From 778c5fcf718b774c7c508440b60827ba499a625b Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 23 Oct 2022 21:57:58 +0900 Subject: [PATCH 001/288] begin to develop the package system --- src/frontend/fileDependencyResolver.ml | 98 ++++++++++++++++--------- src/frontend/fileDependencyResolver.mli | 2 +- src/frontend/lexer.mll | 13 +--- src/frontend/main.ml | 5 +- src/frontend/parser.mly | 16 ++-- src/frontend/types.cppo.ml | 6 +- 6 files changed, 85 insertions(+), 55 deletions(-) diff --git a/src/frontend/fileDependencyResolver.ml b/src/frontend/fileDependencyResolver.ml index 41cf86c7a..ffb3960d7 100644 --- a/src/frontend/fileDependencyResolver.ml +++ b/src/frontend/fileDependencyResolver.ml @@ -31,22 +31,33 @@ let get_candidate_file_extensions () = | TextMode(formats) -> List.append (formats |> List.map (fun s -> ".satyh-" ^ s)) [ ".satyg" ] +(* let get_package_abs_path (package : string) : abs_path = let extcands = get_candidate_file_extensions () in Config.resolve_package_exn package extcands +*) -let get_abs_path_of_header (curdir : string) (headerelem : header_element) : abs_path = +type local_or_package = + | Local of module_name ranged * abs_path + | Package of module_name ranged + + +let get_header (curdir : string) (headerelem : header_element) : local_or_package = match headerelem with - | HeaderRequire(package) -> - get_package_abs_path package + | HeaderUsePackage(modident) -> + Package(modident) - | HeaderImport(s) -> + | HeaderUse(_) -> + failwith "TODO (error): cannot use 'use X' here; use 'use X of path' instead" + + | HeaderUseOf(modident, s_relpath) -> let extcands = get_candidate_file_extensions () in - Config.resolve_local_exn curdir s extcands + let abspath = Config.resolve_local_exn curdir s_relpath extcands in + Local(modident, abspath) -let rec register_library_file (graph : FileDependencyGraph.t) ~prev:(vertex_prev : FileDependencyGraph.vertex) (abspath : abs_path) : FileDependencyGraph.t = +let rec register_library_file (graph : FileDependencyGraph.t) (packages : PackageNameSet.t) ~prev:(vertex_prev : FileDependencyGraph.vertex) (abspath : abs_path) : FileDependencyGraph.t * PackageNameSet.t = begin Logging.begin_to_parse_file abspath; let curdir = Filename.dirname (get_abs_path_string abspath) in @@ -64,21 +75,28 @@ let rec register_library_file (graph : FileDependencyGraph.t) ~prev:(vertex_prev | Ok(pair) -> pair in let graph = FileDependencyGraph.add_edge ~from:vertex_prev ~to_:vertex graph in - header |> List.fold_left (fun graph headerelem -> - let abspath_sub = get_abs_path_of_header curdir headerelem in - match graph |> FileDependencyGraph.get_vertex abspath_sub with - | Some(vertex_sub) -> - (* If `abs_path` has already been parsed *) - graph |> FileDependencyGraph.add_edge ~from:vertex ~to_:vertex_sub - - | None -> - register_library_file graph ~prev:vertex abspath_sub - - ) graph + header |> List.fold_left (fun (graph, packages) headerelem -> + match get_header curdir headerelem with + | Package((_, main_module_name)) -> + (graph, packages |> PackageNameSet.add main_module_name) + + | Local(_modident_sub, abspath_sub) -> + begin + match graph |> FileDependencyGraph.get_vertex abspath_sub with + | Some(vertex_sub) -> + (* If `abs_path` has already been parsed *) + let graph = graph |> FileDependencyGraph.add_edge ~from:vertex ~to_:vertex_sub in + (graph, packages) + + | None -> + register_library_file graph packages ~prev:vertex abspath_sub + end + + ) (graph, packages) end -let register_document_file (graph : FileDependencyGraph.t) (abspath_in : abs_path) : FileDependencyGraph.t = +let register_document_file (graph : FileDependencyGraph.t) (packages : PackageNameSet.t) (abspath_in : abs_path) : FileDependencyGraph.t * PackageNameSet.t = Logging.begin_to_parse_file abspath_in; let file_in = open_in_abs abspath_in in let curdir = Filename.dirname (get_abs_path_string abspath_in) in @@ -95,18 +113,26 @@ let register_document_file (graph : FileDependencyGraph.t) (abspath_in : abs_pat | Error(_) -> assert false | Ok(pair) -> pair in - header |> List.fold_left (fun graph headerelem -> - let abspath_sub = get_abs_path_of_header curdir headerelem in - match graph |> FileDependencyGraph.get_vertex abspath_sub with - | Some(vertex_sub) -> - graph |> FileDependencyGraph.add_edge ~from:vertex ~to_:vertex_sub + header |> List.fold_left (fun (graph, packages) headerelem -> + match get_header curdir headerelem with + | Package((_, main_module_name)) -> + (graph, packages |> PackageNameSet.add main_module_name) - | None -> - register_library_file graph ~prev:vertex abspath_sub + | Local(_, abspath_sub) -> + begin + match graph |> FileDependencyGraph.get_vertex abspath_sub with + | Some(vertex_sub) -> + let graph = graph |> FileDependencyGraph.add_edge ~from:vertex ~to_:vertex_sub in + (graph, packages) - ) graph + | None -> + register_library_file graph packages ~prev:vertex abspath_sub + end + + ) (graph, packages) +(* let register_markdown_file (graph : FileDependencyGraph.t) (setting : string) (abspath_in : abs_path) : FileDependencyGraph.t = Logging.begin_to_parse_file abspath_in; let (cmdrcd, depends) = @@ -135,26 +161,30 @@ let register_markdown_file (graph : FileDependencyGraph.t) (setting : string) (a register_library_file graph ~prev:vertex abspath_sub ) graph +*) - -let main (abspath_in : abs_path) = +let main (abspath_in : abs_path) : (abs_path * file_info) list * PackageNameSet.t = let graph = FileDependencyGraph.empty in - let graph = + let packages = PackageNameSet.empty in + let (graph, packages) = match OptionState.get_input_kind () with | OptionState.SATySFi -> if has_library_extension abspath_in && OptionState.is_type_check_only () then - let vertex = failwith "TODO" in - register_library_file graph ~prev:vertex abspath_in + let vertex = failwith "TODO: type-check-only" in + register_library_file graph packages ~prev:vertex abspath_in else - register_document_file graph abspath_in + register_document_file graph packages abspath_in - | OptionState.Markdown(setting) -> + | OptionState.Markdown(_setting) -> + failwith "TODO: Markdown" +(* register_markdown_file graph setting abspath_in +*) in match FileDependencyGraph.topological_sort graph with | Error(cycle) -> raise (CyclicFileDependency(cycle)) | Ok(inputs) -> - inputs + (inputs, packages) diff --git a/src/frontend/fileDependencyResolver.mli b/src/frontend/fileDependencyResolver.mli index 5c570f2e8..515a2d0a0 100644 --- a/src/frontend/fileDependencyResolver.mli +++ b/src/frontend/fileDependencyResolver.mli @@ -7,4 +7,4 @@ exception CannotReadFileOwingToSystem of string exception LibraryContainsWholeReturnValue of abs_path exception DocumentLacksWholeReturnValue of abs_path -val main : abs_path -> (abs_path * file_info) list +val main : abs_path -> (abs_path * file_info) list * PackageNameSet.t diff --git a/src/frontend/lexer.mll b/src/frontend/lexer.mll index a07833204..c8fbd3298 100644 --- a/src/frontend/lexer.mll +++ b/src/frontend/lexer.mll @@ -144,17 +144,6 @@ rule lex_program stack = parse comment lexbuf; lex_program stack lexbuf } - | ("@" (lower as headertype) ":" (" "*) (nonbreak* as content) (break | eof)) - { - let pos = get_pos lexbuf in - increment_line lexbuf; - match headertype with - | "require" -> HEADER_REQUIRE(pos, content) - | "import" -> HEADER_IMPORT(pos, content) - - | _ -> - raise (LexError(pos, "undefined header type '" ^ headertype ^ "'")) - } | space { lex_program stack lexbuf } | break @@ -342,6 +331,7 @@ rule lex_program stack = parse | "mutable" -> MUTABLE(pos) | "of" -> OF(pos) | "open" -> OPEN(pos) + | "package" -> PACKAGE(pos) | "persistent"-> PERSISTENT(pos) | "rec" -> REC(pos) | "sig" -> SIG(pos) @@ -350,6 +340,7 @@ rule lex_program stack = parse | "then" -> THEN(pos) | "true" -> TRUE(pos) | "type" -> TYPE(pos) + | "use" -> USE(pos) | "val" -> VAL(pos) | "with" -> WITH(pos) | _ -> LOWER(pos, tokstr) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index e01e11415..3f0939d2b 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1154,8 +1154,9 @@ let build let (tyenv, env, dump_file_exists) = initialize abspath_dump in Logging.dump_file dump_file_exists abspath_dump; - (* Resolve dependency: *) - let inputs = FileDependencyResolver.main abspath_in in + (* Resolve dependency of the document and the local source files: *) + let (inputs, _packages) = FileDependencyResolver.main abspath_in in + (* TODO: use `packages` *) (* Typechecking and elaboration: *) let (_, libacc, ast_opt) = diff --git a/src/frontend/parser.mly b/src/frontend/parser.mly index c3ffbd08a..61f82246e 100644 --- a/src/frontend/parser.mly +++ b/src/frontend/parser.mly @@ -238,7 +238,7 @@ %token AND AS BLOCK COMMAND ELSE END FALSE FUN IF IN INCLUDE INLINE LET MOD MATCH MATH MODULE MUTABLE OF OPEN - REC SIG SIGNATURE STRUCT THEN TRUE TYPE VAL WITH PERSISTENT + REC SIG SIGNATURE STRUCT THEN TRUE TYPE VAL WITH PERSISTENT PACKAGE USE %token BAR WILDCARD COLON ARROW REVERSED_ARROW SEMICOLON COMMA CONS ACCESS QUESTION COERCE @@ -282,8 +282,6 @@ %token SUBSCRIPT SUPERSCRIPT %token ITEM -%token HEADER_REQUIRE HEADER_IMPORT - %token BACKSLASH_MACRO PLUS_MACRO %token LONG_BACKSLASH_MACRO LONG_PLUS_MACRO @@ -374,8 +372,16 @@ main_lib: { (modident, utsig_opt, utbinds) } ; headerelem: - | content=HEADER_REQUIRE { let (_, s) = content in HeaderRequire(s) } - | content=HEADER_IMPORT { let (_, s) = content in HeaderImport(s) } + | USE; PACKAGE; modident=UPPER + { HeaderUsePackage(modident) } + | USE; modident=UPPER + { HeaderUse(modident) } + | USE; modident=UPPER; OF; tok=STRING + { + let (_rng, str, pre, post) = tok in + let s = omit_spaces pre post str in + HeaderUseOf(modident, s) + } ; modexpr: | tokL=FUN; L_PAREN; modident=UPPER; COLON; utsig=sigexpr; R_PAREN; ARROW; utmod=modexpr diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index cebe8b65c..d4da91a72 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -38,8 +38,9 @@ type input_position = { [@@deriving show { with_path = false }] type header_element = - | HeaderRequire of string - | HeaderImport of string + | HeaderUsePackage of module_name ranged + | HeaderUse of module_name ranged + | HeaderUseOf of module_name ranged * string type quantifiability = Quantifiable | Unquantifiable @@ -1185,6 +1186,7 @@ type file_info = | DocumentFile of untyped_abstract_tree | LibraryFile of (module_name ranged * untyped_signature option * untyped_binding list) +module PackageNameSet = Set.Make(String) module BoundIDHashTable = Hashtbl.Make(BoundID) From dcf2348728d7c07faca3821c135c93eca63ecd5c Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 23 Oct 2022 22:00:43 +0900 Subject: [PATCH 002/288] rename 'FileDependencyResolver' to 'OpenFileDependencyResolver' --- src/frontend/main.ml | 10 +++++----- ...ndencyResolver.ml => openFileDependencyResolver.ml} | 0 ...encyResolver.mli => openFileDependencyResolver.mli} | 0 3 files changed, 5 insertions(+), 5 deletions(-) rename src/frontend/{fileDependencyResolver.ml => openFileDependencyResolver.ml} (100%) rename src/frontend/{fileDependencyResolver.mli => openFileDependencyResolver.mli} (100%) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 3f0939d2b..f1e2b1e66 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -394,7 +394,7 @@ let error_log_environment suspended = NormalLine("or specify configuration search paths with -C option."); ] - | FileDependencyResolver.CyclicFileDependency(cycle) -> + | OpenFileDependencyResolver.CyclicFileDependency(cycle) -> let pairs = match cycle with | Loop(pair) -> [ pair ] @@ -405,19 +405,19 @@ let error_log_environment suspended = (pairs |> List.map (fun (abspath, _) -> DisplayLine(get_abs_path_string abspath))) ) - | FileDependencyResolver.CannotReadFileOwingToSystem(msg) -> + | OpenFileDependencyResolver.CannotReadFileOwingToSystem(msg) -> report_error Interface [ NormalLine("cannot read file:"); DisplayLine(msg); ] - | FileDependencyResolver.LibraryContainsWholeReturnValue(abspath) -> + | OpenFileDependencyResolver.LibraryContainsWholeReturnValue(abspath) -> let fname = get_abs_path_string abspath in report_error Interface [ NormalLine(Printf.sprintf "file '%s' is not a library; it has a return value." fname); ] - | FileDependencyResolver.DocumentLacksWholeReturnValue(abspath) -> + | OpenFileDependencyResolver.DocumentLacksWholeReturnValue(abspath) -> let fname = get_abs_path_string abspath in report_error Interface [ NormalLine(Printf.sprintf "file '%s' is not a document; it lacks a return value." fname); @@ -1155,7 +1155,7 @@ let build Logging.dump_file dump_file_exists abspath_dump; (* Resolve dependency of the document and the local source files: *) - let (inputs, _packages) = FileDependencyResolver.main abspath_in in + let (inputs, _packages) = OpenFileDependencyResolver.main abspath_in in (* TODO: use `packages` *) (* Typechecking and elaboration: *) diff --git a/src/frontend/fileDependencyResolver.ml b/src/frontend/openFileDependencyResolver.ml similarity index 100% rename from src/frontend/fileDependencyResolver.ml rename to src/frontend/openFileDependencyResolver.ml diff --git a/src/frontend/fileDependencyResolver.mli b/src/frontend/openFileDependencyResolver.mli similarity index 100% rename from src/frontend/fileDependencyResolver.mli rename to src/frontend/openFileDependencyResolver.mli From d53ee25e9a3477ce0fef0b85fc8ed092a67268cf Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 23 Oct 2022 22:09:48 +0900 Subject: [PATCH 003/288] make 'OpenFileDependencyResolver' monadic --- src/frontend/main.ml | 63 ++++++++------- src/frontend/openFileDependencyResolver.ml | 85 +++++++++++---------- src/frontend/openFileDependencyResolver.mli | 11 +-- 3 files changed, 86 insertions(+), 73 deletions(-) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index f1e2b1e66..dba9d7e70 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -9,6 +9,7 @@ exception NoLibraryRootDesignation exception NotADocumentFile of abs_path * Typeenv.t * mono_type exception NotAStringFile of abs_path * Typeenv.t * mono_type exception ShouldSpecifyOutputFile +exception OpenFileDependencyError of OpenFileDependencyResolver.error exception TypeError of type_error @@ -394,34 +395,38 @@ let error_log_environment suspended = NormalLine("or specify configuration search paths with -C option."); ] - | OpenFileDependencyResolver.CyclicFileDependency(cycle) -> - let pairs = - match cycle with - | Loop(pair) -> [ pair ] - | Cycle(pairs) -> pairs |> TupleList.to_list - in - report_error Interface ( - (NormalLine("cyclic dependency detected:")) :: - (pairs |> List.map (fun (abspath, _) -> DisplayLine(get_abs_path_string abspath))) - ) - - | OpenFileDependencyResolver.CannotReadFileOwingToSystem(msg) -> - report_error Interface [ - NormalLine("cannot read file:"); - DisplayLine(msg); - ] + | OpenFileDependencyError(e) -> + begin + match e with + | CyclicFileDependency(cycle) -> + let pairs = + match cycle with + | Loop(pair) -> [ pair ] + | Cycle(pairs) -> pairs |> TupleList.to_list + in + report_error Interface ( + (NormalLine("cyclic dependency detected:")) :: + (pairs |> List.map (fun (abspath, _) -> DisplayLine(get_abs_path_string abspath))) + ) + + | CannotReadFileOwingToSystem(msg) -> + report_error Interface [ + NormalLine("cannot read file:"); + DisplayLine(msg); + ] - | OpenFileDependencyResolver.LibraryContainsWholeReturnValue(abspath) -> - let fname = get_abs_path_string abspath in - report_error Interface [ - NormalLine(Printf.sprintf "file '%s' is not a library; it has a return value." fname); - ] + | LibraryContainsWholeReturnValue(abspath) -> + let fname = get_abs_path_string abspath in + report_error Interface [ + NormalLine(Printf.sprintf "file '%s' is not a library; it has a return value." fname); + ] - | OpenFileDependencyResolver.DocumentLacksWholeReturnValue(abspath) -> - let fname = get_abs_path_string abspath in - report_error Interface [ - NormalLine(Printf.sprintf "file '%s' is not a document; it lacks a return value." fname); - ] + | DocumentLacksWholeReturnValue(abspath) -> + let fname = get_abs_path_string abspath in + report_error Interface [ + NormalLine(Printf.sprintf "file '%s' is not a document; it lacks a return value." fname); + ] + end | Config.PackageNotFound(package, pathcands) -> report_error Interface (List.append [ @@ -1155,7 +1160,11 @@ let build Logging.dump_file dump_file_exists abspath_dump; (* Resolve dependency of the document and the local source files: *) - let (inputs, _packages) = OpenFileDependencyResolver.main abspath_in in + let (inputs, _packages) = + match OpenFileDependencyResolver.main abspath_in with + | Ok(pair) -> pair + | Error(e) -> raise (OpenFileDependencyError(e)) + in (* TODO: use `packages` *) (* Typechecking and elaboration: *) diff --git a/src/frontend/openFileDependencyResolver.ml b/src/frontend/openFileDependencyResolver.ml index ffb3960d7..2e7a0a07a 100644 --- a/src/frontend/openFileDependencyResolver.ml +++ b/src/frontend/openFileDependencyResolver.ml @@ -3,10 +3,13 @@ open MyUtil open Types -exception CyclicFileDependency of (abs_path * file_info) cycle -exception CannotReadFileOwingToSystem of string -exception LibraryContainsWholeReturnValue of abs_path -exception DocumentLacksWholeReturnValue of abs_path +type error = + | CyclicFileDependency of (abs_path * file_info) cycle + | CannotReadFileOwingToSystem of string + | LibraryContainsWholeReturnValue of abs_path + | DocumentLacksWholeReturnValue of abs_path + +type 'a ok = ('a, error) result let has_library_extension (abspath : abs_path) : bool = @@ -57,28 +60,28 @@ let get_header (curdir : string) (headerelem : header_element) : local_or_packag Local(modident, abspath) -let rec register_library_file (graph : FileDependencyGraph.t) (packages : PackageNameSet.t) ~prev:(vertex_prev : FileDependencyGraph.vertex) (abspath : abs_path) : FileDependencyGraph.t * PackageNameSet.t = - begin - Logging.begin_to_parse_file abspath; - let curdir = Filename.dirname (get_abs_path_string abspath) in - let inc = open_in_abs abspath in - let (header, utsrc) = ParserInterface.process (basename_abs abspath) (Lexing.from_channel inc) in - close_in inc; - let lib = - match utsrc with - | UTLibraryFile(lib) -> lib - | UTDocumentFile(_) -> raise (LibraryContainsWholeReturnValue(abspath)) - in - let (graph, vertex) = - match graph |> FileDependencyGraph.add_vertex abspath (LibraryFile(lib)) with - | Error(_) -> assert false - | Ok(pair) -> pair - in - let graph = FileDependencyGraph.add_edge ~from:vertex_prev ~to_:vertex graph in - header |> List.fold_left (fun (graph, packages) headerelem -> +let rec register_library_file (graph : FileDependencyGraph.t) (packages : PackageNameSet.t) ~prev:(vertex_prev : FileDependencyGraph.vertex) (abspath : abs_path) : (FileDependencyGraph.t * PackageNameSet.t) ok = + let open ResultMonad in + Logging.begin_to_parse_file abspath; + let curdir = Filename.dirname (get_abs_path_string abspath) in + let inc = open_in_abs abspath in + let (header, utsrc) = ParserInterface.process (basename_abs abspath) (Lexing.from_channel inc) in + close_in inc; + let* lib = + match utsrc with + | UTLibraryFile(lib) -> return lib + | UTDocumentFile(_) -> err @@ LibraryContainsWholeReturnValue(abspath) + in + let (graph, vertex) = + match graph |> FileDependencyGraph.add_vertex abspath (LibraryFile(lib)) with + | Error(_) -> assert false + | Ok(pair) -> pair + in + let graph = FileDependencyGraph.add_edge ~from:vertex_prev ~to_:vertex graph in + header |> foldM (fun (graph, packages) headerelem -> match get_header curdir headerelem with | Package((_, main_module_name)) -> - (graph, packages |> PackageNameSet.add main_module_name) + return (graph, packages |> PackageNameSet.add main_module_name) | Local(_modident_sub, abspath_sub) -> begin @@ -86,44 +89,44 @@ let rec register_library_file (graph : FileDependencyGraph.t) (packages : Packag | Some(vertex_sub) -> (* If `abs_path` has already been parsed *) let graph = graph |> FileDependencyGraph.add_edge ~from:vertex ~to_:vertex_sub in - (graph, packages) + return (graph, packages) | None -> register_library_file graph packages ~prev:vertex abspath_sub end ) (graph, packages) - end -let register_document_file (graph : FileDependencyGraph.t) (packages : PackageNameSet.t) (abspath_in : abs_path) : FileDependencyGraph.t * PackageNameSet.t = +let register_document_file (graph : FileDependencyGraph.t) (packages : PackageNameSet.t) (abspath_in : abs_path) : (FileDependencyGraph.t * PackageNameSet.t) ok = + let open ResultMonad in Logging.begin_to_parse_file abspath_in; let file_in = open_in_abs abspath_in in let curdir = Filename.dirname (get_abs_path_string abspath_in) in let (header, utsrc) = ParserInterface.process (Filename.basename (get_abs_path_string abspath_in)) (Lexing.from_channel file_in) in - let utast = + let* utast = match utsrc with - | UTLibraryFile(_) -> raise (DocumentLacksWholeReturnValue(abspath_in)) - | UTDocumentFile(utast) -> utast + | UTLibraryFile(_) -> err @@ DocumentLacksWholeReturnValue(abspath_in) + | UTDocumentFile(utast) -> return utast in let (graph, vertex) = match graph |> FileDependencyGraph.add_vertex abspath_in (DocumentFile(utast)) with | Error(_) -> assert false | Ok(pair) -> pair in - header |> List.fold_left (fun (graph, packages) headerelem -> + header |> foldM (fun (graph, packages) headerelem -> match get_header curdir headerelem with | Package((_, main_module_name)) -> - (graph, packages |> PackageNameSet.add main_module_name) + return (graph, packages |> PackageNameSet.add main_module_name) | Local(_, abspath_sub) -> begin match graph |> FileDependencyGraph.get_vertex abspath_sub with | Some(vertex_sub) -> let graph = graph |> FileDependencyGraph.add_edge ~from:vertex ~to_:vertex_sub in - (graph, packages) + return (graph, packages) | None -> register_library_file graph packages ~prev:vertex abspath_sub @@ -164,10 +167,11 @@ let register_markdown_file (graph : FileDependencyGraph.t) (setting : string) (a *) -let main (abspath_in : abs_path) : (abs_path * file_info) list * PackageNameSet.t = +let main (abspath_in : abs_path) : ((abs_path * file_info) list * PackageNameSet.t) ok = + let open ResultMonad in let graph = FileDependencyGraph.empty in let packages = PackageNameSet.empty in - let (graph, packages) = + let* (graph, packages) = match OptionState.get_input_kind () with | OptionState.SATySFi -> if has_library_extension abspath_in && OptionState.is_type_check_only () then @@ -182,9 +186,8 @@ let main (abspath_in : abs_path) : (abs_path * file_info) list * PackageNameSet. register_markdown_file graph setting abspath_in *) in - match FileDependencyGraph.topological_sort graph with - | Error(cycle) -> - raise (CyclicFileDependency(cycle)) - - | Ok(inputs) -> - (inputs, packages) + begin + FileDependencyGraph.topological_sort graph + |> Result.map_error (fun cycle -> CyclicFileDependency(cycle)) + end >>= fun inputs -> + return (inputs, packages) diff --git a/src/frontend/openFileDependencyResolver.mli b/src/frontend/openFileDependencyResolver.mli index 515a2d0a0..82e8fd83f 100644 --- a/src/frontend/openFileDependencyResolver.mli +++ b/src/frontend/openFileDependencyResolver.mli @@ -2,9 +2,10 @@ open MyUtil open Types -exception CyclicFileDependency of (abs_path * file_info) cycle -exception CannotReadFileOwingToSystem of string -exception LibraryContainsWholeReturnValue of abs_path -exception DocumentLacksWholeReturnValue of abs_path +type error = + | CyclicFileDependency of (abs_path * file_info) cycle + | CannotReadFileOwingToSystem of string + | LibraryContainsWholeReturnValue of abs_path + | DocumentLacksWholeReturnValue of abs_path -val main : abs_path -> (abs_path * file_info) list * PackageNameSet.t +val main : abs_path -> ((abs_path * file_info) list * PackageNameSet.t, error) result From 0c90ac8120cd672c3291303c8f522408fba51c57 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 23 Oct 2022 22:26:11 +0900 Subject: [PATCH 004/288] make 'ParserInterface' monadic --- src/frontend/main.ml | 10 +++---- src/frontend/openFileDependencyResolver.ml | 14 ++++++---- src/frontend/openFileDependencyResolver.mli | 1 + src/frontend/parserInterface.ml | 31 +++++++++++++++++---- src/frontend/parserInterface.mli | 7 +++++ src/md/decodeMD.ml | 7 ++--- 6 files changed, 49 insertions(+), 21 deletions(-) create mode 100644 src/frontend/parserInterface.mli diff --git a/src/frontend/main.ml b/src/frontend/main.ml index dba9d7e70..3de121ff8 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -426,6 +426,11 @@ let error_log_environment suspended = report_error Interface [ NormalLine(Printf.sprintf "file '%s' is not a document; it lacks a return value." fname); ] + + | FailedToParse(rng) -> + report_error Parser [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + ] end | Config.PackageNotFound(package, pathcands) -> @@ -578,11 +583,6 @@ let error_log_environment suspended = NormalLine(s); ] - | ParserInterface.Error(rng) -> - report_error Parser [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - ] - | ParseErrorDetail(rng, s) -> report_error Parser [ NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); diff --git a/src/frontend/openFileDependencyResolver.ml b/src/frontend/openFileDependencyResolver.ml index 2e7a0a07a..d0e854e30 100644 --- a/src/frontend/openFileDependencyResolver.ml +++ b/src/frontend/openFileDependencyResolver.ml @@ -8,6 +8,7 @@ type error = | CannotReadFileOwingToSystem of string | LibraryContainsWholeReturnValue of abs_path | DocumentLacksWholeReturnValue of abs_path + | FailedToParse of Range.t type 'a ok = ('a, error) result @@ -64,9 +65,10 @@ let rec register_library_file (graph : FileDependencyGraph.t) (packages : Packag let open ResultMonad in Logging.begin_to_parse_file abspath; let curdir = Filename.dirname (get_abs_path_string abspath) in - let inc = open_in_abs abspath in - let (header, utsrc) = ParserInterface.process (basename_abs abspath) (Lexing.from_channel inc) in - close_in inc; + let* (header, utsrc) = + ParserInterface.process_file abspath + |> Result.map_error (fun rng -> FailedToParse(rng)) + in let* lib = match utsrc with | UTLibraryFile(lib) -> return lib @@ -101,10 +103,10 @@ let rec register_library_file (graph : FileDependencyGraph.t) (packages : Packag let register_document_file (graph : FileDependencyGraph.t) (packages : PackageNameSet.t) (abspath_in : abs_path) : (FileDependencyGraph.t * PackageNameSet.t) ok = let open ResultMonad in Logging.begin_to_parse_file abspath_in; - let file_in = open_in_abs abspath_in in let curdir = Filename.dirname (get_abs_path_string abspath_in) in - let (header, utsrc) = - ParserInterface.process (Filename.basename (get_abs_path_string abspath_in)) (Lexing.from_channel file_in) + let* (header, utsrc) = + ParserInterface.process_file abspath_in + |> Result.map_error (fun rng -> FailedToParse(rng)) in let* utast = match utsrc with diff --git a/src/frontend/openFileDependencyResolver.mli b/src/frontend/openFileDependencyResolver.mli index 82e8fd83f..2fe4ca29d 100644 --- a/src/frontend/openFileDependencyResolver.mli +++ b/src/frontend/openFileDependencyResolver.mli @@ -7,5 +7,6 @@ type error = | CannotReadFileOwingToSystem of string | LibraryContainsWholeReturnValue of abs_path | DocumentLacksWholeReturnValue of abs_path + | FailedToParse of Range.t val main : abs_path -> ((abs_path * file_info) list * PackageNameSet.t, error) result diff --git a/src/frontend/parserInterface.ml b/src/frontend/parserInterface.ml index 8c0722955..ebfdcad31 100644 --- a/src/frontend/parserInterface.ml +++ b/src/frontend/parserInterface.ml @@ -1,9 +1,9 @@ -exception Error of Range.t +exception InternalError of Range.t module I = Parser.MenhirInterpreter -open Lexing +open MyUtil open Types @@ -18,14 +18,33 @@ let k_fail chkpt = let cnumS = lposS.Lexing.pos_cnum - lposS.Lexing.pos_bol in let cnumE = lposE.Lexing.pos_cnum - lposE.Lexing.pos_bol in let rng = Range.make lposS.Lexing.pos_fname lposS.Lexing.pos_lnum cnumS cnumE in - raise (Error(rng)) + raise (InternalError(rng)) | _ -> assert false -let process fname lexbuf = +let process_common fname lexbuf = + let open ResultMonad in let stack = Lexer.reset_to_program () in - let () = lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = fname } in + lexbuf.Lexing.lex_curr_p <- { lexbuf.Lexing.lex_curr_p with pos_fname = fname }; let supplier = I.lexer_lexbuf_to_supplier (Lexer.cut_token stack) lexbuf in - I.loop_handle k_success k_fail supplier (Parser.Incremental.main lexbuf.Lexing.lex_curr_p) + try + return @@ I.loop_handle k_success k_fail supplier (Parser.Incremental.main lexbuf.Lexing.lex_curr_p) + with + | InternalError(rng) -> + err rng + + +let process_file (abspath : abs_path) = + let fname = basename_abs abspath in + let inc = open_in_abs abspath in + let lexbuf = Lexing.from_channel inc in + let res = process_common fname lexbuf in + close_in inc; + res + + +let process_text (fname : string) (s : string) = + let lexbuf = Lexing.from_string s in + process_common fname lexbuf diff --git a/src/frontend/parserInterface.mli b/src/frontend/parserInterface.mli new file mode 100644 index 000000000..cedb7a4bd --- /dev/null +++ b/src/frontend/parserInterface.mli @@ -0,0 +1,7 @@ + +open MyUtil +open Types + +val process_file : abs_path -> (header_element list * Types.untyped_source_file, Range.t) result + +val process_text : string -> string -> (header_element list * Types.untyped_source_file, Range.t) result diff --git a/src/md/decodeMD.ml b/src/md/decodeMD.ml index 5b8e3462f..a19871aa3 100644 --- a/src/md/decodeMD.ml +++ b/src/md/decodeMD.ml @@ -474,11 +474,10 @@ let decode (cmdrcd : command_record) (s : string) = | _ -> (cmdrcd.header_default, md) in - let lexbuf = Lexing.from_string strheader in let utasthead = - match ParserInterface.process "(markdown)" lexbuf with - | ([], UTDocumentFile(u)) -> u - | _ -> failwith "TODO (error): invalid header expression" + match ParserInterface.process_text "(markdown)" strheader with + | Ok(([], UTDocumentFile(u))) -> u + | _ -> failwith "TODO (error): invalid header expression" in let blk = normalize_h1 md in (* From 553a40e7becac305115f5e5a356639734424fb35 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 23 Oct 2022 22:35:42 +0900 Subject: [PATCH 005/288] begin to add 'OpenPackageDependencyResolver' --- src/frontend/main.ml | 15 +++++++++++++-- src/frontend/openPackageDependencyResolver.ml | 10 ++++++++++ src/frontend/types.cppo.ml | 3 +++ 3 files changed, 26 insertions(+), 2 deletions(-) create mode 100644 src/frontend/openPackageDependencyResolver.ml diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 3de121ff8..a73bbdd99 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -10,6 +10,7 @@ exception NotADocumentFile of abs_path * Typeenv.t * mono_type exception NotAStringFile of abs_path * Typeenv.t * mono_type exception ShouldSpecifyOutputFile exception OpenFileDependencyError of OpenFileDependencyResolver.error +exception OpenPackageDependencyError of OpenPackageDependencyResolver.error exception TypeError of type_error @@ -433,6 +434,9 @@ let error_log_environment suspended = ] end + | OpenPackageDependencyError(_e) -> + failwith "TODO (error): OpenPackageDependencyError" + | Config.PackageNotFound(package, pathcands) -> report_error Interface (List.append [ NormalLine("package file not found:"); @@ -1160,12 +1164,19 @@ let build Logging.dump_file dump_file_exists abspath_dump; (* Resolve dependency of the document and the local source files: *) - let (inputs, _packages) = + let (inputs, package_names) = match OpenFileDependencyResolver.main abspath_in with | Ok(pair) -> pair | Error(e) -> raise (OpenFileDependencyError(e)) in - (* TODO: use `packages` *) + + (* Resolve dependency among packages that the document depends on: *) + let _sorted_packages = + match OpenPackageDependencyResolver.main package_names with + | Ok(sorted_packages) -> sorted_packages + | Error(e) -> raise (OpenPackageDependencyError(e)) + in + (* TODO: use `sorted_packages` *) (* Typechecking and elaboration: *) let (_, libacc, ast_opt) = diff --git a/src/frontend/openPackageDependencyResolver.ml b/src/frontend/openPackageDependencyResolver.ml new file mode 100644 index 000000000..e78d79c71 --- /dev/null +++ b/src/frontend/openPackageDependencyResolver.ml @@ -0,0 +1,10 @@ + +open Types + +type error = + unit (* TODO: define this *) + +type 'a ok = ('a, error) result + +let main (_package_names : PackageNameSet.t) : (package_info list) ok = + Ok([]) (* TODO: define this *) diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index d4da91a72..280d48660 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -1186,6 +1186,9 @@ type file_info = | DocumentFile of untyped_abstract_tree | LibraryFile of (module_name ranged * untyped_signature option * untyped_binding list) +type package_info = + unit (* TODO: define this *) + module PackageNameSet = Set.Make(String) module BoundIDHashTable = Hashtbl.Make(BoundID) From 8c15e8253776acf524145b8dc04535c161abaa05 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 23 Oct 2022 22:53:45 +0900 Subject: [PATCH 006/288] begin to add 'PackageChecker' --- src/frontend/main.ml | 20 ++++++++++++++++++-- src/frontend/packageChecker.ml | 6 ++++++ src/frontend/staticEnv.ml | 3 +++ src/frontend/staticEnv.mli | 2 ++ src/frontend/types.cppo.ml | 2 ++ 5 files changed, 31 insertions(+), 2 deletions(-) create mode 100644 src/frontend/packageChecker.ml diff --git a/src/frontend/main.ml b/src/frontend/main.ml index a73bbdd99..643f5a2ac 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1171,12 +1171,28 @@ let build in (* Resolve dependency among packages that the document depends on: *) - let _sorted_packages = + let sorted_packages = match OpenPackageDependencyResolver.main package_names with | Ok(sorted_packages) -> sorted_packages | Error(e) -> raise (OpenPackageDependencyError(e)) in - (* TODO: use `sorted_packages` *) + + (* Typecheck every package: *) + let (_genv, bindacc) = + sorted_packages |> List.fold_left (fun (genv, bindacc) package -> + let main_module_name = failwith "TODO: main_module_name; extract it from `package`" in + let (absmodsig, binds) = + match PackageChecker.main genv package with + | Ok(pair) -> pair + | Error(_e) -> failwith "TODO (error): PackageChecker, Error" + in + let genv = genv |> GlobalTypeenv.add main_module_name absmodsig in + let bindacc = Alist.append bindacc binds in + (genv, bindacc) + ) (GlobalTypeenv.empty, Alist.empty) + in + let _binds = bindacc |> Alist.to_list in + (* TODO: use `genv` and `binds` *) (* Typechecking and elaboration: *) let (_, libacc, ast_opt) = diff --git a/src/frontend/packageChecker.ml b/src/frontend/packageChecker.ml new file mode 100644 index 000000000..fed7958f4 --- /dev/null +++ b/src/frontend/packageChecker.ml @@ -0,0 +1,6 @@ + +open Types +open StaticEnv + +let main (_genv : global_type_environment) (_package : package_info) = + failwith "TODO: PackageChecker" diff --git a/src/frontend/staticEnv.ml b/src/frontend/staticEnv.ml index 8bf491565..9f02dd320 100644 --- a/src/frontend/staticEnv.ml +++ b/src/frontend/staticEnv.ml @@ -427,3 +427,6 @@ let find_candidates_in_struct_sig (ssig : StructSig.t) (varnm : var_name) : var_ ssig in Distance.get_candidates fold_value ssig varnm + + +type global_type_environment = (signature abstracted) GlobalTypeenv.t diff --git a/src/frontend/staticEnv.mli b/src/frontend/staticEnv.mli index 7815ff807..12b5e912a 100644 --- a/src/frontend/staticEnv.mli +++ b/src/frontend/staticEnv.mli @@ -158,3 +158,5 @@ end val find_candidates_in_type_environment : Typeenv.t -> var_name -> var_name list val find_candidates_in_struct_sig : StructSig.t -> var_name -> var_name list + +type global_type_environment = (signature abstracted) GlobalTypeenv.t diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index 280d48660..1881e1a59 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -1189,6 +1189,8 @@ type file_info = type package_info = unit (* TODO: define this *) +module GlobalTypeenv = Map.Make(String) + module PackageNameSet = Set.Make(String) module BoundIDHashTable = Hashtbl.Make(BoundID) From cc4fa2f10815b7d42adf0eaab10c667187b90969 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 23 Oct 2022 23:31:40 +0900 Subject: [PATCH 007/288] develop how to use headers and global type environments --- src/frontend/fileDependencyGraph.ml | 6 +-- src/frontend/fileDependencyGraph.mli | 4 +- src/frontend/main.ml | 49 +++++++++++---------- src/frontend/openFileDependencyResolver.ml | 24 +++++----- src/frontend/openFileDependencyResolver.mli | 4 +- src/frontend/parser.mly | 6 +-- src/frontend/parserInterface.ml | 4 +- src/frontend/parserInterface.mli | 4 +- src/frontend/staticEnv.ml | 2 +- src/frontend/staticEnv.mli | 2 +- src/frontend/types.cppo.ml | 16 +++---- src/md/decodeMD.ml | 4 +- 12 files changed, 62 insertions(+), 63 deletions(-) diff --git a/src/frontend/fileDependencyGraph.ml b/src/frontend/fileDependencyGraph.ml index 198341eb3..98c71fa20 100644 --- a/src/frontend/fileDependencyGraph.ml +++ b/src/frontend/fileDependencyGraph.ml @@ -12,13 +12,13 @@ module Impl = DependencyGraph.Make(AbsPath) type vertex = Impl.Vertex.t -type t = file_info Impl.t +type t = untyped_source_file Impl.t let empty = Impl.empty -let add_vertex (abspath : abs_path) (data : file_info) (graph : t) : (t * vertex, file_info * vertex) result = +let add_vertex (abspath : abs_path) (data : untyped_source_file) (graph : t) : (t * vertex, untyped_source_file * vertex) result = Impl.add_vertex abspath data graph @@ -30,5 +30,5 @@ let add_edge ~(from : vertex) ~(to_ : vertex) (graph : t) : t = Impl.add_edge ~from ~to_ graph -let topological_sort (graph : t) : ((abs_path * file_info) list, (abs_path * file_info) cycle) result = +let topological_sort (graph : t) : ((abs_path * untyped_source_file) list, (abs_path * untyped_source_file) cycle) result = Impl.topological_sort graph diff --git a/src/frontend/fileDependencyGraph.mli b/src/frontend/fileDependencyGraph.mli index b158160e0..69a6032f7 100644 --- a/src/frontend/fileDependencyGraph.mli +++ b/src/frontend/fileDependencyGraph.mli @@ -8,10 +8,10 @@ type t val empty : t -val add_vertex : abs_path -> file_info -> t -> (t * vertex, file_info * vertex) result +val add_vertex : abs_path -> untyped_source_file -> t -> (t * vertex, untyped_source_file * vertex) result val get_vertex : abs_path -> t -> vertex option val add_edge : from:vertex -> to_:vertex -> t -> t -val topological_sort : t -> ((abs_path * file_info) list, (abs_path * file_info) cycle) result +val topological_sort : t -> ((abs_path * untyped_source_file) list, (abs_path * untyped_source_file) cycle) result diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 643f5a2ac..e90edf817 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1160,11 +1160,11 @@ let build | (PdfMode, None) -> make_abs_path (Printf.sprintf "%s.pdf" basename_without_extension) in Logging.target_file abspath_out; - let (tyenv, env, dump_file_exists) = initialize abspath_dump in + let (_tyenv_prim, env, dump_file_exists) = initialize abspath_dump in Logging.dump_file dump_file_exists abspath_dump; (* Resolve dependency of the document and the local source files: *) - let (inputs, package_names) = + let (sorted_locals, package_names) = match OpenFileDependencyResolver.main abspath_in with | Ok(pair) -> pair | Error(e) -> raise (OpenFileDependencyError(e)) @@ -1178,44 +1178,47 @@ let build in (* Typecheck every package: *) - let (_genv, bindacc) = - sorted_packages |> List.fold_left (fun (genv, bindacc) package -> + let (genv, libacc) = + sorted_packages |> List.fold_left (fun (genv, libacc) package -> let main_module_name = failwith "TODO: main_module_name; extract it from `package`" in - let (absmodsig, binds) = + let (absmodsig, libs) = match PackageChecker.main genv package with | Ok(pair) -> pair | Error(_e) -> failwith "TODO (error): PackageChecker, Error" in let genv = genv |> GlobalTypeenv.add main_module_name absmodsig in - let bindacc = Alist.append bindacc binds in - (genv, bindacc) + let libacc = Alist.append libacc libs in + (genv, libacc) ) (GlobalTypeenv.empty, Alist.empty) in - let _binds = bindacc |> Alist.to_list in - (* TODO: use `genv` and `binds` *) (* Typechecking and elaboration: *) - let (_, libacc, ast_opt) = - inputs |> List.fold_left (fun (tyenv, libacc, docopt) (abspath, file_info) -> - match file_info with - | DocumentFile(utast) -> - let ast = typecheck_document_file tyenv abspath utast in - (tyenv, libacc, Some(ast)) - - | LibraryFile((modident, utsig_opt, utbinds)) -> + let (_, libacc, doc_opt) = + sorted_locals |> List.fold_left (fun (genv, libacc, doc_opt) (abspath, utsrc) -> + match utsrc with + | UTDocumentFile(_header, utast) -> + let ast = + let tyenv = failwith "TODO: make `tyenv` from `tyenv_prim`, `genv`, and `header`" in + typecheck_document_file tyenv abspath utast + in + (genv, libacc, Some(ast)) + + | UTLibraryFile(_header, (modident, utsig_opt, utbinds)) -> let (_, modnm) = modident in - let ((_quant, ssig), binds) = typecheck_library_file tyenv abspath utsig_opt utbinds in - let mentry = { mod_signature = ConcStructure(ssig); } in - let tyenv = tyenv |> Typeenv.add_module modnm mentry in - (tyenv, Alist.extend libacc (abspath, binds), docopt) - ) (tyenv, Alist.empty, None) + let (absssig, binds) = + let tyenv = failwith "TODO: make `tyenv` from `tyenv_prim`, `genv`, and `header`" in + typecheck_library_file tyenv abspath utsig_opt utbinds + in + let genv = genv |> GlobalTypeenv.add modnm absssig in + (genv, Alist.extend libacc (abspath, binds), doc_opt) + ) (genv, libacc, None) in let libs = Alist.to_list libacc in if type_check_only then () else - match ast_opt with + match doc_opt with | None -> assert false | Some(ast) -> preprocess_and_evaluate env libs ast abspath_in abspath_out abspath_dump ) diff --git a/src/frontend/openFileDependencyResolver.ml b/src/frontend/openFileDependencyResolver.ml index d0e854e30..628058dbe 100644 --- a/src/frontend/openFileDependencyResolver.ml +++ b/src/frontend/openFileDependencyResolver.ml @@ -4,7 +4,7 @@ open Types type error = - | CyclicFileDependency of (abs_path * file_info) cycle + | CyclicFileDependency of (abs_path * untyped_source_file) cycle | CannotReadFileOwingToSystem of string | LibraryContainsWholeReturnValue of abs_path | DocumentLacksWholeReturnValue of abs_path @@ -65,17 +65,17 @@ let rec register_library_file (graph : FileDependencyGraph.t) (packages : Packag let open ResultMonad in Logging.begin_to_parse_file abspath; let curdir = Filename.dirname (get_abs_path_string abspath) in - let* (header, utsrc) = + let* utsrc = ParserInterface.process_file abspath |> Result.map_error (fun rng -> FailedToParse(rng)) in - let* lib = + let* (header, utsrc) = match utsrc with - | UTLibraryFile(lib) -> return lib - | UTDocumentFile(_) -> err @@ LibraryContainsWholeReturnValue(abspath) + | UTLibraryFile(header, _) -> return (header, utsrc) + | UTDocumentFile(_, _) -> err @@ LibraryContainsWholeReturnValue(abspath) in let (graph, vertex) = - match graph |> FileDependencyGraph.add_vertex abspath (LibraryFile(lib)) with + match graph |> FileDependencyGraph.add_vertex abspath utsrc with | Error(_) -> assert false | Ok(pair) -> pair in @@ -104,17 +104,17 @@ let register_document_file (graph : FileDependencyGraph.t) (packages : PackageNa let open ResultMonad in Logging.begin_to_parse_file abspath_in; let curdir = Filename.dirname (get_abs_path_string abspath_in) in - let* (header, utsrc) = + let* utsrc = ParserInterface.process_file abspath_in |> Result.map_error (fun rng -> FailedToParse(rng)) in - let* utast = + let* (header, utsrc) = match utsrc with - | UTLibraryFile(_) -> err @@ DocumentLacksWholeReturnValue(abspath_in) - | UTDocumentFile(utast) -> return utast + | UTLibraryFile(_) -> err @@ DocumentLacksWholeReturnValue(abspath_in) + | UTDocumentFile(header, _) -> return (header, utsrc) in let (graph, vertex) = - match graph |> FileDependencyGraph.add_vertex abspath_in (DocumentFile(utast)) with + match graph |> FileDependencyGraph.add_vertex abspath_in utsrc with | Error(_) -> assert false | Ok(pair) -> pair in @@ -169,7 +169,7 @@ let register_markdown_file (graph : FileDependencyGraph.t) (setting : string) (a *) -let main (abspath_in : abs_path) : ((abs_path * file_info) list * PackageNameSet.t) ok = +let main (abspath_in : abs_path) : ((abs_path * untyped_source_file) list * PackageNameSet.t) ok = let open ResultMonad in let graph = FileDependencyGraph.empty in let packages = PackageNameSet.empty in diff --git a/src/frontend/openFileDependencyResolver.mli b/src/frontend/openFileDependencyResolver.mli index 2fe4ca29d..0afd3c589 100644 --- a/src/frontend/openFileDependencyResolver.mli +++ b/src/frontend/openFileDependencyResolver.mli @@ -3,10 +3,10 @@ open MyUtil open Types type error = - | CyclicFileDependency of (abs_path * file_info) cycle + | CyclicFileDependency of (abs_path * untyped_source_file) cycle | CannotReadFileOwingToSystem of string | LibraryContainsWholeReturnValue of abs_path | DocumentLacksWholeReturnValue of abs_path | FailedToParse of Range.t -val main : abs_path -> ((abs_path * file_info) list * PackageNameSet.t, error) result +val main : abs_path -> ((abs_path * untyped_source_file) list * PackageNameSet.t, error) result diff --git a/src/frontend/parser.mly b/src/frontend/parser.mly index 61f82246e..b0a73eaa4 100644 --- a/src/frontend/parser.mly +++ b/src/frontend/parser.mly @@ -297,7 +297,7 @@ %right BINOP_TIMES EXACT_TIMES BINOP_DIVIDES MOD %start main -%type main +%type main %type modexpr %type mod_chain %type bind @@ -361,9 +361,9 @@ optterm_nonempty_list(sep, X): ; main: | header=list(headerelem); lib=main_lib; EOI - { (header, UTLibraryFile(lib)) } + { UTLibraryFile(header, lib) } | header=list(headerelem); utast=expr; EOI - { (header, UTDocumentFile(utast)) } + { UTDocumentFile(header, utast) } | rng=EOI { raise (ParseErrorDetail(rng, "empty input")) } ; diff --git a/src/frontend/parserInterface.ml b/src/frontend/parserInterface.ml index ebfdcad31..1cb090e8b 100644 --- a/src/frontend/parserInterface.ml +++ b/src/frontend/parserInterface.ml @@ -7,8 +7,8 @@ open MyUtil open Types -let k_success (utmain : header_element list * untyped_source_file) = - utmain +let k_success (utsrc : untyped_source_file) = + utsrc let k_fail chkpt = diff --git a/src/frontend/parserInterface.mli b/src/frontend/parserInterface.mli index cedb7a4bd..8eae4f9e3 100644 --- a/src/frontend/parserInterface.mli +++ b/src/frontend/parserInterface.mli @@ -2,6 +2,6 @@ open MyUtil open Types -val process_file : abs_path -> (header_element list * Types.untyped_source_file, Range.t) result +val process_file : abs_path -> (untyped_source_file, Range.t) result -val process_text : string -> string -> (header_element list * Types.untyped_source_file, Range.t) result +val process_text : string -> string -> (untyped_source_file, Range.t) result diff --git a/src/frontend/staticEnv.ml b/src/frontend/staticEnv.ml index 9f02dd320..89bf046e9 100644 --- a/src/frontend/staticEnv.ml +++ b/src/frontend/staticEnv.ml @@ -429,4 +429,4 @@ let find_candidates_in_struct_sig (ssig : StructSig.t) (varnm : var_name) : var_ Distance.get_candidates fold_value ssig varnm -type global_type_environment = (signature abstracted) GlobalTypeenv.t +type global_type_environment = (StructSig.t abstracted) GlobalTypeenv.t diff --git a/src/frontend/staticEnv.mli b/src/frontend/staticEnv.mli index 12b5e912a..57475f45e 100644 --- a/src/frontend/staticEnv.mli +++ b/src/frontend/staticEnv.mli @@ -159,4 +159,4 @@ val find_candidates_in_type_environment : Typeenv.t -> var_name -> var_name list val find_candidates_in_struct_sig : StructSig.t -> var_name -> var_name list -type global_type_environment = (signature abstracted) GlobalTypeenv.t +type global_type_environment = (StructSig.t abstracted) GlobalTypeenv.t diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index 1881e1a59..00f3ce88c 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -41,7 +41,7 @@ type header_element = | HeaderUsePackage of module_name ranged | HeaderUse of module_name ranged | HeaderUseOf of module_name ranged * string - +[@@deriving show { with_path = false }] type quantifiability = Quantifiable | Unquantifiable [@@deriving show] @@ -554,10 +554,13 @@ and untyped_parameter_unit = [@@deriving show { with_path = false; }] type untyped_source_file = - | UTLibraryFile of (module_name ranged * untyped_signature option * untyped_binding list) - | UTDocumentFile of untyped_abstract_tree + | UTLibraryFile of header_element list * (module_name ranged * untyped_signature option * untyped_binding list) + | UTDocumentFile of header_element list * untyped_abstract_tree [@@deriving show { with_path = false; }] +type package_info = + unit (* TODO: define this *) + type untyped_letrec_pattern_branch = | UTLetRecPatternBranch of untyped_pattern_tree list * untyped_abstract_tree @@ -1182,13 +1185,6 @@ type 'a cycle = | Cycle of 'a TupleList.t [@@deriving show { with_path = false; }] -type file_info = - | DocumentFile of untyped_abstract_tree - | LibraryFile of (module_name ranged * untyped_signature option * untyped_binding list) - -type package_info = - unit (* TODO: define this *) - module GlobalTypeenv = Map.Make(String) module PackageNameSet = Set.Make(String) diff --git a/src/md/decodeMD.ml b/src/md/decodeMD.ml index a19871aa3..5b326fe4c 100644 --- a/src/md/decodeMD.ml +++ b/src/md/decodeMD.ml @@ -476,8 +476,8 @@ let decode (cmdrcd : command_record) (s : string) = in let utasthead = match ParserInterface.process_text "(markdown)" strheader with - | Ok(([], UTDocumentFile(u))) -> u - | _ -> failwith "TODO (error): invalid header expression" + | Ok(UTDocumentFile([], u)) -> u + | _ -> failwith "TODO (error): invalid header expression" in let blk = normalize_h1 md in (* From c62eb41e6fc106ed4f0e9fcb793e0ed47ae41dc4 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 23 Oct 2022 23:41:04 +0900 Subject: [PATCH 008/288] develop 'add_dependency_to_type_environment' --- src/frontend/main.ml | 34 +++++++++++++++++++++++++++------- src/frontend/staticEnv.ml | 2 +- src/frontend/staticEnv.mli | 2 +- 3 files changed, 29 insertions(+), 9 deletions(-) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index e90edf817..4e5ed4ce6 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1092,6 +1092,26 @@ let make_absolute_if_relative ~(origin : string) (s : string) : abs_path = make_abs_path abspath_str +let add_dependency_to_type_environment header genv tyenv = + header |> List.fold_left (fun tyenv headerelem -> + match headerelem with + | HeaderUse(_) -> + assert false + + | HeaderUsePackage((_, modnm)) + | HeaderUseOf((_, modnm), _) -> + begin + match genv |> GlobalTypeenv.find_opt modnm with + | None -> + assert false + + | Some(ssig) -> + let mentry = { mod_signature = ConcStructure(ssig) } in + tyenv |> Typeenv.add_module modnm mentry + end + ) tyenv + + let build ~(fpath_in : string) ~(fpath_out_opt : string option) @@ -1160,7 +1180,7 @@ let build | (PdfMode, None) -> make_abs_path (Printf.sprintf "%s.pdf" basename_without_extension) in Logging.target_file abspath_out; - let (_tyenv_prim, env, dump_file_exists) = initialize abspath_dump in + let (tyenv_prim, env, dump_file_exists) = initialize abspath_dump in Logging.dump_file dump_file_exists abspath_dump; (* Resolve dependency of the document and the local source files: *) @@ -1196,20 +1216,20 @@ let build let (_, libacc, doc_opt) = sorted_locals |> List.fold_left (fun (genv, libacc, doc_opt) (abspath, utsrc) -> match utsrc with - | UTDocumentFile(_header, utast) -> + | UTDocumentFile(header, utast) -> let ast = - let tyenv = failwith "TODO: make `tyenv` from `tyenv_prim`, `genv`, and `header`" in + let tyenv = tyenv_prim |> add_dependency_to_type_environment header genv in typecheck_document_file tyenv abspath utast in (genv, libacc, Some(ast)) - | UTLibraryFile(_header, (modident, utsig_opt, utbinds)) -> + | UTLibraryFile(header, (modident, utsig_opt, utbinds)) -> let (_, modnm) = modident in - let (absssig, binds) = - let tyenv = failwith "TODO: make `tyenv` from `tyenv_prim`, `genv`, and `header`" in + let ((_quant, ssig), binds) = + let tyenv = tyenv_prim |> add_dependency_to_type_environment header genv in typecheck_library_file tyenv abspath utsig_opt utbinds in - let genv = genv |> GlobalTypeenv.add modnm absssig in + let genv = genv |> GlobalTypeenv.add modnm ssig in (genv, Alist.extend libacc (abspath, binds), doc_opt) ) (genv, libacc, None) in diff --git a/src/frontend/staticEnv.ml b/src/frontend/staticEnv.ml index 89bf046e9..bebbea8b9 100644 --- a/src/frontend/staticEnv.ml +++ b/src/frontend/staticEnv.ml @@ -429,4 +429,4 @@ let find_candidates_in_struct_sig (ssig : StructSig.t) (varnm : var_name) : var_ Distance.get_candidates fold_value ssig varnm -type global_type_environment = (StructSig.t abstracted) GlobalTypeenv.t +type global_type_environment = StructSig.t GlobalTypeenv.t diff --git a/src/frontend/staticEnv.mli b/src/frontend/staticEnv.mli index 57475f45e..1a3b7cc48 100644 --- a/src/frontend/staticEnv.mli +++ b/src/frontend/staticEnv.mli @@ -159,4 +159,4 @@ val find_candidates_in_type_environment : Typeenv.t -> var_name -> var_name list val find_candidates_in_struct_sig : StructSig.t -> var_name -> var_name list -type global_type_environment = (StructSig.t abstracted) GlobalTypeenv.t +type global_type_environment = StructSig.t GlobalTypeenv.t From 3cbd877b422c8b9fa249ce62f127ff9535c7acfb Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 24 Oct 2022 00:55:08 +0900 Subject: [PATCH 009/288] begin to add 'ClosedFileDependencyResolver' --- src/frontend/closedFileDependencyResolver.ml | 7 ++ src/frontend/main.ml | 116 ++++--------------- src/frontend/packageChecker.ml | 110 +++++++++++++++++- 3 files changed, 139 insertions(+), 94 deletions(-) create mode 100644 src/frontend/closedFileDependencyResolver.ml diff --git a/src/frontend/closedFileDependencyResolver.ml b/src/frontend/closedFileDependencyResolver.ml new file mode 100644 index 000000000..8ce3f7fcd --- /dev/null +++ b/src/frontend/closedFileDependencyResolver.ml @@ -0,0 +1,7 @@ + +open MyUtil + + +let main _utlibs = + let open ResultMonad in + return [] diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 4e5ed4ce6..0a7b71ec5 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -6,12 +6,10 @@ open TypeError exception NoLibraryRootDesignation -exception NotADocumentFile of abs_path * Typeenv.t * mono_type -exception NotAStringFile of abs_path * Typeenv.t * mono_type exception ShouldSpecifyOutputFile exception OpenFileDependencyError of OpenFileDependencyResolver.error exception OpenPackageDependencyError of OpenPackageDependencyResolver.error -exception TypeError of type_error +exception PackageCheckError of PackageChecker.error (* Initialization that should be performed before every cross-reference-solving loop *) @@ -70,37 +68,6 @@ let unfreeze_environment ((valenv, stenvref, stmap) : frozen_environment) : envi (valenv, ref stenv) -let typecheck_library_file (tyenv : Typeenv.t) (abspath_in : abs_path) (utsig_opt : untyped_signature option) (utbinds : untyped_binding list) : StructSig.t abstracted * binding list = - Logging.begin_to_typecheck_file abspath_in; - let pair = - match ModuleTypechecker.main tyenv utsig_opt utbinds with - | Ok(pair) -> pair - | Error(e) -> raise (TypeError(e)) - in - Logging.pass_type_check None; - pair - - -let typecheck_document_file (tyenv : Typeenv.t) (abspath_in : abs_path) (utast : untyped_abstract_tree) : abstract_tree = - Logging.begin_to_typecheck_file abspath_in; - let (ty, ast) = - match Typechecker.main Stage1 tyenv utast with - | Ok(pair) -> pair - | Error(e) -> raise (TypeError(e)) - in - Logging.pass_type_check (Some(Display.show_mono_type ty)); - if OptionState.is_text_mode () then - if Typechecker.are_unifiable ty (Range.dummy "text-mode", BaseType(StringType)) then - ast - else - raise (NotAStringFile(abspath_in, tyenv, ty)) - else - if Typechecker.are_unifiable ty (Range.dummy "pdf-mode", BaseType(DocumentType)) then - ast - else - raise (NotADocumentFile(abspath_in, tyenv, ty)) - - let output_pdf (pdfret : HandlePdf.t) : unit = HandlePdf.write_to_file pdfret @@ -466,20 +433,6 @@ let error_log_environment suspended = NormalLine("candidate paths:"); ] (pathcands |> List.map (fun abspath -> DisplayLine(get_abs_path_string abspath)))) - | NotADocumentFile(abspath_in, _tyenv, ty) -> - let fname = convert_abs_path_to_show abspath_in in - report_error Typechecker [ - NormalLine(Printf.sprintf "file '%s' is not a document file; it is of type" fname); - DisplayLine(Display.show_mono_type ty); - ] - - | NotAStringFile(abspath_in, _tyenv, ty) -> - let fname = convert_abs_path_to_show abspath_in in - report_error Typechecker [ - NormalLine(Printf.sprintf "file '%s' is not a file for generating text; it is of type" fname); - DisplayLine(Display.show_mono_type ty); - ] - | ShouldSpecifyOutputFile -> report_error Interface [ NormalLine("should specify output file for text mode."); @@ -636,7 +589,21 @@ let error_log_environment suspended = NormalLine(Printf.sprintf "missing required key '%s'." key); ] - | TypeError(tyerr) -> + | PackageCheckError(NotADocumentFile(abspath_in, _tyenv, ty)) -> + let fname = convert_abs_path_to_show abspath_in in + report_error Typechecker [ + NormalLine(Printf.sprintf "file '%s' is not a document file; it is of type" fname); + DisplayLine(Display.show_mono_type ty); + ] + + | PackageCheckError(NotAStringFile(abspath_in, _tyenv, ty)) -> + let fname = convert_abs_path_to_show abspath_in in + report_error Typechecker [ + NormalLine(Printf.sprintf "file '%s' is not a file for generating text; it is of type" fname); + DisplayLine(Display.show_mono_type ty); + ] + + | PackageCheckError(TypeError(tyerr)) -> begin match tyerr with | UndefinedVariable(rng, varnm, candidates) -> @@ -1092,26 +1059,6 @@ let make_absolute_if_relative ~(origin : string) (s : string) : abs_path = make_abs_path abspath_str -let add_dependency_to_type_environment header genv tyenv = - header |> List.fold_left (fun tyenv headerelem -> - match headerelem with - | HeaderUse(_) -> - assert false - - | HeaderUsePackage((_, modnm)) - | HeaderUseOf((_, modnm), _) -> - begin - match genv |> GlobalTypeenv.find_opt modnm with - | None -> - assert false - - | Some(ssig) -> - let mentry = { mod_signature = ConcStructure(ssig) } in - tyenv |> Typeenv.add_module modnm mentry - end - ) tyenv - - let build ~(fpath_in : string) ~(fpath_out_opt : string option) @@ -1201,39 +1148,24 @@ let build let (genv, libacc) = sorted_packages |> List.fold_left (fun (genv, libacc) package -> let main_module_name = failwith "TODO: main_module_name; extract it from `package`" in - let (absmodsig, libs) = - match PackageChecker.main genv package with + let (ssig, libs) = + match PackageChecker.main tyenv_prim genv package with | Ok(pair) -> pair | Error(_e) -> failwith "TODO (error): PackageChecker, Error" in - let genv = genv |> GlobalTypeenv.add main_module_name absmodsig in + let genv = genv |> GlobalTypeenv.add main_module_name ssig in let libacc = Alist.append libacc libs in (genv, libacc) ) (GlobalTypeenv.empty, Alist.empty) in (* Typechecking and elaboration: *) - let (_, libacc, doc_opt) = - sorted_locals |> List.fold_left (fun (genv, libacc, doc_opt) (abspath, utsrc) -> - match utsrc with - | UTDocumentFile(header, utast) -> - let ast = - let tyenv = tyenv_prim |> add_dependency_to_type_environment header genv in - typecheck_document_file tyenv abspath utast - in - (genv, libacc, Some(ast)) - - | UTLibraryFile(header, (modident, utsig_opt, utbinds)) -> - let (_, modnm) = modident in - let ((_quant, ssig), binds) = - let tyenv = tyenv_prim |> add_dependency_to_type_environment header genv in - typecheck_library_file tyenv abspath utsig_opt utbinds - in - let genv = genv |> GlobalTypeenv.add modnm ssig in - (genv, Alist.extend libacc (abspath, binds), doc_opt) - ) (genv, libacc, None) + let (libs_local, doc_opt) = + match PackageChecker.main_document tyenv_prim genv sorted_locals with + | Ok(pair) -> pair + | Error(e) -> raise (PackageCheckError(e)) in - let libs = Alist.to_list libacc in + let libs = Alist.to_list (Alist.append libacc libs_local) in if type_check_only then () diff --git a/src/frontend/packageChecker.ml b/src/frontend/packageChecker.ml index fed7958f4..319c9098f 100644 --- a/src/frontend/packageChecker.ml +++ b/src/frontend/packageChecker.ml @@ -1,6 +1,112 @@ +open MyUtil open Types open StaticEnv +open TypeError -let main (_genv : global_type_environment) (_package : package_info) = - failwith "TODO: PackageChecker" + +type error = + | TypeError of type_error + | NotADocumentFile of abs_path * Typeenv.t * mono_type + | NotAStringFile of abs_path * Typeenv.t * mono_type + +type 'a ok = ('a, error) result + + +let add_dependency_to_type_environment (header : header_element list) (genv : global_type_environment) (tyenv : Typeenv.t) = + header |> List.fold_left (fun tyenv headerelem -> + match headerelem with + | HeaderUse(_) -> + assert false + + | HeaderUsePackage((_, modnm)) + | HeaderUseOf((_, modnm), _) -> + begin + match genv |> GlobalTypeenv.find_opt modnm with + | None -> + assert false + + | Some(ssig) -> + let mentry = { mod_signature = ConcStructure(ssig) } in + tyenv |> Typeenv.add_module modnm mentry + end + ) tyenv + + +let typecheck_library_file (tyenv : Typeenv.t) (abspath_in : abs_path) (utsig_opt : untyped_signature option) (utbinds : untyped_binding list) : (StructSig.t abstracted * binding list) ok = + let open ResultMonad in + Logging.begin_to_typecheck_file abspath_in; + let* ret = ModuleTypechecker.main tyenv utsig_opt utbinds |> Result.map_error (fun tyerr -> TypeError(tyerr)) in + Logging.pass_type_check None; + return ret + + +let typecheck_document_file (tyenv : Typeenv.t) (abspath_in : abs_path) (utast : untyped_abstract_tree) : abstract_tree ok = + let open ResultMonad in + Logging.begin_to_typecheck_file abspath_in; + let* (ty, ast) = Typechecker.main Stage1 tyenv utast |> Result.map_error (fun tyerr -> TypeError(tyerr)) in + Logging.pass_type_check (Some(Display.show_mono_type ty)); + if OptionState.is_text_mode () then + if Typechecker.are_unifiable ty (Range.dummy "text-mode", BaseType(StringType)) then + return ast + else + err (NotAStringFile(abspath_in, tyenv, ty)) + else + if Typechecker.are_unifiable ty (Range.dummy "pdf-mode", BaseType(DocumentType)) then + return ast + else + err (NotADocumentFile(abspath_in, tyenv, ty)) + + +let main (tyenv_prim : Typeenv.t) (genv : global_type_environment) (_package : package_info) : (StructSig.t * (abs_path * binding list) list) ok = + let open ResultMonad in + let utlibs = failwith "TODO: extract `utlibs` from `package`" in + + (* Resolve dependency among the source files in the package: *) + let* sorted_utlibs = ClosedFileDependencyResolver.main utlibs in + + (* Typecheck each source file: *) + let* (_genv, libacc) = + sorted_utlibs |> foldM (fun (genv, libacc) (abspath, utlib) -> + let (header, (modident, utsig_opt, utbinds)) = utlib in + let (_, modnm) = modident in + let* ((_quant, ssig), binds) = + let tyenv = tyenv_prim |> add_dependency_to_type_environment header genv in + typecheck_library_file tyenv abspath utsig_opt utbinds + in + let genv = genv |> GlobalTypeenv.add modnm ssig in + return (genv, Alist.extend libacc (abspath, binds)) + ) (genv, Alist.empty) + in + let libs = Alist.to_list libacc in + + (* TODO: check the main module *) + let ssig = failwith "TODO: PackageChecker, check the main module" in + return (ssig, libs) + + +let main_document (tyenv_prim : Typeenv.t) (genv : global_type_environment) sorted_locals = + let open ResultMonad in + let* (_, libacc, doc_opt) = + sorted_locals |> foldM (fun (genv, libacc, doc_opt) (abspath, utsrc) -> + match utsrc with + | UTDocumentFile(header, utast) -> + let* ast = + let tyenv = tyenv_prim |> add_dependency_to_type_environment header genv in + typecheck_document_file tyenv abspath utast + in + return (genv, libacc, Some(ast)) + + | UTLibraryFile(header, (modident, utsig_opt, utbinds)) -> + let (_, modnm) = modident in + let* ((_quant, ssig), binds) = + let tyenv = tyenv_prim |> add_dependency_to_type_environment header genv in + typecheck_library_file tyenv abspath utsig_opt utbinds + in + let genv = genv |> GlobalTypeenv.add modnm ssig in + return (genv, Alist.extend libacc (abspath, binds), doc_opt) + + ) (genv, Alist.empty, None) + in + let libs = Alist.to_list libacc in + return (libs, doc_opt) From a06051a8272e3486ec4bcc2fc549256fbda93172 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 24 Oct 2022 01:08:25 +0900 Subject: [PATCH 010/288] slight improvement of 'ClosedFileDependencyResolver' --- src/frontend/closedFileDependencyResolver.ml | 8 +++++++- src/frontend/main.ml | 3 +++ src/frontend/packageChecker.ml | 13 ++++++++----- src/frontend/types.cppo.ml | 12 ++++++++++-- 4 files changed, 28 insertions(+), 8 deletions(-) diff --git a/src/frontend/closedFileDependencyResolver.ml b/src/frontend/closedFileDependencyResolver.ml index 8ce3f7fcd..ec2e28b82 100644 --- a/src/frontend/closedFileDependencyResolver.ml +++ b/src/frontend/closedFileDependencyResolver.ml @@ -1,7 +1,13 @@ open MyUtil +open Types +type error = + unit (* TODO: define this *) -let main _utlibs = +type 'a ok = ('a, error) result + + +let main (_utlibs : (abs_path * untyped_library_file) list) : ((abs_path * untyped_library_file) list) ok = let open ResultMonad in return [] diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 0a7b71ec5..6902133bd 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -603,6 +603,9 @@ let error_log_environment suspended = DisplayLine(Display.show_mono_type ty); ] + | PackageCheckError(ClosedFileDependencyError(_)) -> + failwith "TODO (error): ClosedFileDependencyError" + | PackageCheckError(TypeError(tyerr)) -> begin match tyerr with diff --git a/src/frontend/packageChecker.ml b/src/frontend/packageChecker.ml index 319c9098f..7c8925d65 100644 --- a/src/frontend/packageChecker.ml +++ b/src/frontend/packageChecker.ml @@ -6,9 +6,10 @@ open TypeError type error = - | TypeError of type_error - | NotADocumentFile of abs_path * Typeenv.t * mono_type - | NotAStringFile of abs_path * Typeenv.t * mono_type + | TypeError of type_error + | ClosedFileDependencyError of ClosedFileDependencyResolver.error + | NotADocumentFile of abs_path * Typeenv.t * mono_type + | NotAStringFile of abs_path * Typeenv.t * mono_type type 'a ok = ('a, error) result @@ -63,7 +64,9 @@ let main (tyenv_prim : Typeenv.t) (genv : global_type_environment) (_package : p let utlibs = failwith "TODO: extract `utlibs` from `package`" in (* Resolve dependency among the source files in the package: *) - let* sorted_utlibs = ClosedFileDependencyResolver.main utlibs in + let* sorted_utlibs = + ClosedFileDependencyResolver.main utlibs |> Result.map_error (fun e -> ClosedFileDependencyError(e)) + in (* Typecheck each source file: *) let* (_genv, libacc) = @@ -85,7 +88,7 @@ let main (tyenv_prim : Typeenv.t) (genv : global_type_environment) (_package : p return (ssig, libs) -let main_document (tyenv_prim : Typeenv.t) (genv : global_type_environment) sorted_locals = +let main_document (tyenv_prim : Typeenv.t) (genv : global_type_environment) (sorted_locals : (abs_path * untyped_source_file) list) : ((abs_path * binding list) list * abstract_tree option) ok = let open ResultMonad in let* (_, libacc, doc_opt) = sorted_locals |> foldM (fun (genv, libacc, doc_opt) (abspath, utsrc) -> diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index 00f3ce88c..d2d9441bc 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -553,9 +553,17 @@ and untyped_parameter_unit = | UTParameterUnit of (label ranged * var_name ranged) list * untyped_pattern_tree * manual_type option [@@deriving show { with_path = false; }] +type untyped_library_file = + header_element list * (module_name ranged * untyped_signature option * untyped_binding list) +[@@deriving show { with_path = false; }] + +type untyped_document_file = + header_element list * untyped_abstract_tree +[@@deriving show { with_path = false; }] + type untyped_source_file = - | UTLibraryFile of header_element list * (module_name ranged * untyped_signature option * untyped_binding list) - | UTDocumentFile of header_element list * untyped_abstract_tree + | UTLibraryFile of untyped_library_file + | UTDocumentFile of untyped_document_file [@@deriving show { with_path = false; }] type package_info = From eae050ab5e34f4fd7319fdab3717d773bcaf1d43 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 24 Oct 2022 01:51:17 +0900 Subject: [PATCH 011/288] refactor 'FileDependencyGraph' --- src/frontend/fileDependencyGraph.ml | 11 +- src/frontend/fileDependencyGraph.mli | 4 +- src/frontend/main.ml | 14 +- src/frontend/openFileDependencyResolver.ml | 142 ++++++++++---------- src/frontend/openFileDependencyResolver.mli | 4 +- src/frontend/packageChecker.ml | 43 +++--- src/myUtil.ml | 7 + src/myUtil.mli | 6 + 8 files changed, 115 insertions(+), 116 deletions(-) diff --git a/src/frontend/fileDependencyGraph.ml b/src/frontend/fileDependencyGraph.ml index 98c71fa20..b8c4bba8f 100644 --- a/src/frontend/fileDependencyGraph.ml +++ b/src/frontend/fileDependencyGraph.ml @@ -2,23 +2,18 @@ open MyUtil open Types -module AbsPath = struct - type t = abs_path - - let compare ap1 ap2 = String.compare (get_abs_path_string ap1) (get_abs_path_string ap2) -end module Impl = DependencyGraph.Make(AbsPath) type vertex = Impl.Vertex.t -type t = untyped_source_file Impl.t +type t = untyped_library_file Impl.t let empty = Impl.empty -let add_vertex (abspath : abs_path) (data : untyped_source_file) (graph : t) : (t * vertex, untyped_source_file * vertex) result = +let add_vertex (abspath : abs_path) (data : untyped_library_file) (graph : t) : (t * vertex, untyped_library_file * vertex) result = Impl.add_vertex abspath data graph @@ -30,5 +25,5 @@ let add_edge ~(from : vertex) ~(to_ : vertex) (graph : t) : t = Impl.add_edge ~from ~to_ graph -let topological_sort (graph : t) : ((abs_path * untyped_source_file) list, (abs_path * untyped_source_file) cycle) result = +let topological_sort (graph : t) : ((abs_path * untyped_library_file) list, (abs_path * untyped_library_file) cycle) result = Impl.topological_sort graph diff --git a/src/frontend/fileDependencyGraph.mli b/src/frontend/fileDependencyGraph.mli index 69a6032f7..c21359c28 100644 --- a/src/frontend/fileDependencyGraph.mli +++ b/src/frontend/fileDependencyGraph.mli @@ -8,10 +8,10 @@ type t val empty : t -val add_vertex : abs_path -> untyped_source_file -> t -> (t * vertex, untyped_source_file * vertex) result +val add_vertex : abs_path -> untyped_library_file -> t -> (t * vertex, untyped_library_file * vertex) result val get_vertex : abs_path -> t -> vertex option val add_edge : from:vertex -> to_:vertex -> t -> t -val topological_sort : t -> ((abs_path * untyped_source_file) list, (abs_path * untyped_source_file) cycle) result +val topological_sort : t -> ((abs_path * untyped_library_file) list, (abs_path * untyped_library_file) cycle) result diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 6902133bd..ccb591092 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1134,10 +1134,10 @@ let build Logging.dump_file dump_file_exists abspath_dump; (* Resolve dependency of the document and the local source files: *) - let (sorted_locals, package_names) = + let (package_names, sorted_locals, utdoc) = match OpenFileDependencyResolver.main abspath_in with - | Ok(pair) -> pair - | Error(e) -> raise (OpenFileDependencyError(e)) + | Ok(triple) -> triple + | Error(e) -> raise (OpenFileDependencyError(e)) in (* Resolve dependency among packages that the document depends on: *) @@ -1163,8 +1163,8 @@ let build in (* Typechecking and elaboration: *) - let (libs_local, doc_opt) = - match PackageChecker.main_document tyenv_prim genv sorted_locals with + let (libs_local, ast_doc) = + match PackageChecker.main_document tyenv_prim genv sorted_locals (abspath_in, utdoc) with | Ok(pair) -> pair | Error(e) -> raise (PackageCheckError(e)) in @@ -1173,7 +1173,5 @@ let build if type_check_only then () else - match doc_opt with - | None -> assert false - | Some(ast) -> preprocess_and_evaluate env libs ast abspath_in abspath_out abspath_dump + preprocess_and_evaluate env libs ast_doc abspath_in abspath_out abspath_dump ) diff --git a/src/frontend/openFileDependencyResolver.ml b/src/frontend/openFileDependencyResolver.ml index 628058dbe..b863f7587 100644 --- a/src/frontend/openFileDependencyResolver.ml +++ b/src/frontend/openFileDependencyResolver.ml @@ -4,7 +4,7 @@ open Types type error = - | CyclicFileDependency of (abs_path * untyped_source_file) cycle + | CyclicFileDependency of (abs_path * untyped_library_file) cycle | CannotReadFileOwingToSystem of string | LibraryContainsWholeReturnValue of abs_path | DocumentLacksWholeReturnValue of abs_path @@ -61,46 +61,49 @@ let get_header (curdir : string) (headerelem : header_element) : local_or_packag Local(modident, abspath) -let rec register_library_file (graph : FileDependencyGraph.t) (packages : PackageNameSet.t) ~prev:(vertex_prev : FileDependencyGraph.vertex) (abspath : abs_path) : (FileDependencyGraph.t * PackageNameSet.t) ok = +let rec register_library_file (graph : FileDependencyGraph.t) (package_names : PackageNameSet.t) ~prev:(vertex_prev_opt : FileDependencyGraph.vertex option) (abspath : abs_path) : (PackageNameSet.t * FileDependencyGraph.t) ok = let open ResultMonad in - Logging.begin_to_parse_file abspath; - let curdir = Filename.dirname (get_abs_path_string abspath) in - let* utsrc = - ParserInterface.process_file abspath - |> Result.map_error (fun rng -> FailedToParse(rng)) - in - let* (header, utsrc) = - match utsrc with - | UTLibraryFile(header, _) -> return (header, utsrc) - | UTDocumentFile(_, _) -> err @@ LibraryContainsWholeReturnValue(abspath) - in - let (graph, vertex) = - match graph |> FileDependencyGraph.add_vertex abspath utsrc with - | Error(_) -> assert false - | Ok(pair) -> pair - in - let graph = FileDependencyGraph.add_edge ~from:vertex_prev ~to_:vertex graph in - header |> foldM (fun (graph, packages) headerelem -> - match get_header curdir headerelem with - | Package((_, main_module_name)) -> - return (graph, packages |> PackageNameSet.add main_module_name) - - | Local(_modident_sub, abspath_sub) -> - begin - match graph |> FileDependencyGraph.get_vertex abspath_sub with - | Some(vertex_sub) -> - (* If `abs_path` has already been parsed *) - let graph = graph |> FileDependencyGraph.add_edge ~from:vertex ~to_:vertex_sub in - return (graph, packages) - - | None -> - register_library_file graph packages ~prev:vertex abspath_sub - end - - ) (graph, packages) - - -let register_document_file (graph : FileDependencyGraph.t) (packages : PackageNameSet.t) (abspath_in : abs_path) : (FileDependencyGraph.t * PackageNameSet.t) ok = + match graph |> FileDependencyGraph.get_vertex abspath with + | Some(vertex) -> + (* If `abspath` has already been parsed: *) + let graph = + match vertex_prev_opt with + | None -> graph + | Some(vertex_prev) -> graph |> FileDependencyGraph.add_edge ~from:vertex_prev ~to_:vertex + in + return (package_names, graph) + + | None -> + let curdir = Filename.dirname (get_abs_path_string abspath) in + let* utlib = + Logging.begin_to_parse_file abspath; + let* utsrc = ParserInterface.process_file abspath |> Result.map_error (fun rng -> FailedToParse(rng)) in + match utsrc with + | UTLibraryFile(utlib) -> return utlib + | UTDocumentFile(_, _) -> err @@ LibraryContainsWholeReturnValue(abspath) + in + let (header, _) = utlib in + let (graph, vertex) = + match graph |> FileDependencyGraph.add_vertex abspath utlib with + | Error(_vertex) -> assert false + | Ok(pair) -> pair + in + let graph = + match vertex_prev_opt with + | None -> graph + | Some(vertex_prev) -> graph |> FileDependencyGraph.add_edge ~from:vertex_prev ~to_:vertex + in + header |> foldM (fun (package_names, graph) headerelem -> + match get_header curdir headerelem with + | Package((_, main_module_name)) -> + return (package_names |> PackageNameSet.add main_module_name, graph) + + | Local(_modident_sub, abspath_sub) -> + register_library_file graph package_names ~prev:(Some(vertex)) abspath_sub + ) (package_names, graph) + + +let register_document_file (graph : FileDependencyGraph.t) (package_names : PackageNameSet.t) (abspath_in : abs_path) : (PackageNameSet.t * FileDependencyGraph.t * untyped_document_file) ok = let open ResultMonad in Logging.begin_to_parse_file abspath_in; let curdir = Filename.dirname (get_abs_path_string abspath_in) in @@ -108,34 +111,23 @@ let register_document_file (graph : FileDependencyGraph.t) (packages : PackageNa ParserInterface.process_file abspath_in |> Result.map_error (fun rng -> FailedToParse(rng)) in - let* (header, utsrc) = + let* utdoc = match utsrc with - | UTLibraryFile(_) -> err @@ DocumentLacksWholeReturnValue(abspath_in) - | UTDocumentFile(header, _) -> return (header, utsrc) + | UTLibraryFile(_) -> err @@ DocumentLacksWholeReturnValue(abspath_in) + | UTDocumentFile(utdoc) -> return utdoc in - let (graph, vertex) = - match graph |> FileDependencyGraph.add_vertex abspath_in utsrc with - | Error(_) -> assert false - | Ok(pair) -> pair - in - header |> foldM (fun (graph, packages) headerelem -> - match get_header curdir headerelem with - | Package((_, main_module_name)) -> - return (graph, packages |> PackageNameSet.add main_module_name) - - | Local(_, abspath_sub) -> - begin - match graph |> FileDependencyGraph.get_vertex abspath_sub with - | Some(vertex_sub) -> - let graph = graph |> FileDependencyGraph.add_edge ~from:vertex ~to_:vertex_sub in - return (graph, packages) - - | None -> - register_library_file graph packages ~prev:vertex abspath_sub - end - - ) (graph, packages) + let (header, _) = utdoc in + let* (package_names, graph) = + header |> foldM (fun (package_names, graph) headerelem -> + match get_header curdir headerelem with + | Package((_, main_module_name)) -> + return (package_names |> PackageNameSet.add main_module_name, graph) + | Local(_, abspath_sub) -> + register_library_file graph package_names ~prev:None abspath_sub + ) (package_names, graph) + in + return (package_names, graph, utdoc) (* let register_markdown_file (graph : FileDependencyGraph.t) (setting : string) (abspath_in : abs_path) : FileDependencyGraph.t = @@ -169,18 +161,20 @@ let register_markdown_file (graph : FileDependencyGraph.t) (setting : string) (a *) -let main (abspath_in : abs_path) : ((abs_path * untyped_source_file) list * PackageNameSet.t) ok = +let main (abspath_in : abs_path) : (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file) ok = let open ResultMonad in let graph = FileDependencyGraph.empty in - let packages = PackageNameSet.empty in - let* (graph, packages) = + let package_names = PackageNameSet.empty in + let* (package_names, graph, utdoc) = match OptionState.get_input_kind () with | OptionState.SATySFi -> if has_library_extension abspath_in && OptionState.is_type_check_only () then - let vertex = failwith "TODO: type-check-only" in - register_library_file graph packages ~prev:vertex abspath_in + failwith "TODO: --type-check-only" +(* + register_library_file graph package_names ~prev:None abspath_in +*) else - register_document_file graph packages abspath_in + register_document_file graph package_names abspath_in | OptionState.Markdown(_setting) -> failwith "TODO: Markdown" @@ -188,8 +182,8 @@ let main (abspath_in : abs_path) : ((abs_path * untyped_source_file) list * Pack register_markdown_file graph setting abspath_in *) in - begin + let* sorted_locals = FileDependencyGraph.topological_sort graph |> Result.map_error (fun cycle -> CyclicFileDependency(cycle)) - end >>= fun inputs -> - return (inputs, packages) + in + return (package_names, sorted_locals, utdoc) diff --git a/src/frontend/openFileDependencyResolver.mli b/src/frontend/openFileDependencyResolver.mli index 0afd3c589..4bf14a8a7 100644 --- a/src/frontend/openFileDependencyResolver.mli +++ b/src/frontend/openFileDependencyResolver.mli @@ -3,10 +3,10 @@ open MyUtil open Types type error = - | CyclicFileDependency of (abs_path * untyped_source_file) cycle + | CyclicFileDependency of (abs_path * untyped_library_file) cycle | CannotReadFileOwingToSystem of string | LibraryContainsWholeReturnValue of abs_path | DocumentLacksWholeReturnValue of abs_path | FailedToParse of Range.t -val main : abs_path -> ((abs_path * untyped_source_file) list * PackageNameSet.t, error) result +val main : abs_path -> (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file, error) result diff --git a/src/frontend/packageChecker.ml b/src/frontend/packageChecker.ml index 7c8925d65..784bca81b 100644 --- a/src/frontend/packageChecker.ml +++ b/src/frontend/packageChecker.ml @@ -88,28 +88,27 @@ let main (tyenv_prim : Typeenv.t) (genv : global_type_environment) (_package : p return (ssig, libs) -let main_document (tyenv_prim : Typeenv.t) (genv : global_type_environment) (sorted_locals : (abs_path * untyped_source_file) list) : ((abs_path * binding list) list * abstract_tree option) ok = +let main_document (tyenv_prim : Typeenv.t) (genv : global_type_environment) (sorted_locals : (abs_path * untyped_library_file) list) (utdoc : abs_path * untyped_document_file) : ((abs_path * binding list) list * abstract_tree) ok = let open ResultMonad in - let* (_, libacc, doc_opt) = - sorted_locals |> foldM (fun (genv, libacc, doc_opt) (abspath, utsrc) -> - match utsrc with - | UTDocumentFile(header, utast) -> - let* ast = - let tyenv = tyenv_prim |> add_dependency_to_type_environment header genv in - typecheck_document_file tyenv abspath utast - in - return (genv, libacc, Some(ast)) - - | UTLibraryFile(header, (modident, utsig_opt, utbinds)) -> - let (_, modnm) = modident in - let* ((_quant, ssig), binds) = - let tyenv = tyenv_prim |> add_dependency_to_type_environment header genv in - typecheck_library_file tyenv abspath utsig_opt utbinds - in - let genv = genv |> GlobalTypeenv.add modnm ssig in - return (genv, Alist.extend libacc (abspath, binds), doc_opt) - - ) (genv, Alist.empty, None) + let* (_, libacc) = + sorted_locals |> foldM (fun (genv, libacc) (abspath, utlib) -> + let (header, (modident, utsig_opt, utbinds)) = utlib in + let (_, modnm) = modident in + let* ((_quant, ssig), binds) = + let tyenv = tyenv_prim |> add_dependency_to_type_environment header genv in + typecheck_library_file tyenv abspath utsig_opt utbinds + in + let genv = genv |> GlobalTypeenv.add modnm ssig in + return (genv, Alist.extend libacc (abspath, binds)) + ) (genv, Alist.empty) in let libs = Alist.to_list libacc in - return (libs, doc_opt) + + (* Typecheck the document: *) + let* ast_doc = + let (abspath, (header, utast)) = utdoc in + let tyenv = tyenv_prim |> add_dependency_to_type_environment header genv in + typecheck_document_file tyenv abspath utast + in + + return (libs, ast_doc) diff --git a/src/myUtil.ml b/src/myUtil.ml index 1fd9b9e56..c29e4fbfa 100644 --- a/src/myUtil.ml +++ b/src/myUtil.ml @@ -254,3 +254,10 @@ let get_abs_path_string (AbsPath(pathstr)) = pathstr let get_lib_path_string (LibPath(pathstr)) = pathstr let get_abs_path_extension (AbsPath(pathstr)) = Filename.extension pathstr + + +module AbsPath = struct + type t = abs_path + + let compare ap1 ap2 = String.compare (get_abs_path_string ap1) (get_abs_path_string ap2) +end diff --git a/src/myUtil.mli b/src/myUtil.mli index 4522f2947..9295ab2a9 100644 --- a/src/myUtil.mli +++ b/src/myUtil.mli @@ -78,3 +78,9 @@ val get_abs_path_string : abs_path -> string val get_lib_path_string : lib_path -> string val get_abs_path_extension : abs_path -> string + +module AbsPath : sig + type t = abs_path + + val compare : t -> t -> int +end From 63b8eedd3b5c3f232067f507713907b9a1d2346b Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 24 Oct 2022 02:11:52 +0900 Subject: [PATCH 012/288] develop 'ClosedFileDependencyResolver' --- src/frontend/closedFileDependencyResolver.ml | 56 ++++++++++++++++++- src/frontend/closedFileDependencyResolver.mli | 9 +++ 2 files changed, 62 insertions(+), 3 deletions(-) create mode 100644 src/frontend/closedFileDependencyResolver.mli diff --git a/src/frontend/closedFileDependencyResolver.ml b/src/frontend/closedFileDependencyResolver.ml index ec2e28b82..85b0d155f 100644 --- a/src/frontend/closedFileDependencyResolver.ml +++ b/src/frontend/closedFileDependencyResolver.ml @@ -3,11 +3,61 @@ open MyUtil open Types type error = - unit (* TODO: define this *) + | FileModuleNotFound of Range.t * module_name + | CyclicFileDependency of (abs_path * untyped_library_file) cycle type 'a ok = ('a, error) result -let main (_utlibs : (abs_path * untyped_library_file) list) : ((abs_path * untyped_library_file) list) ok = +let main (utlibs : (abs_path * untyped_library_file) list) : ((abs_path * untyped_library_file) list) ok = let open ResultMonad in - return [] + + (* Add vertices: *) + let (graph, modnm_to_path, entryacc) = + utlibs |> List.fold_left (fun (graph, modnm_to_path, entryacc) (abspath, utlib) -> + let (_, ((_, modnm), _, _)) = utlib in + let (graph, vertex) = + match graph |> FileDependencyGraph.add_vertex abspath utlib with + | Error(_) -> assert false + | Ok(pair) -> pair + in + let entry = (utlib, vertex) in + (graph, modnm_to_path |> ModuleNameMap.add modnm abspath, Alist.extend entryacc entry) + ) (FileDependencyGraph.empty, ModuleNameMap.empty, Alist.empty) + in + + (* Add edges: *) + let* graph = + entryacc |> Alist.to_list |> foldM (fun graph (utlib, vertex) -> + let (header, _) = utlib in + header |> foldM (fun graph headerelem -> + match headerelem with + | HeaderUse((rng, modnm_sub)) -> + begin + match modnm_to_path |> ModuleNameMap.find_opt modnm_sub with + | None -> + err @@ FileModuleNotFound(rng, modnm_sub) + + | Some(abspath_sub) -> + begin + match graph |> FileDependencyGraph.get_vertex abspath_sub with + | None -> + assert false + + | Some(vertex_sub) -> + let graph = graph |> FileDependencyGraph.add_edge ~from:vertex ~to_:vertex_sub in + return graph + end + end + + | HeaderUsePackage(_) -> + return graph + + | HeaderUseOf(_, _) -> + assert false + + ) graph + ) graph + in + + FileDependencyGraph.topological_sort graph |> Result.map_error (fun cycle -> CyclicFileDependency(cycle)) diff --git a/src/frontend/closedFileDependencyResolver.mli b/src/frontend/closedFileDependencyResolver.mli new file mode 100644 index 000000000..dc845b29e --- /dev/null +++ b/src/frontend/closedFileDependencyResolver.mli @@ -0,0 +1,9 @@ + +open MyUtil +open Types + +type error = + | FileModuleNotFound of Range.t * module_name + | CyclicFileDependency of (abs_path * untyped_library_file) cycle + +val main : (abs_path * untyped_library_file) list -> ((abs_path * untyped_library_file) list, error) result From 91da7b8538fb802b345ec8a11a0d307ca4a3ebe7 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 24 Oct 2022 02:25:49 +0900 Subject: [PATCH 013/288] begin to define 'package_info' and use it --- src/frontend/main.ml | 5 ++++- src/frontend/packageChecker.ml | 39 ++++++++++++++++++++++------------ src/frontend/types.cppo.ml | 7 ++++-- 3 files changed, 35 insertions(+), 16 deletions(-) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index ccb591092..bf9009a7c 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -606,6 +606,9 @@ let error_log_environment suspended = | PackageCheckError(ClosedFileDependencyError(_)) -> failwith "TODO (error): ClosedFileDependencyError" + | PackageCheckError(NoMainModule(_)) -> + failwith "TODO (error): NoMainModule" + | PackageCheckError(TypeError(tyerr)) -> begin match tyerr with @@ -1150,7 +1153,7 @@ let build (* Typecheck every package: *) let (genv, libacc) = sorted_packages |> List.fold_left (fun (genv, libacc) package -> - let main_module_name = failwith "TODO: main_module_name; extract it from `package`" in + let main_module_name = package.main_module_name in let (ssig, libs) = match PackageChecker.main tyenv_prim genv package with | Ok(pair) -> pair diff --git a/src/frontend/packageChecker.ml b/src/frontend/packageChecker.ml index 784bca81b..098780a4e 100644 --- a/src/frontend/packageChecker.ml +++ b/src/frontend/packageChecker.ml @@ -10,6 +10,7 @@ type error = | ClosedFileDependencyError of ClosedFileDependencyResolver.error | NotADocumentFile of abs_path * Typeenv.t * mono_type | NotAStringFile of abs_path * Typeenv.t * mono_type + | NoMainModule of module_name type 'a ok = ('a, error) result @@ -59,9 +60,10 @@ let typecheck_document_file (tyenv : Typeenv.t) (abspath_in : abs_path) (utast : err (NotADocumentFile(abspath_in, tyenv, ty)) -let main (tyenv_prim : Typeenv.t) (genv : global_type_environment) (_package : package_info) : (StructSig.t * (abs_path * binding list) list) ok = +let main (tyenv_prim : Typeenv.t) (genv : global_type_environment) (package : package_info) : (StructSig.t * (abs_path * binding list) list) ok = let open ResultMonad in - let utlibs = failwith "TODO: extract `utlibs` from `package`" in + let main_module_name = package.main_module_name in + let utlibs = package.modules in (* Resolve dependency among the source files in the package: *) let* sorted_utlibs = @@ -69,23 +71,34 @@ let main (tyenv_prim : Typeenv.t) (genv : global_type_environment) (_package : p in (* Typecheck each source file: *) - let* (_genv, libacc) = - sorted_utlibs |> foldM (fun (genv, libacc) (abspath, utlib) -> + let* (_genv, libacc, ssig_opt) = + sorted_utlibs |> foldM (fun (genv, libacc, ssig_opt) (abspath, utlib) -> let (header, (modident, utsig_opt, utbinds)) = utlib in let (_, modnm) = modident in - let* ((_quant, ssig), binds) = - let tyenv = tyenv_prim |> add_dependency_to_type_environment header genv in - typecheck_library_file tyenv abspath utsig_opt utbinds - in - let genv = genv |> GlobalTypeenv.add modnm ssig in - return (genv, Alist.extend libacc (abspath, binds)) - ) (genv, Alist.empty) + if String.equal modnm main_module_name then + let ((_quant, ssig), binds) = + failwith "TODO: typecheck the main module" + in + let genv = genv |> GlobalTypeenv.add modnm ssig in + return (genv, Alist.extend libacc (abspath, binds), Some(ssig)) + else + let* ((_quant, ssig), binds) = + let tyenv = tyenv_prim |> add_dependency_to_type_environment header genv in + typecheck_library_file tyenv abspath utsig_opt utbinds + in + let genv = genv |> GlobalTypeenv.add modnm ssig in + return (genv, Alist.extend libacc (abspath, binds), ssig_opt) + ) (genv, Alist.empty, None) in let libs = Alist.to_list libacc in (* TODO: check the main module *) - let ssig = failwith "TODO: PackageChecker, check the main module" in - return (ssig, libs) + match ssig_opt with + | Some(ssig) -> + return (ssig, libs) + + | None -> + err @@ NoMainModule(main_module_name) let main_document (tyenv_prim : Typeenv.t) (genv : global_type_environment) (sorted_locals : (abs_path * untyped_library_file) list) (utdoc : abs_path * untyped_document_file) : ((abs_path * binding list) list * abstract_tree) ok = diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index d2d9441bc..e150983af 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -2,6 +2,7 @@ open LengthInterface open GraphicBase open SyntaxBase +open MyUtil exception ParseErrorDetail of Range.t * string @@ -566,8 +567,10 @@ type untyped_source_file = | UTDocumentFile of untyped_document_file [@@deriving show { with_path = false; }] -type package_info = - unit (* TODO: define this *) +type package_info = { + main_module_name : module_name; + modules : (abs_path * untyped_library_file) list; +} type untyped_letrec_pattern_branch = | UTLetRecPatternBranch of untyped_pattern_tree list * untyped_abstract_tree From 87a172548d18eb63373609850b14eec7542d7d7b Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 24 Oct 2022 03:43:57 +0900 Subject: [PATCH 014/288] develop how to typecheck main modules --- src/frontend/moduleTypechecker.ml | 7 ++-- src/frontend/moduleTypechecker.mli | 4 ++- src/frontend/packageChecker.ml | 55 ++++++++++++++++-------------- 3 files changed, 36 insertions(+), 30 deletions(-) diff --git a/src/frontend/moduleTypechecker.ml b/src/frontend/moduleTypechecker.ml index 1a461c642..6397c33bd 100644 --- a/src/frontend/moduleTypechecker.ml +++ b/src/frontend/moduleTypechecker.ml @@ -885,14 +885,13 @@ and typecheck_binding (tyenv : Typeenv.t) (utbind : untyped_binding) : (binding return (binds, (OpaqueIDMap.empty, ssig)) -let main (tyenv : Typeenv.t) (utsig_opt : untyped_signature option) (utbinds : untyped_binding list) : (StructSig.t abstracted * binding list) ok = +let main (tyenv : Typeenv.t) (absmodsig_opt : (signature abstracted) option) (utbinds : untyped_binding list) : (StructSig.t abstracted * binding list) ok = let open ResultMonad in - match utsig_opt with + match absmodsig_opt with | None -> typecheck_binding_list tyenv utbinds - | Some(utsig) -> - let* absmodsig = typecheck_signature tyenv utsig in + | Some(absmodsig) -> let* ((_, ssig), binds) = typecheck_binding_list tyenv utbinds in let rng = Range.dummy "main_bindings" in (* TODO (error): give appropriate ranges *) let* (quant, modsig) = coerce_signature rng (ConcStructure(ssig)) absmodsig in diff --git a/src/frontend/moduleTypechecker.mli b/src/frontend/moduleTypechecker.mli index b3f5343ea..11fe50b36 100644 --- a/src/frontend/moduleTypechecker.mli +++ b/src/frontend/moduleTypechecker.mli @@ -3,4 +3,6 @@ open Types open StaticEnv open TypeError -val main : Typeenv.t -> untyped_signature option -> untyped_binding list -> (StructSig.t abstracted * binding list, type_error) result +val typecheck_signature : Typeenv.t -> untyped_signature -> (signature abstracted, type_error) result + +val main : Typeenv.t -> (signature abstracted) option -> untyped_binding list -> (StructSig.t abstracted * binding list, type_error) result diff --git a/src/frontend/packageChecker.ml b/src/frontend/packageChecker.ml index 098780a4e..4c62e6991 100644 --- a/src/frontend/packageChecker.ml +++ b/src/frontend/packageChecker.ml @@ -15,14 +15,18 @@ type error = type 'a ok = ('a, error) result -let add_dependency_to_type_environment (header : header_element list) (genv : global_type_environment) (tyenv : Typeenv.t) = +let add_dependency_to_type_environment ~(package_only : bool) (header : header_element list) (genv : global_type_environment) (tyenv : Typeenv.t) = header |> List.fold_left (fun tyenv headerelem -> - match headerelem with - | HeaderUse(_) -> - assert false - - | HeaderUsePackage((_, modnm)) - | HeaderUseOf((_, modnm), _) -> + let modnm_opt = + match headerelem with + | HeaderUse((_, modnm)) | HeaderUseOf((_, modnm), _) -> if package_only then None else Some(modnm) + | HeaderUsePackage((_, modnm)) -> Some(modnm) + in + match modnm_opt with + | None -> + tyenv + + | Some(modnm) -> begin match genv |> GlobalTypeenv.find_opt modnm with | None -> @@ -35,12 +39,16 @@ let add_dependency_to_type_environment (header : header_element list) (genv : gl ) tyenv -let typecheck_library_file (tyenv : Typeenv.t) (abspath_in : abs_path) (utsig_opt : untyped_signature option) (utbinds : untyped_binding list) : (StructSig.t abstracted * binding list) ok = +let typecheck_library_file ~for_struct:(tyenv_for_struct : Typeenv.t) ~for_sig:(tyenv_for_sig : Typeenv.t) (abspath_in : abs_path) (utsig_opt : untyped_signature option) (utbinds : untyped_binding list) : (StructSig.t abstracted * binding list) ok = let open ResultMonad in - Logging.begin_to_typecheck_file abspath_in; - let* ret = ModuleTypechecker.main tyenv utsig_opt utbinds |> Result.map_error (fun tyerr -> TypeError(tyerr)) in - Logging.pass_type_check None; - return ret + let res = + Logging.begin_to_typecheck_file abspath_in; + let* absmodsig_opt = utsig_opt |> optionM (ModuleTypechecker.typecheck_signature tyenv_for_sig) in + let* ret = ModuleTypechecker.main tyenv_for_struct absmodsig_opt utbinds in + Logging.pass_type_check None; + return ret + in + res |> Result.map_error (fun tyerr -> TypeError(tyerr)) let typecheck_document_file (tyenv : Typeenv.t) (abspath_in : abs_path) (utast : untyped_abstract_tree) : abstract_tree ok = @@ -74,17 +82,18 @@ let main (tyenv_prim : Typeenv.t) (genv : global_type_environment) (package : pa let* (_genv, libacc, ssig_opt) = sorted_utlibs |> foldM (fun (genv, libacc, ssig_opt) (abspath, utlib) -> let (header, (modident, utsig_opt, utbinds)) = utlib in + let tyenv_for_struct = tyenv_prim |> add_dependency_to_type_environment ~package_only:false header genv in let (_, modnm) = modident in if String.equal modnm main_module_name then - let ((_quant, ssig), binds) = - failwith "TODO: typecheck the main module" + let* ((_quant, ssig), binds) = + let tyenv_for_sig = tyenv_prim |> add_dependency_to_type_environment ~package_only:true header genv in + typecheck_library_file ~for_struct:tyenv_for_struct ~for_sig:tyenv_for_sig abspath utsig_opt utbinds in let genv = genv |> GlobalTypeenv.add modnm ssig in return (genv, Alist.extend libacc (abspath, binds), Some(ssig)) else let* ((_quant, ssig), binds) = - let tyenv = tyenv_prim |> add_dependency_to_type_environment header genv in - typecheck_library_file tyenv abspath utsig_opt utbinds + typecheck_library_file ~for_struct:tyenv_for_struct ~for_sig:tyenv_for_struct abspath utsig_opt utbinds in let genv = genv |> GlobalTypeenv.add modnm ssig in return (genv, Alist.extend libacc (abspath, binds), ssig_opt) @@ -92,13 +101,9 @@ let main (tyenv_prim : Typeenv.t) (genv : global_type_environment) (package : pa in let libs = Alist.to_list libacc in - (* TODO: check the main module *) match ssig_opt with - | Some(ssig) -> - return (ssig, libs) - - | None -> - err @@ NoMainModule(main_module_name) + | Some(ssig) -> return (ssig, libs) + | None -> err @@ NoMainModule(main_module_name) let main_document (tyenv_prim : Typeenv.t) (genv : global_type_environment) (sorted_locals : (abs_path * untyped_library_file) list) (utdoc : abs_path * untyped_document_file) : ((abs_path * binding list) list * abstract_tree) ok = @@ -108,8 +113,8 @@ let main_document (tyenv_prim : Typeenv.t) (genv : global_type_environment) (sor let (header, (modident, utsig_opt, utbinds)) = utlib in let (_, modnm) = modident in let* ((_quant, ssig), binds) = - let tyenv = tyenv_prim |> add_dependency_to_type_environment header genv in - typecheck_library_file tyenv abspath utsig_opt utbinds + let tyenv = tyenv_prim |> add_dependency_to_type_environment ~package_only:false header genv in + typecheck_library_file ~for_struct:tyenv ~for_sig:tyenv abspath utsig_opt utbinds in let genv = genv |> GlobalTypeenv.add modnm ssig in return (genv, Alist.extend libacc (abspath, binds)) @@ -120,7 +125,7 @@ let main_document (tyenv_prim : Typeenv.t) (genv : global_type_environment) (sor (* Typecheck the document: *) let* ast_doc = let (abspath, (header, utast)) = utdoc in - let tyenv = tyenv_prim |> add_dependency_to_type_environment header genv in + let tyenv = tyenv_prim |> add_dependency_to_type_environment ~package_only:false header genv in typecheck_document_file tyenv abspath utast in From 25f4ef88417a2d936418f3afedff05fe6a04d861 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 24 Oct 2022 04:40:10 +0900 Subject: [PATCH 015/288] develop 'OpenPackageDependencyResolver' --- src/config.ml | 25 +++++++ src/config.mli | 2 + src/frontend/openPackageDependencyResolver.ml | 70 ++++++++++++++++++- src/frontend/packageReader.ml | 13 ++++ src/frontend/types.cppo.ml | 1 + 5 files changed, 108 insertions(+), 3 deletions(-) create mode 100644 src/frontend/packageReader.ml diff --git a/src/config.ml b/src/config.ml index 532af1a58..b0e3ee49a 100644 --- a/src/config.ml +++ b/src/config.ml @@ -18,6 +18,13 @@ let resolve fn = if Sys.file_exists fn then Some(fn) else None +let resolve_directory fn = + try + if Sys.is_directory fn then Some(make_abs_path fn) else None + with + | Sys_error(_) -> None + + (* -- `resolve_lib_file` receives a file path relative to `LIBROOT` and returns its corresponding absolute path. @@ -101,6 +108,24 @@ let resolve_package_exn package extcands = fn_local +let resolve_package_directory main_module_name = + let open ResultMonad in + let dirs = !satysfi_root_dirs in + let pathcands_local = + dirs |> List.map (fun dir -> + Filename.concat (Filename.concat dir "local/packages") main_module_name + ) + in + let pathcands_dist = + dirs |> List.map (fun dir -> + Filename.concat (Filename.concat dir "dist/packages") main_module_name + ) + in + match MyUtil.first_some resolve_directory (List.append pathcands_local pathcands_dist) with + | None -> err (List.append pathcands_local pathcands_dist) + | Some(p) -> return p + + let resolve_local_exn dir s extcands = let pathwithoutext = Filename.concat dir s in let pathcands = extcands |> List.map (fun ext -> pathwithoutext ^ ext) in diff --git a/src/config.mli b/src/config.mli index 38bdded64..57e81214f 100644 --- a/src/config.mli +++ b/src/config.mli @@ -16,4 +16,6 @@ val resolve_lib_file_from_candidates_exn : lib_path list -> abs_path val resolve_package_exn : string -> string list -> abs_path +val resolve_package_directory : string -> (abs_path, string list) result + val resolve_local_exn : string -> string -> string list -> abs_path diff --git a/src/frontend/openPackageDependencyResolver.ml b/src/frontend/openPackageDependencyResolver.ml index e78d79c71..18c207874 100644 --- a/src/frontend/openPackageDependencyResolver.ml +++ b/src/frontend/openPackageDependencyResolver.ml @@ -1,10 +1,74 @@ +open MyUtil open Types type error = - unit (* TODO: define this *) + | MainModuleNameMismatch of { + expected : module_name; + got : module_name; + } + | DependencyNotFound of { + depending : module_name; + depended : module_name; + } + | PackageDirectoryNotFound of string list + | PackageReadingError of PackageReader.error + | CyclicPackageDependency of (module_name * package_info) cycle type 'a ok = ('a, error) result -let main (_package_names : PackageNameSet.t) : (package_info list) ok = - Ok([]) (* TODO: define this *) + +module PackageDependencyGraph = DependencyGraph.Make(String) + + +let main (package_name_set : PackageNameSet.t) : (package_info list) ok = + let open ResultMonad in + let main_module_names = package_name_set |> PackageNameSet.elements in + + (* Add vertices: *) + let* (graph, entryacc) = + main_module_names |> foldM (fun (graph, entryacc) main_module_name -> + let* absdir = + Config.resolve_package_directory main_module_name + |> Result.map_error (fun cands -> PackageDirectoryNotFound(cands)) + in + let* package = + PackageReader.main absdir + |> Result.map_error (fun e -> PackageReadingError(e)) + in + if String.equal package.main_module_name main_module_name then + match graph |> PackageDependencyGraph.add_vertex main_module_name package with + | Error(_) -> + assert false + + | Ok((graph, vertex)) -> + let entry = (package, vertex) in + return (graph, Alist.extend entryacc entry) + else + err @@ MainModuleNameMismatch{ + expected = main_module_name; + got = package.main_module_name; + } + ) (PackageDependencyGraph.empty, Alist.empty) + in + + let* graph = + entryacc |> Alist.to_list |> foldM (fun graph (package, vertex) -> + let main_module_names_dep = package.dependencies in + main_module_names_dep |> foldM (fun graph main_module_name_dep -> + match graph |> PackageDependencyGraph.get_vertex main_module_name_dep with + | None -> + err @@ DependencyNotFound{ + depending = package.main_module_name; + depended = main_module_name_dep; + } + + | Some(vertex_dep) -> + return (graph |> PackageDependencyGraph.add_edge ~from:vertex ~to_:vertex_dep) + ) graph + ) graph + in + + PackageDependencyGraph.topological_sort graph + |> Result.map (fun pairs -> pairs |> List.map (fun (_, package) -> package)) + |> Result.map_error (fun cycle -> CyclicPackageDependency(cycle)) diff --git a/src/frontend/packageReader.ml b/src/frontend/packageReader.ml new file mode 100644 index 000000000..310194aaa --- /dev/null +++ b/src/frontend/packageReader.ml @@ -0,0 +1,13 @@ + +open MyUtil +open Types + +type error = + unit (* TODO: define this *) + +type 'a ok = ('a, error) result + +let main (_absdir : abs_path) : package_info ok = + let open ResultMonad in + let package = failwith "TODO: PackageReader" in + return package diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index e150983af..263ffd211 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -568,6 +568,7 @@ type untyped_source_file = [@@deriving show { with_path = false; }] type package_info = { + dependencies : module_name list; main_module_name : module_name; modules : (abs_path * untyped_library_file) list; } From 78d463dd6770d58a16ed17c3bd81dabc2fca7def Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 24 Oct 2022 14:36:24 +0900 Subject: [PATCH 016/288] develop 'PackageReader' --- satysfi.opam | 1 + src/dune | 2 +- src/frontend/packageReader.ml | 101 ++++++++++++++++++++- src/frontend/yamlDecoder.ml | 163 ++++++++++++++++++++++++++++++++++ src/frontend/yamlDecoder.mli | 42 +++++++++ 5 files changed, 305 insertions(+), 4 deletions(-) create mode 100644 src/frontend/yamlDecoder.ml create mode 100644 src/frontend/yamlDecoder.mli diff --git a/satysfi.opam b/satysfi.opam index bfda4da92..99782f65c 100644 --- a/satysfi.opam +++ b/satysfi.opam @@ -38,6 +38,7 @@ depends: [ "omd" {< "2.0.0~"} "ocamlgraph" "alcotest" {with-test & >= "1.4.0"} + "yaml" {>= "2.1.0"} ] synopsis: "A statically-typed, functional typesetting system" description: """ diff --git a/src/dune b/src/dune index cc4ed7cff..be549f789 100644 --- a/src/dune +++ b/src/dune @@ -16,7 +16,7 @@ yojson-with-position omd ocamlgraph - ) + yaml) (preprocess (pps ppx_deriving.show )) diff --git a/src/frontend/packageReader.ml b/src/frontend/packageReader.ml index 310194aaa..88c88b121 100644 --- a/src/frontend/packageReader.ml +++ b/src/frontend/packageReader.ml @@ -3,11 +3,106 @@ open MyUtil open Types type error = - unit (* TODO: define this *) + | PackageConfigNotFound of abs_path + | PackageConfigError of YamlDecoder.error + | FailedToParse of Range.t + | NotALibraryFile of abs_path type 'a ok = ('a, error) result -let main (_absdir : abs_path) : package_info ok = +type relative_path = string + +type config = + | Version_0_1 of { + main_module_name : module_name; + source_directories : relative_path list; + dependencies : module_name list; + } + + +let config_version_0_1_decoder = + let open YamlDecoder in + get "main_module" string >>= fun main_module_name -> + get "source_directories" (list string) >>= fun source_directories -> + get_or_else "dependencies" (list string) [] >>= fun dependencies -> + succeed @@ Version_0_1 { + main_module_name; + source_directories; + dependencies; + } + + +let config_decoder = + let open YamlDecoder in + get "language" string >>= fun language -> + match language with + | "v0.1.0" -> config_version_0_1_decoder + | _ -> failure (Printf.sprintf "unknown language version '%s'" language) + + +let load_config (absdir_package : abs_path) : config ok = let open ResultMonad in - let package = failwith "TODO: PackageReader" in + let abspath_config = + make_abs_path (Filename.concat (get_abs_path_string absdir_package) "satysfi.yaml") + in + let* inc = + try + return (open_in_abs abspath_config) + with + | Sys_error(_) -> err (PackageConfigNotFound(abspath_config)) + in + let s = Core.In_channel.input_all inc in + close_in inc; + YamlDecoder.run config_decoder s |> Result.map_error (fun e -> PackageConfigError(e)) + + +let listup_sources_in_directory (extensions : string list) (absdir_src : abs_path) : abs_path list = + let filenames = Sys.readdir (get_abs_path_string absdir_src) |> Array.to_list in + filenames |> List.filter_map (fun filename -> + if extensions |> List.exists (fun suffix -> Core.String.is_suffix filename ~suffix) then + Some(make_abs_path (Filename.concat (get_abs_path_string absdir_src) filename)) + else + None + ) + + +let main (absdir_package : abs_path) : package_info ok = + let open ResultMonad in + let* config = load_config absdir_package in + let* package = + match config with + | Version_0_1 { + main_module_name; + source_directories; + dependencies; + } -> + let absdirs_src = + source_directories |> List.map (fun source_directory -> + make_abs_path (Filename.concat (get_abs_path_string absdir_package) source_directory) + ) + in + let extensions = [ ".satyh"; ".satyg" ] in (* TODO: generalize this to the text mode *) + let abspaths_src = absdirs_src |> List.map (listup_sources_in_directory extensions) |> List.concat in + let* acc = + abspaths_src |> foldM (fun acc abspath_src -> + let* utsrc = + ParserInterface.process_file abspath_src + |> Result.map_error (fun rng -> FailedToParse(rng)) + in + match utsrc with + | UTLibraryFile(utlib) -> + return @@ Alist.extend acc (abspath_src, utlib) + + | UTDocumentFile(_) -> + err @@ NotALibraryFile(abspath_src) + + ) Alist.empty + in + let modules = Alist.to_list acc in + return { + main_module_name; + modules; + dependencies; + } + in return package diff --git a/src/frontend/yamlDecoder.ml b/src/frontend/yamlDecoder.ml new file mode 100644 index 000000000..0a12dbb4c --- /dev/null +++ b/src/frontend/yamlDecoder.ml @@ -0,0 +1,163 @@ + +open MyUtil + + +type error = + | FieldNotFound of string + | NotAFloat + | NotAString + | NotABool + | NotAnArray + | NotAnObject + | OtherMessage of string + + +let pp_error (ppf : Format.formatter) = + let p = Format.fprintf in + function + | FieldNotFound(field) -> p ppf "field '%s' not found" field + | NotAFloat -> p ppf "not a float value" + | NotAString -> p ppf "not a string value" + | NotABool -> p ppf "not a Boolean value" + | NotAnArray -> p ppf "not an array" + | NotAnObject -> p ppf "not an object" + | OtherMessage(msg) -> p ppf "%s" msg + + +type 'a t = Yaml.value -> ('a, error) result + + +let run (d : 'a t) (s : string) : ('a, error) result = + let open ResultMonad in + match Yaml.of_string s with + | Ok(yval) -> d yval + | Error(`Msg(s)) -> err (OtherMessage(s)) + + +let succeed (a : 'a) : 'a t = + fun _ -> Ok(a) + + +let failure (msg : string) : 'a t = + fun _ -> Error(OtherMessage(msg)) + + +let bind (d : 'a t) (df : 'a -> 'b t) : 'b t = +fun yval -> + match d yval with + | Ok(a) -> df a yval + | Error(_) as e -> e + + +let ( >>= ) = bind + + +let get_scheme (field : string) (d : 'a t) (k : unit -> ('a, error) result) : 'a t = + let open ResultMonad in + function + | `O(keyvals) -> + begin + match + List.find_map (fun (k, v) -> if String.equal k field then Some(v) else None) keyvals + with + | None -> k () + | Some(v) -> d v + end + + | _ -> + err NotAnObject + + +let get (field : string) (d : 'a t) : 'a t = + let open ResultMonad in + get_scheme field d (fun () -> err (FieldNotFound(field))) + + +let get_opt (field : string) (d : 'a t) : ('a option) t = + let d_some = + d >>= fun v -> succeed (Some(v)) + in + let open ResultMonad in + get_scheme field d_some (fun () -> return None) + + +let get_or_else (field : string) (d : 'a t) (default : 'a) : 'a t = + let open ResultMonad in + get_scheme field d (fun () -> return default) + + +let number : float t = + let open ResultMonad in + function + | `Float(x) -> return x + | _ -> err NotAFloat + + +let string : string t = + let open ResultMonad in + function + | `String(x) -> return x + | _ -> err NotAString + + +let bool : bool t = + let open ResultMonad in + function + | `Bool(x) -> return x + | _ -> err NotABool + + +let list (d : 'a t) : ('a list) t = + let open ResultMonad in + function + | `A(yvals) -> + yvals |> List.fold_left (fun res yval -> + res >>= fun acc -> + d yval >>= fun a -> + return (Alist.extend acc a) + ) (return Alist.empty) >>= fun acc -> + return (Alist.to_list acc) + + | _ -> + err NotAnArray + + +type 'a branch = string * 'a t + + +let branch (field : string) (branches : ('a branch) list) ~on_error:(errorf : string -> string) : 'a t = + get field string >>= fun tag_gotten -> + match + branches |> List.find_map (fun (tag_candidate, d) -> + if String.equal tag_gotten tag_candidate then Some(d) else None + ) + with + | None -> failure (errorf tag_gotten) + | Some(d) -> d + + +let ( ==> ) (label : string) (d : 'a t) : 'a branch = (label, d) + + +let map (f : 'a -> 'b) (d : 'a t) : 'b t = + let open ResultMonad in + fun yval -> + d yval >>= fun a -> + return (f a) + + +let map2 (f : 'a1 -> 'a2 -> 'b) (d1 : 'a1 t) (d2 : 'a2 t) : 'b t = + let open ResultMonad in + fun yval -> + d1 yval >>= fun a1 -> + d2 yval >>= fun a2 -> + return (f a1 a2) + + +let map3 (f : 'a1 -> 'a2 -> 'a3 -> 'b) (d1 : 'a1 t) (d2 : 'a2 t) (d3 : 'a3 t) : 'b t = + let open ResultMonad in + fun yval -> + d1 yval >>= fun a1 -> + d2 yval >>= fun a2 -> + d3 yval >>= fun a3 -> + return (f a1 a2 a3) diff --git a/src/frontend/yamlDecoder.mli b/src/frontend/yamlDecoder.mli new file mode 100644 index 000000000..2f7b18a68 --- /dev/null +++ b/src/frontend/yamlDecoder.mli @@ -0,0 +1,42 @@ + +type error + +val pp_error : Format.formatter -> error -> unit + +type 'a t + +val run : 'a t -> string -> ('a, error) result + +val succeed : 'a -> 'a t + +val failure : string -> 'a t + +val bind : 'a t -> ('a -> 'b t) -> 'b t + +val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t + +val get : string -> 'a t -> 'a t + +val get_opt : string -> 'a t -> ('a option) t + +val get_or_else : string -> 'a t -> 'a -> 'a t + +val number : float t + +val string : string t + +val bool : bool t + +val list : 'a t -> ('a list) t + +type 'a branch + +val branch : string -> ('a branch) list -> on_error:(string -> string) -> 'a t + +val ( ==> ) : string -> 'a t -> 'a branch + +val map : ('a -> 'b) -> 'a t -> 'b t + +val map2 : ('a1 -> 'a2 -> 'b) -> 'a1 t -> 'a2 t -> 'b t + +val map3 : ('a1 -> 'a2 -> 'a3 -> 'b) -> 'a1 t -> 'a2 t -> 'a3 t -> 'b t From b96d851c2f58f7e490ed8168baedb245280b14e1 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 24 Oct 2022 14:50:51 +0900 Subject: [PATCH 017/288] begin to modify SATySFi sources --- demo/demo.saty | 13 +++---- demo/local.satyh | 8 ++--- .../dist/packages/Stdlib/satysfi-package.yaml | 4 +++ .../dist/packages/{ => Stdlib/src}/list.satyg | 2 +- .../packages/{ => Stdlib/src}/option.satyg | 0 .../dist/packages/Stdlib/src/stdlib.satyh | 35 +++++++++++++++++++ src/frontend/main.ml | 2 +- 7 files changed, 52 insertions(+), 12 deletions(-) create mode 100644 lib-satysfi/dist/packages/Stdlib/satysfi-package.yaml rename lib-satysfi/dist/packages/{ => Stdlib/src}/list.satyg (99%) rename lib-satysfi/dist/packages/{ => Stdlib/src}/option.satyg (100%) create mode 100644 lib-satysfi/dist/packages/Stdlib/src/stdlib.satyh diff --git a/demo/demo.saty b/demo/demo.saty index 9041f733b..16b9b644f 100644 --- a/demo/demo.saty +++ b/demo/demo.saty @@ -1,9 +1,10 @@ -@require: stdjabook -@require: code -@require: itemize -@require: tabular -@require: proof -@import: local +use package Stdjabook +use package Annot +use package Code +use package Itemize +use package Tabular +use package Proof +use Local of `./local` let open Pervasives in let open Math in diff --git a/demo/local.satyh b/demo/local.satyh index df5053cfb..d6e93af73 100644 --- a/demo/local.satyh +++ b/demo/local.satyh @@ -1,7 +1,7 @@ -@require: stdjabook -@require: hdecoset -@require: vdecoset -@require: code +use package Stdjabook +use package HDecoSet +use package VDecoSet +use package Code module Local = struct diff --git a/lib-satysfi/dist/packages/Stdlib/satysfi-package.yaml b/lib-satysfi/dist/packages/Stdlib/satysfi-package.yaml new file mode 100644 index 000000000..a6cb4c843 --- /dev/null +++ b/lib-satysfi/dist/packages/Stdlib/satysfi-package.yaml @@ -0,0 +1,4 @@ +language: "v0.1.0" +main_module: "Stdlib" +source_directories: + - "./src" diff --git a/lib-satysfi/dist/packages/list.satyg b/lib-satysfi/dist/packages/Stdlib/src/list.satyg similarity index 99% rename from lib-satysfi/dist/packages/list.satyg rename to lib-satysfi/dist/packages/Stdlib/src/list.satyg index 553af0a2b..333544519 100644 --- a/lib-satysfi/dist/packages/list.satyg +++ b/lib-satysfi/dist/packages/Stdlib/src/list.satyg @@ -1,4 +1,4 @@ -@require: option +use Option module List :> sig val persistent ~map 'a 'b : ('a -> 'b) -> list 'a -> list 'b diff --git a/lib-satysfi/dist/packages/option.satyg b/lib-satysfi/dist/packages/Stdlib/src/option.satyg similarity index 100% rename from lib-satysfi/dist/packages/option.satyg rename to lib-satysfi/dist/packages/Stdlib/src/option.satyg diff --git a/lib-satysfi/dist/packages/Stdlib/src/stdlib.satyh b/lib-satysfi/dist/packages/Stdlib/src/stdlib.satyh new file mode 100644 index 000000000..be82d29bb --- /dev/null +++ b/lib-satysfi/dist/packages/Stdlib/src/stdlib.satyh @@ -0,0 +1,35 @@ +use Option +use List + +module Stdlib :> sig + module Option : sig + val persistent ~map 'a 'b : ('a -> 'b) -> option 'a -> option 'b + val persistent ~from 'a : 'a -> option 'a -> 'a + val persistent ~bind 'a 'b : option 'a -> ('a -> option 'b) -> option 'b + val persistent ~is-none 'a : option 'a -> bool + end + module List : sig + val persistent ~map 'a 'b : ('a -> 'b) -> list 'a -> list 'b + val persistent ~mapi 'a 'b : (int -> 'a -> 'b) -> list 'a -> list 'b + val persistent ~iter 'a : ('a -> unit) -> list 'a -> unit + val persistent ~iteri 'a : (int -> 'a -> unit) -> list 'a -> unit + val persistent ~fold-left 'a 'b : ('a -> 'b -> 'a) -> 'a -> list 'b -> 'a + val persistent ~fold-lefti 'a 'b : (int -> 'a -> 'b -> 'a) -> 'a -> list 'b -> 'a + val persistent ~fold-right 'a 'b : ('a -> 'b -> 'b) -> 'b -> list 'a -> 'b + val persistent ~filter 'a : ('a -> bool) -> list 'a -> list 'a + val persistent ~assoc 'a 'b : ('a -> 'a -> bool) -> 'a -> list ('a * 'b) -> option 'b + val persistent ~reverse 'a : list 'a -> list 'a + val persistent ~append 'a : list 'a -> list 'a -> list 'a + val persistent ~concat 'a : list (list 'a) -> list 'a + val persistent ~fold-left-adjacent 'a 'b : ('a -> 'b -> option 'b -> option 'b -> 'a) -> 'a -> list 'b -> 'a + val persistent ~map-adjacent 'a 'b : ('a -> option 'a -> option 'a -> 'b) -> list 'a -> list 'b + val persistent ~mapi-adjacent 'a 'b : (int -> 'a -> option 'a -> option 'a -> 'b) -> list 'a -> list 'b + val persistent ~length 'a : list 'a -> int + val persistent ~nth 'a : int -> list 'a -> option 'a + val persistent ~is-empty 'a : list 'a -> bool + val persistent ~map-with-ends 'a 'b : (bool -> bool -> 'a -> 'b) -> list 'a -> list 'b + end +end = struct + module Option = Option + module List = List +end diff --git a/src/frontend/main.ml b/src/frontend/main.ml index bf9009a7c..c772313d8 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -401,7 +401,7 @@ let error_log_environment suspended = ] end - | OpenPackageDependencyError(_e) -> + | OpenPackageDependencyError(e) -> failwith "TODO (error): OpenPackageDependencyError" | Config.PackageNotFound(package, pathcands) -> From 88f8171984cfc084b29089b1f8f5ed33b4ba78a5 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 24 Oct 2022 15:03:51 +0900 Subject: [PATCH 018/288] FIRST SUCCESS in loading packages --- .../{satysfi-package.yaml => satysfi.yaml} | 0 src/frontend/main.ml | 2 +- src/frontend/openPackageDependencyResolver.ml | 1 + src/frontend/packageReader.ml | 5 +++-- src/frontend/types.cppo.ml | 1 + src/myUtil.ml | 1 + src/myUtil.mli | 1 + tests/refactor1.saty | 16 +++++++++------- 8 files changed, 17 insertions(+), 10 deletions(-) rename lib-satysfi/dist/packages/Stdlib/{satysfi-package.yaml => satysfi.yaml} (100%) diff --git a/lib-satysfi/dist/packages/Stdlib/satysfi-package.yaml b/lib-satysfi/dist/packages/Stdlib/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/Stdlib/satysfi-package.yaml rename to lib-satysfi/dist/packages/Stdlib/satysfi.yaml diff --git a/src/frontend/main.ml b/src/frontend/main.ml index c772313d8..30ed62567 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -402,7 +402,7 @@ let error_log_environment suspended = end | OpenPackageDependencyError(e) -> - failwith "TODO (error): OpenPackageDependencyError" + failwith (Format.asprintf "%a" OpenPackageDependencyResolver.pp_error e) | Config.PackageNotFound(package, pathcands) -> report_error Interface (List.append [ diff --git a/src/frontend/openPackageDependencyResolver.ml b/src/frontend/openPackageDependencyResolver.ml index 18c207874..fefa6be09 100644 --- a/src/frontend/openPackageDependencyResolver.ml +++ b/src/frontend/openPackageDependencyResolver.ml @@ -14,6 +14,7 @@ type error = | PackageDirectoryNotFound of string list | PackageReadingError of PackageReader.error | CyclicPackageDependency of (module_name * package_info) cycle +[@@deriving show { with_path = false }] type 'a ok = ('a, error) result diff --git a/src/frontend/packageReader.ml b/src/frontend/packageReader.ml index 88c88b121..c6763df77 100644 --- a/src/frontend/packageReader.ml +++ b/src/frontend/packageReader.ml @@ -7,6 +7,7 @@ type error = | PackageConfigError of YamlDecoder.error | FailedToParse of Range.t | NotALibraryFile of abs_path +[@@deriving show { with_path = false }] type 'a ok = ('a, error) result @@ -86,8 +87,8 @@ let main (absdir_package : abs_path) : package_info ok = let* acc = abspaths_src |> foldM (fun acc abspath_src -> let* utsrc = - ParserInterface.process_file abspath_src - |> Result.map_error (fun rng -> FailedToParse(rng)) + Logging.begin_to_parse_file abspath_src; + ParserInterface.process_file abspath_src |> Result.map_error (fun rng -> FailedToParse(rng)) in match utsrc with | UTLibraryFile(utlib) -> diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index 263ffd211..15e9696b9 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -572,6 +572,7 @@ type package_info = { main_module_name : module_name; modules : (abs_path * untyped_library_file) list; } +[@@deriving show { with_path = false }] type untyped_letrec_pattern_branch = | UTLetRecPatternBranch of untyped_pattern_tree list * untyped_abstract_tree diff --git a/src/myUtil.ml b/src/myUtil.ml index c29e4fbfa..4bc804e13 100644 --- a/src/myUtil.ml +++ b/src/myUtil.ml @@ -2,6 +2,7 @@ exception RemainsToBeImplemented of string type abs_path = AbsPath of string +[@@deriving show { with_path = false }] type lib_path = LibPath of string diff --git a/src/myUtil.mli b/src/myUtil.mli index 9295ab2a9..55ac3c470 100644 --- a/src/myUtil.mli +++ b/src/myUtil.mli @@ -2,6 +2,7 @@ exception RemainsToBeImplemented of string type abs_path +[@@deriving show] type lib_path diff --git a/tests/refactor1.saty b/tests/refactor1.saty index 2a040ca5f..adfbb8c09 100644 --- a/tests/refactor1.saty +++ b/tests/refactor1.saty @@ -1,12 +1,14 @@ +use package Stdlib -let rec fold-left f i l = - match l with - | [] -> i - | x :: xs -> fold-left f (f i x) xs - end -in +%let rec fold-left f i l = +% match l with +% | [] -> i +% | x :: xs -> fold-left f (f i x) xs +% end +%in -let sum = fold-left (+) 0 [3, 1, 4, 1, 5, 9, 2] in +let open Stdlib in +let sum = List.fold-left (+) 0 [3, 1, 4, 1, 5, 9, 2] in let f t y = if t == 0 then y else t + 2 From 0c70637fc4894dd43fe3d8bdad40a42e6a41b6f4 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 24 Oct 2022 23:38:23 +0900 Subject: [PATCH 019/288] develop SATySFi package 'Math' --- lib-satysfi/dist/packages/Math/satysfi.yaml | 6 ++ .../dist/packages/{ => Math/src}/math.satyh | 11 ++-- .../dist/packages/{ => Stdlib/src}/geom.satyh | 2 +- .../dist/packages/{ => Stdlib/src}/gr.satyh | 6 +- .../{ => Stdlib/src}/pervasives.satyh | 0 .../dist/packages/Stdlib/src/stdlib.satyh | 56 +++++++++++++++++++ 6 files changed, 73 insertions(+), 8 deletions(-) create mode 100644 lib-satysfi/dist/packages/Math/satysfi.yaml rename lib-satysfi/dist/packages/{ => Math/src}/math.satyh (99%) rename lib-satysfi/dist/packages/{ => Stdlib/src}/geom.satyh (96%) rename lib-satysfi/dist/packages/{ => Stdlib/src}/gr.satyh (99%) rename lib-satysfi/dist/packages/{ => Stdlib/src}/pervasives.satyh (100%) diff --git a/lib-satysfi/dist/packages/Math/satysfi.yaml b/lib-satysfi/dist/packages/Math/satysfi.yaml new file mode 100644 index 000000000..d06098c9e --- /dev/null +++ b/lib-satysfi/dist/packages/Math/satysfi.yaml @@ -0,0 +1,6 @@ +language: "v0.1.0" +main_module: "Math" +source_directories: + - "./src" +dependencies: + - "Stdlib" diff --git a/lib-satysfi/dist/packages/math.satyh b/lib-satysfi/dist/packages/Math/src/math.satyh similarity index 99% rename from lib-satysfi/dist/packages/math.satyh rename to lib-satysfi/dist/packages/Math/src/math.satyh index faf009672..1a7a67d8d 100644 --- a/lib-satysfi/dist/packages/math.satyh +++ b/lib-satysfi/dist/packages/Math/src/math.satyh @@ -1,6 +1,4 @@ -@require: pervasives -@require: list -@require: gr +use package Stdlib module Math :> sig @@ -398,7 +396,7 @@ module Math :> sig val \setsep : math [math-text, math-text] val \cases : math [list (math-text * inline-text)] - type paren = Pervasives.paren %TODO (enhance): remove this + type paren = Stdlib.Pervasives.paren %TODO (enhance): remove this val paren-left : paren val paren-right : paren val paren : context -> math-boxes -> math-boxes @@ -428,6 +426,11 @@ module Math :> sig % end = struct + %- TODO: replace this with 'open' + module List = Stdlib.List + module Pervasives = Stdlib.Pervasives + module Gr = Stdlib.Gr + val join (msep : math-text) (ms : list math-text) = match ms |> List.fold-left (fun maccopt m -> ( diff --git a/lib-satysfi/dist/packages/geom.satyh b/lib-satysfi/dist/packages/Stdlib/src/geom.satyh similarity index 96% rename from lib-satysfi/dist/packages/geom.satyh rename to lib-satysfi/dist/packages/Stdlib/src/geom.satyh index 01dc26a28..67c4d2bab 100644 --- a/lib-satysfi/dist/packages/geom.satyh +++ b/lib-satysfi/dist/packages/Stdlib/src/geom.satyh @@ -1,4 +1,4 @@ -@require: pervasives +use Pervasives module Geom :> sig type point = Pervasives.point %TODO (enhance): remove this diff --git a/lib-satysfi/dist/packages/gr.satyh b/lib-satysfi/dist/packages/Stdlib/src/gr.satyh similarity index 99% rename from lib-satysfi/dist/packages/gr.satyh rename to lib-satysfi/dist/packages/Stdlib/src/gr.satyh index 0af90c091..e878d438b 100644 --- a/lib-satysfi/dist/packages/gr.satyh +++ b/lib-satysfi/dist/packages/Stdlib/src/gr.satyh @@ -1,6 +1,6 @@ -@require: pervasives -@require: geom -@require: list +use Pervasives +use Geom +use List module Gr :> sig type point = Pervasives.point %TODO (enhance): erase this diff --git a/lib-satysfi/dist/packages/pervasives.satyh b/lib-satysfi/dist/packages/Stdlib/src/pervasives.satyh similarity index 100% rename from lib-satysfi/dist/packages/pervasives.satyh rename to lib-satysfi/dist/packages/Stdlib/src/pervasives.satyh diff --git a/lib-satysfi/dist/packages/Stdlib/src/stdlib.satyh b/lib-satysfi/dist/packages/Stdlib/src/stdlib.satyh index be82d29bb..7d7fbccda 100644 --- a/lib-satysfi/dist/packages/Stdlib/src/stdlib.satyh +++ b/lib-satysfi/dist/packages/Stdlib/src/stdlib.satyh @@ -1,5 +1,8 @@ use Option use List +use Pervasives +use Geom +use Gr module Stdlib :> sig module Option : sig @@ -29,7 +32,60 @@ module Stdlib :> sig val persistent ~is-empty 'a : list 'a -> bool val persistent ~map-with-ends 'a 'b : (bool -> bool -> 'a -> 'b) -> list 'a -> list 'b end + module Pervasives : sig + type point = length * length + type paren = length -> length -> context -> inline-boxes * (length -> length) + val get-natural-width : inline-boxes -> length + val form-paragraph : context -> inline-boxes -> block-boxes + val kern : length -> inline-boxes + val \hskip : inline [length] + val no-break : inline-boxes -> inline-boxes + val \no-break : inline [inline-text] + val \SATySFi : inline [] + val \LaTeX : inline [] + val \TeX : inline [] + val length-max : length -> length -> length + val length-min : length -> length -> length + val length-abs : length -> length + val \fil : inline [] + val \fil-both : inline [] + val mandatory-break : context -> inline-boxes + val destruct-option 'a : 'a -> option 'a -> 'a + val math-pi : float + val increment : ref int -> unit + end + module Geom : sig + type point = Pervasives.point %TODO (enhance): remove this + val atan2-point : point -> point -> float + val div-perp : point -> point -> float -> length -> point + end + module Gr : sig + type point = Pervasives.point %TODO (enhance): erase this + val rectangle : point -> point -> path + val rectangle-round : length -> point -> point -> path + val rectangle-round-left : length -> point -> point -> path + val rectangle-round-left-lower : length -> point -> point -> path + val rectangle-round-left-upper : length -> point -> point -> path + val rectangle-round-right : length -> point -> point -> path + val poly-line : point -> list point -> path + val polygon : point -> list point -> path + val line : point -> point -> path + val circle : point -> length -> path + val empty : graphics + val text-centering : point -> inline-boxes -> graphics + val text-leftward : point -> inline-boxes -> graphics + val text-rightward : point -> inline-boxes -> graphics + val arrow : length -> color -> length -> length -> length -> point -> point -> graphics + val dashed-arrow : length -> length * length * length -> color -> length -> length -> length -> point -> point -> graphics + val rotate-path : point -> float -> path -> path + val scale-path : point -> float -> float -> path -> path + val rotate-graphics : point -> float -> graphics -> graphics + val scale-graphics : point -> float -> float -> graphics -> graphics + end end = struct module Option = Option module List = List + module Pervasives = Pervasives + module Geom = Geom + module Gr = Gr end From 7378e9aeea748b969b4d8593e21a2ae432ea89bf Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 24 Oct 2022 23:38:50 +0900 Subject: [PATCH 020/288] fix 'OpenPackageDependencyResolver' --- src/frontend/closedFileDependencyResolver.ml | 6 +- src/frontend/closedFileDependencyResolver.mli | 1 + src/frontend/main.ml | 17 ++-- src/frontend/openPackageDependencyResolver.ml | 82 +++++++++++-------- src/frontend/packageChecker.ml | 54 +++++++----- tests/refactor1.saty | 4 +- 6 files changed, 98 insertions(+), 66 deletions(-) diff --git a/src/frontend/closedFileDependencyResolver.ml b/src/frontend/closedFileDependencyResolver.ml index 85b0d155f..96d6696fb 100644 --- a/src/frontend/closedFileDependencyResolver.ml +++ b/src/frontend/closedFileDependencyResolver.ml @@ -5,6 +5,7 @@ open Types type error = | FileModuleNotFound of Range.t * module_name | CyclicFileDependency of (abs_path * untyped_library_file) cycle +[@@deriving show { with_path = false }] type 'a ok = ('a, error) result @@ -21,14 +22,14 @@ let main (utlibs : (abs_path * untyped_library_file) list) : ((abs_path * untype | Error(_) -> assert false | Ok(pair) -> pair in - let entry = (utlib, vertex) in + let entry = (modnm, utlib, vertex) in (graph, modnm_to_path |> ModuleNameMap.add modnm abspath, Alist.extend entryacc entry) ) (FileDependencyGraph.empty, ModuleNameMap.empty, Alist.empty) in (* Add edges: *) let* graph = - entryacc |> Alist.to_list |> foldM (fun graph (utlib, vertex) -> + entryacc |> Alist.to_list |> foldM (fun graph (modnm, utlib, vertex) -> let (header, _) = utlib in header |> foldM (fun graph headerelem -> match headerelem with @@ -45,6 +46,7 @@ let main (utlibs : (abs_path * untyped_library_file) list) : ((abs_path * untype assert false | Some(vertex_sub) -> + Printf.printf "****SRC DEP: %s ---> %s\n" modnm modnm_sub; (* TODO: remove this *) let graph = graph |> FileDependencyGraph.add_edge ~from:vertex ~to_:vertex_sub in return graph end diff --git a/src/frontend/closedFileDependencyResolver.mli b/src/frontend/closedFileDependencyResolver.mli index dc845b29e..8ed41e2fb 100644 --- a/src/frontend/closedFileDependencyResolver.mli +++ b/src/frontend/closedFileDependencyResolver.mli @@ -5,5 +5,6 @@ open Types type error = | FileModuleNotFound of Range.t * module_name | CyclicFileDependency of (abs_path * untyped_library_file) cycle +[@@deriving show] val main : (abs_path * untyped_library_file) list -> ((abs_path * untyped_library_file) list, error) result diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 30ed62567..6d0aab1d9 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -402,7 +402,7 @@ let error_log_environment suspended = end | OpenPackageDependencyError(e) -> - failwith (Format.asprintf "%a" OpenPackageDependencyResolver.pp_error e) + failwith (Format.asprintf "TODO (error): %a" OpenPackageDependencyResolver.pp_error e) | Config.PackageNotFound(package, pathcands) -> report_error Interface (List.append [ @@ -589,26 +589,29 @@ let error_log_environment suspended = NormalLine(Printf.sprintf "missing required key '%s'." key); ] - | PackageCheckError(NotADocumentFile(abspath_in, _tyenv, ty)) -> + | PackageCheckError(NotADocumentFile(abspath_in, ty)) -> let fname = convert_abs_path_to_show abspath_in in report_error Typechecker [ NormalLine(Printf.sprintf "file '%s' is not a document file; it is of type" fname); DisplayLine(Display.show_mono_type ty); ] - | PackageCheckError(NotAStringFile(abspath_in, _tyenv, ty)) -> + | PackageCheckError(NotAStringFile(abspath_in, ty)) -> let fname = convert_abs_path_to_show abspath_in in report_error Typechecker [ NormalLine(Printf.sprintf "file '%s' is not a file for generating text; it is of type" fname); DisplayLine(Display.show_mono_type ty); ] - | PackageCheckError(ClosedFileDependencyError(_)) -> - failwith "TODO (error): ClosedFileDependencyError" + | PackageCheckError(ClosedFileDependencyError(e)) -> + failwith (Format.asprintf "TODO (error): %a" ClosedFileDependencyResolver.pp_error e) | PackageCheckError(NoMainModule(_)) -> failwith "TODO (error): NoMainModule" + | PackageCheckError(UnknownPackageDependency(rng, modnm)) -> + failwith (Format.asprintf "TODO (error): %a %s" Range.pp rng modnm) + | PackageCheckError(TypeError(tyerr)) -> begin match tyerr with @@ -1156,8 +1159,8 @@ let build let main_module_name = package.main_module_name in let (ssig, libs) = match PackageChecker.main tyenv_prim genv package with - | Ok(pair) -> pair - | Error(_e) -> failwith "TODO (error): PackageChecker, Error" + | Ok(pair) -> pair + | Error(e) -> raise (PackageCheckError(e)) in let genv = genv |> GlobalTypeenv.add main_module_name ssig in let libacc = Alist.append libacc libs in diff --git a/src/frontend/openPackageDependencyResolver.ml b/src/frontend/openPackageDependencyResolver.ml index fefa6be09..5c114483f 100644 --- a/src/frontend/openPackageDependencyResolver.ml +++ b/src/frontend/openPackageDependencyResolver.ml @@ -7,10 +7,6 @@ type error = expected : module_name; got : module_name; } - | DependencyNotFound of { - depending : module_name; - depended : module_name; - } | PackageDirectoryNotFound of string list | PackageReadingError of PackageReader.error | CyclicPackageDependency of (module_name * package_info) cycle @@ -21,14 +17,28 @@ type 'a ok = ('a, error) result module PackageDependencyGraph = DependencyGraph.Make(String) +type graph = package_info PackageDependencyGraph.t + +type vertex = PackageDependencyGraph.Vertex.t -let main (package_name_set : PackageNameSet.t) : (package_info list) ok = + +let rec add_package (graph : graph) ~prev:(vertex_prev_opt : vertex option) (main_module_name : module_name) : graph ok = let open ResultMonad in - let main_module_names = package_name_set |> PackageNameSet.elements in + match graph |> PackageDependencyGraph.get_vertex main_module_name with + | Some(vertex) -> + (* If `main_module_name` has already been read: *) + let graph = + match vertex_prev_opt with + | None -> + graph - (* Add vertices: *) - let* (graph, entryacc) = - main_module_names |> foldM (fun (graph, entryacc) main_module_name -> + | Some(vertex_prev) -> + graph |> PackageDependencyGraph.add_edge ~from:vertex_prev ~to_:vertex + in + return graph + + | None -> + Printf.printf "****PACKAGE: %s\n" main_module_name; (* TODO: remove this *) let* absdir = Config.resolve_package_directory main_module_name |> Result.map_error (fun cands -> PackageDirectoryNotFound(cands)) @@ -38,38 +48,38 @@ let main (package_name_set : PackageNameSet.t) : (package_info list) ok = |> Result.map_error (fun e -> PackageReadingError(e)) in if String.equal package.main_module_name main_module_name then - match graph |> PackageDependencyGraph.add_vertex main_module_name package with - | Error(_) -> - assert false - - | Ok((graph, vertex)) -> - let entry = (package, vertex) in - return (graph, Alist.extend entryacc entry) + let (graph, vertex) = + match graph |> PackageDependencyGraph.add_vertex main_module_name package with + | Error(_) -> assert false + | Ok(pair) -> pair + in + let graph = + match vertex_prev_opt with + | None -> graph + | Some(vertex_prev) -> graph |> PackageDependencyGraph.add_edge ~from:vertex_prev ~to_:vertex + in + package.dependencies |> foldM (fun graph main_module_name_dep -> + Printf.printf "****DEP2: %s ---> %s\n" main_module_name main_module_name_dep; (* TODO: remove this *) + add_package graph ~prev:(Some(vertex)) main_module_name_dep + ) graph else err @@ MainModuleNameMismatch{ expected = main_module_name; got = package.main_module_name; } - ) (PackageDependencyGraph.empty, Alist.empty) - in - let* graph = - entryacc |> Alist.to_list |> foldM (fun graph (package, vertex) -> - let main_module_names_dep = package.dependencies in - main_module_names_dep |> foldM (fun graph main_module_name_dep -> - match graph |> PackageDependencyGraph.get_vertex main_module_name_dep with - | None -> - err @@ DependencyNotFound{ - depending = package.main_module_name; - depended = main_module_name_dep; - } - | Some(vertex_dep) -> - return (graph |> PackageDependencyGraph.add_edge ~from:vertex ~to_:vertex_dep) - ) graph - ) graph +let main (package_name_set_init : PackageNameSet.t) : (package_info list) ok = + let open ResultMonad in + let main_module_names_init = package_name_set_init |> PackageNameSet.elements in + let* graph = + main_module_names_init |> foldM (fun graph main_module_name -> + add_package graph ~prev:None main_module_name + ) PackageDependencyGraph.empty in - - PackageDependencyGraph.topological_sort graph - |> Result.map (fun pairs -> pairs |> List.map (fun (_, package) -> package)) - |> Result.map_error (fun cycle -> CyclicPackageDependency(cycle)) + let* pairs = + PackageDependencyGraph.topological_sort graph + |> Result.map_error (fun cycle -> CyclicPackageDependency(cycle)) + in + Printf.printf "****SORTED: %s\n" (pairs |> List.map (fun (n, _) -> n) |> String.concat " > "); (* TODO: remove this *) + return (pairs |> List.map (fun (_, package) -> package)) diff --git a/src/frontend/packageChecker.ml b/src/frontend/packageChecker.ml index 4c62e6991..fc551b83d 100644 --- a/src/frontend/packageChecker.ml +++ b/src/frontend/packageChecker.ml @@ -8,33 +8,47 @@ open TypeError type error = | TypeError of type_error | ClosedFileDependencyError of ClosedFileDependencyResolver.error - | NotADocumentFile of abs_path * Typeenv.t * mono_type - | NotAStringFile of abs_path * Typeenv.t * mono_type + | NotADocumentFile of abs_path * mono_type + | NotAStringFile of abs_path * mono_type | NoMainModule of module_name + | UnknownPackageDependency of Range.t * module_name type 'a ok = ('a, error) result +type dependency_kind = PackageDependency | LocalDependency -let add_dependency_to_type_environment ~(package_only : bool) (header : header_element list) (genv : global_type_environment) (tyenv : Typeenv.t) = - header |> List.fold_left (fun tyenv headerelem -> - let modnm_opt = + +let add_dependency_to_type_environment ~(package_only : bool) (header : header_element list) (genv : global_type_environment) (tyenv : Typeenv.t) : Typeenv.t ok = + let open ResultMonad in + header |> foldM (fun tyenv headerelem -> + let opt = match headerelem with - | HeaderUse((_, modnm)) | HeaderUseOf((_, modnm), _) -> if package_only then None else Some(modnm) - | HeaderUsePackage((_, modnm)) -> Some(modnm) + | HeaderUse(modident) + | HeaderUseOf(modident, _) -> + if package_only then + None + else + Some((LocalDependency, modident)) + + | HeaderUsePackage(modident) -> + Some((PackageDependency, modident)) in - match modnm_opt with + match opt with | None -> - tyenv + return tyenv - | Some(modnm) -> + | Some((kind, (rng, modnm))) -> begin - match genv |> GlobalTypeenv.find_opt modnm with - | None -> + match (kind, genv |> GlobalTypeenv.find_opt modnm) with + | (LocalDependency, None) -> assert false - | Some(ssig) -> + | (PackageDependency, None) -> + err @@ UnknownPackageDependency(rng, modnm) + + | (_, Some(ssig)) -> let mentry = { mod_signature = ConcStructure(ssig) } in - tyenv |> Typeenv.add_module modnm mentry + return (tyenv |> Typeenv.add_module modnm mentry) end ) tyenv @@ -60,12 +74,12 @@ let typecheck_document_file (tyenv : Typeenv.t) (abspath_in : abs_path) (utast : if Typechecker.are_unifiable ty (Range.dummy "text-mode", BaseType(StringType)) then return ast else - err (NotAStringFile(abspath_in, tyenv, ty)) + err (NotAStringFile(abspath_in, ty)) else if Typechecker.are_unifiable ty (Range.dummy "pdf-mode", BaseType(DocumentType)) then return ast else - err (NotADocumentFile(abspath_in, tyenv, ty)) + err (NotADocumentFile(abspath_in, ty)) let main (tyenv_prim : Typeenv.t) (genv : global_type_environment) (package : package_info) : (StructSig.t * (abs_path * binding list) list) ok = @@ -82,11 +96,11 @@ let main (tyenv_prim : Typeenv.t) (genv : global_type_environment) (package : pa let* (_genv, libacc, ssig_opt) = sorted_utlibs |> foldM (fun (genv, libacc, ssig_opt) (abspath, utlib) -> let (header, (modident, utsig_opt, utbinds)) = utlib in - let tyenv_for_struct = tyenv_prim |> add_dependency_to_type_environment ~package_only:false header genv in + let* tyenv_for_struct = tyenv_prim |> add_dependency_to_type_environment ~package_only:false header genv in let (_, modnm) = modident in if String.equal modnm main_module_name then let* ((_quant, ssig), binds) = - let tyenv_for_sig = tyenv_prim |> add_dependency_to_type_environment ~package_only:true header genv in + let* tyenv_for_sig = tyenv_prim |> add_dependency_to_type_environment ~package_only:true header genv in typecheck_library_file ~for_struct:tyenv_for_struct ~for_sig:tyenv_for_sig abspath utsig_opt utbinds in let genv = genv |> GlobalTypeenv.add modnm ssig in @@ -113,7 +127,7 @@ let main_document (tyenv_prim : Typeenv.t) (genv : global_type_environment) (sor let (header, (modident, utsig_opt, utbinds)) = utlib in let (_, modnm) = modident in let* ((_quant, ssig), binds) = - let tyenv = tyenv_prim |> add_dependency_to_type_environment ~package_only:false header genv in + let* tyenv = tyenv_prim |> add_dependency_to_type_environment ~package_only:false header genv in typecheck_library_file ~for_struct:tyenv ~for_sig:tyenv abspath utsig_opt utbinds in let genv = genv |> GlobalTypeenv.add modnm ssig in @@ -125,7 +139,7 @@ let main_document (tyenv_prim : Typeenv.t) (genv : global_type_environment) (sor (* Typecheck the document: *) let* ast_doc = let (abspath, (header, utast)) = utdoc in - let tyenv = tyenv_prim |> add_dependency_to_type_environment ~package_only:false header genv in + let* tyenv = tyenv_prim |> add_dependency_to_type_environment ~package_only:false header genv in typecheck_document_file tyenv abspath utast in diff --git a/tests/refactor1.saty b/tests/refactor1.saty index adfbb8c09..85a8c8564 100644 --- a/tests/refactor1.saty +++ b/tests/refactor1.saty @@ -1,4 +1,5 @@ use package Stdlib +use package Math %let rec fold-left f i l = % match l with @@ -8,6 +9,7 @@ use package Stdlib %in let open Stdlib in +let open Math in let sum = List.fold-left (+) 0 [3, 1, 4, 1, 5, 9, 2] in let f t y = @@ -21,7 +23,7 @@ let g p q = in let s = arabic sum ^ `,` ^ arabic (f 0 42) ^ `,` ^ arabic (f 1 42) ^ `,` ^ arabic (g 0 42) ^ `,` ^ arabic (g 1 42) in -let inline ctx \math m = embed-math ctx (read-math ctx m) in +%let inline ctx \math m = embed-math ctx (read-math ctx m) in let ctx = get-initial-context 400pt (command \math) in let paper-size = (210mm, 297mm) in %A4 let pagecontf _ = (| text-origin = (20pt, 20pt), text-height = 600pt, |) in From 26b9e773755527b2541a38b105d59705eca6d1be Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 24 Oct 2022 23:44:36 +0900 Subject: [PATCH 021/288] fix the parser tests --- src/frontend/parserInterface.ml | 2 +- src/frontend/parserInterface.mli | 2 + test/parsing/parser.expected | 2286 +++++++++++++++--------------- test/parsing/parser_test.ml | 31 +- 4 files changed, 1175 insertions(+), 1146 deletions(-) diff --git a/src/frontend/parserInterface.ml b/src/frontend/parserInterface.ml index 1cb090e8b..3299712f4 100644 --- a/src/frontend/parserInterface.ml +++ b/src/frontend/parserInterface.ml @@ -24,7 +24,7 @@ let k_fail chkpt = assert false -let process_common fname lexbuf = +let process_common (fname : string) (lexbuf : Lexing.lexbuf) = let open ResultMonad in let stack = Lexer.reset_to_program () in lexbuf.Lexing.lex_curr_p <- { lexbuf.Lexing.lex_curr_p with pos_fname = fname }; diff --git a/src/frontend/parserInterface.mli b/src/frontend/parserInterface.mli index 8eae4f9e3..d6c30a79b 100644 --- a/src/frontend/parserInterface.mli +++ b/src/frontend/parserInterface.mli @@ -2,6 +2,8 @@ open MyUtil open Types +val process_common : string -> Lexing.lexbuf -> (untyped_source_file, Range.t) result + val process_file : abs_path -> (untyped_source_file, Range.t) result val process_text : string -> string -> (untyped_source_file, Range.t) result diff --git a/test/parsing/parser.expected b/test/parsing/parser.expected index 392430388..98c4de8db 100644 --- a/test/parsing/parser.expected +++ b/test/parsing/parser.expected @@ -3,1228 +3,1254 @@ ;; nx.saty (UTLibraryFile - (((Range.Normal ), "Nx"), None, - [((Range.Normal ), - (UTBindValue (Stage1, - (UTNonRec - (((Range.Normal ), "xs"), - (UTListCons ((UTIntegerConstant 1), - (UTListCons ((UTIntegerConstant 2), - (UTListCons ((UTIntegerConstant 3), UTEndOfList)))) - )))) - ))); - ((Range.Normal ), + ([], + (((Range.Normal ), "Nx"), None, + [((Range.Normal ), (UTBindValue (Stage1, (UTNonRec - (((Range.Normal ), "ys"), + (((Range.Normal ), "xs"), (UTListCons ((UTIntegerConstant 1), (UTListCons ((UTIntegerConstant 2), (UTListCons ((UTIntegerConstant 3), UTEndOfList)))) )))) ))); - ((Range.Normal ), - (UTBindValue (Stage1, - (UTNonRec (((Range.Normal ), "r0"), (UTRecord []))) - ))); - ((Range.Normal ), - (UTBindValue (Stage1, - (UTNonRec - (((Range.Normal ), "r1"), - (UTRecord - [(((Range.Normal ), "x"), - (UTIntegerConstant 1))]))) - ))); - ((Range.Normal ), - (UTBindValue (Stage1, - (UTNonRec - (((Range.Normal ), "r2"), - (UTRecord - [(((Range.Normal ), "x"), - (UTIntegerConstant 1)); - (((Range.Normal ), "y"), - (UTIntegerConstant 2)) - ]))) - ))); - ((Range.Normal ), - (UTBindValue (Stage1, - (UTNonRec - (((Range.Normal ), "r2semi"), - (UTRecord - [(((Range.Normal ), "x"), - (UTIntegerConstant 1)); - (((Range.Normal ), "y"), - (UTIntegerConstant 2)) - ]))) - ))); - ((Range.Normal ), - (UTBindValue (Stage1, - (UTNonRec - (((Range.Normal ), "tp2"), - (UTTuple (UTIntegerConstant 1) (UTIntegerConstant 2) ))) - ))); - ((Range.Normal ), - (UTBindValue (Stage1, - (UTNonRec - (((Range.Normal ), "tp3"), - (UTTuple (UTIntegerConstant 1) (UTIntegerConstant 2) - (UTIntegerConstant 3)))) - ))); - ((Range.Normal ), - (UTBindValue (Stage1, - (UTNonRec - (((Range.Normal ), "op-test"), - (UTTuple - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "||"))), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "||"))), - (UTContentOf ([], - ((Range.Normal ), "a"))) - )), - (UTContentOf ([], - ((Range.Normal ), "b"))) - )) - )), - (UTContentOf ([], - ((Range.Normal ), "c"))) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "&&"))), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "&&"))), - (UTContentOf ([], - ((Range.Normal ), "a"))) - )), - (UTContentOf ([], - ((Range.Normal ), "b"))) - )) - )), - (UTContentOf ([], - ((Range.Normal ), "c"))) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "=="))), - (UTContentOf ([], - ((Range.Normal ), "a"))) - )), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), ">"))), - (UTContentOf ([], - ((Range.Normal ), "b"))) - )), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "<"))), - (UTContentOf ([], - ((Range.Normal ), "c"))) - )), - (UTContentOf ([], - ((Range.Normal ), "d"))) - )) - )) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "^"))), - (UTContentOf ([], - ((Range.Normal ), "a"))) - )), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "::"))), - (UTContentOf ([], - ((Range.Normal ), "b"))) - )), - (UTContentOf ([], - ((Range.Normal ), "c"))) - )) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "+"))), - (UTContentOf ([], - ((Range.Normal ), "a"))) - )), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "+"))), - (UTContentOf ([], - ((Range.Normal ), "b"))) - )), - (UTContentOf ([], - ((Range.Normal ), "c"))) - )) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "-'"))), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "-"))), - (UTContentOf ([], - ((Range.Normal ), "a"))) - )), - (UTContentOf ([], - ((Range.Normal ), "b"))) - )) - )), - (UTContentOf ([], - ((Range.Normal ), "c"))) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "+"))), - (UTContentOf ([], - ((Range.Normal ), "a"))) - )), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "+"))), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "-"))), - (UTContentOf ([], - ((Range.Normal ), "b"))) - )), - (UTContentOf ([], - ((Range.Normal ), "c"))) - )) - )), - (UTContentOf ([], - ((Range.Normal ), "d"))) - )) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "*"))), - (UTContentOf ([], - ((Range.Normal ), "a"))) - )), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "*'"))), - (UTContentOf ([], - ((Range.Normal ), "b"))) - )), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "/"))), - (UTContentOf ([], - ((Range.Normal ), "c"))) - )), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "mod") - )), - (UTContentOf ([], - ((Range.Normal ), "d"))) - )), - (UTContentOf ([], - ((Range.Normal ), "e"))) - )) - )) - )) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "*"))), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "-"))), - (UTIntegerConstant 0))), - (UTContentOf ([], - ((Range.Normal ), "a"))) - )) - )), - (UTContentOf ([], - ((Range.Normal ), "b"))) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "||"))), - (UTContentOf ([], - ((Range.Normal ), "a"))) - )), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "&&"))), - (UTContentOf ([], - ((Range.Normal ), "a"))) - )), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "=="))), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "^") - )), - (UTContentOf ([], - ((Range.Normal ), "b") - )) - )), - (UTContentOf ([], - ((Range.Normal ), "c"))) - )) - )), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), ">"))), - (UTContentOf ([], - ((Range.Normal ), "d"))) - )), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "<") - )), - (UTContentOf ([], - ((Range.Normal ), "e") - )) - )), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), - "^") - )), - (UTContentOf ([], - ((Range.Normal ), - "f") - )) - )), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), - "::") - )), - (UTContentOf ([], - ((Range.Normal ), - "g") - )) - )), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), - "+") - )), - (UTContentOf ([], - ((Range.Normal ), - "h") - )) - )), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), - "-'") - )), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), - "-") - )), - (UTContentOf ([], - ((Range.Normal ), - "i") - )) - )), - (UTContentOf ([], - ((Range.Normal ), - "j") - )) - )) - )), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), - "*") - )), - (UTContentOf ([], - ((Range.Normal ), - "k") - )) - )), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), - "*'") - )), - (UTContentOf ([], - ((Range.Normal ), - "l") - )) - )), - (UTApply ([], - (UTApply ([], - (UTContentOf ( - [], - ((Range.Normal ), - "/") - )), - (UTContentOf ( - [], - ((Range.Normal ), - "m") - )) - )), - (UTApply ([], - (UTApply ([], - (UTContentOf ( - [], - ((Range.Normal ), - "mod") - )), - (UTContentOf ( - [], - ((Range.Normal ), - "n") - )) - )), - (UTContentOf ( - [], - ((Range.Normal ), - "o") - )) - )) - )) - )) - )) - )) - )) - )) - )) - )) - )) - )) - )) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "*"))), - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "-"))), - (UTIntegerConstant 0))), - (UTContentOf ([], - ((Range.Normal ), "a"))) - )) - )), - (UTContentOf ([], - ((Range.Normal ), "b"))) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "*"))), - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "not"))), - (UTContentOf ([], - ((Range.Normal ), "a"))) - )) - )), - (UTContentOf ([], - ((Range.Normal ), "b"))) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "*"))), - (UTConstructor ("F", - (UTContentOf ([], - ((Range.Normal ), "a"))) - )) - )), - (UTContentOf ([], - ((Range.Normal ), "b"))) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "*"))), - (UTConstructor ("A", UTUnitConstant)))), - (UTContentOf ([], - ((Range.Normal ), "b"))) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "+"))), - (UTContentOf ([], - ((Range.Normal ), "a"))) - )), - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "f"))), - (UTContentOf ([], - ((Range.Normal ), "b"))) - )) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "-"))), - (UTContentOf ([], - ((Range.Normal ), "f"))) - )), - (UTContentOf ([], - ((Range.Normal ), "b"))) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "&&"))), - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "not"))), - (UTContentOf ([], - ((Range.Normal ), "a"))) - )) - )), - (UTContentOf ([], - ((Range.Normal ), "b"))) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "||"))), - (UTContentOf ([], - ((Range.Normal ), "a"))) - )), - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "not"))), - (UTContentOf ([], - ((Range.Normal ), "b"))) - )) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "*"))), - (UTContentOf ([], - ((Range.Normal ), "a"))) - )), - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "not"))), - (UTContentOf ([], - ((Range.Normal ), "b"))) - )) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "*"))), - (UTContentOf ([], - ((Range.Normal ), "a"))) - )), - (UTConstructor ("F", - (UTContentOf ([], - ((Range.Normal ), "b"))) - )) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "*"))), - (UTContentOf ([], - ((Range.Normal ), "a"))) - )), - (UTConstructor ("B", UTUnitConstant)))) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "*"))), - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "not"))), - (UTContentOf ([], - ((Range.Normal ), "a"))) - )) - )), - (UTContentOf ([], - ((Range.Normal ), "b"))) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "*"))), - (UTConstructor ("F", - (UTContentOf ([], - ((Range.Normal ), "a"))) - )) - )), - (UTContentOf ([], - ((Range.Normal ), "b"))) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "*"))), - (UTConstructor ("A", UTUnitConstant)))), - (UTContentOf ([], - ((Range.Normal ), "b"))) - ))))) - ))); - ((Range.Normal ), - (UTBindValue (Stage1, - (UTNonRec - (((Range.Normal ), "uminus"), - (UTTuple - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "-"))), - (UTIntegerConstant 0))), - (UTIntegerConstant 1))) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "-"))), - (UTIntegerConstant 0))), - (UTIntegerConstant 42))) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "-."))), - (UTFloatConstant 0.))), - (UTFloatConstant 1.))) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "-."))), - (UTFloatConstant 0.))), - (UTFloatConstant 3.14))) - (UTLengthDescription (-1., "mm")) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "-'"))), - (UTLengthDescription (0., "cm")))), - (UTLengthDescription (2.71828, "cm")))) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "-"))), - (UTIntegerConstant 0))), - (UTContentOf ([], - ((Range.Normal ), "x"))) - )) - (UTApply ([], - (UTApply ([], - (UTContentOf ([], - ((Range.Normal ), "-"))), - (UTIntegerConstant 0))), - (UTContentOf ([], - ((Range.Normal ), "x"))) - ))))) - ))) - ])) + ((Range.Normal ), + (UTBindValue (Stage1, + (UTNonRec + (((Range.Normal ), "ys"), + (UTListCons ((UTIntegerConstant 1), + (UTListCons ((UTIntegerConstant 2), + (UTListCons ((UTIntegerConstant 3), UTEndOfList)))) + )))) + ))); + ((Range.Normal ), + (UTBindValue (Stage1, + (UTNonRec (((Range.Normal ), "r0"), (UTRecord []))) + ))); + ((Range.Normal ), + (UTBindValue (Stage1, + (UTNonRec + (((Range.Normal ), "r1"), + (UTRecord + [(((Range.Normal ), "x"), + (UTIntegerConstant 1))]))) + ))); + ((Range.Normal ), + (UTBindValue (Stage1, + (UTNonRec + (((Range.Normal ), "r2"), + (UTRecord + [(((Range.Normal ), "x"), + (UTIntegerConstant 1)); + (((Range.Normal ), "y"), + (UTIntegerConstant 2)) + ]))) + ))); + ((Range.Normal ), + (UTBindValue (Stage1, + (UTNonRec + (((Range.Normal ), "r2semi"), + (UTRecord + [(((Range.Normal ), "x"), + (UTIntegerConstant 1)); + (((Range.Normal ), "y"), + (UTIntegerConstant 2)) + ]))) + ))); + ((Range.Normal ), + (UTBindValue (Stage1, + (UTNonRec + (((Range.Normal ), "tp2"), + (UTTuple (UTIntegerConstant 1) (UTIntegerConstant 2) ))) + ))); + ((Range.Normal ), + (UTBindValue (Stage1, + (UTNonRec + (((Range.Normal ), "tp3"), + (UTTuple (UTIntegerConstant 1) (UTIntegerConstant 2) + (UTIntegerConstant 3)))) + ))); + ((Range.Normal ), + (UTBindValue (Stage1, + (UTNonRec + (((Range.Normal ), "op-test"), + (UTTuple + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "||"))), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "||"))), + (UTContentOf ([], + ((Range.Normal ), "a"))) + )), + (UTContentOf ([], + ((Range.Normal ), "b"))) + )) + )), + (UTContentOf ([], + ((Range.Normal ), "c"))) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "&&"))), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "&&"))), + (UTContentOf ([], + ((Range.Normal ), "a"))) + )), + (UTContentOf ([], + ((Range.Normal ), "b"))) + )) + )), + (UTContentOf ([], + ((Range.Normal ), "c"))) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "=="))), + (UTContentOf ([], + ((Range.Normal ), "a"))) + )), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), ">"))), + (UTContentOf ([], + ((Range.Normal ), "b"))) + )), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "<"))), + (UTContentOf ([], + ((Range.Normal ), "c"))) + )), + (UTContentOf ([], + ((Range.Normal ), "d"))) + )) + )) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "^"))), + (UTContentOf ([], + ((Range.Normal ), "a"))) + )), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "::"))), + (UTContentOf ([], + ((Range.Normal ), "b"))) + )), + (UTContentOf ([], + ((Range.Normal ), "c"))) + )) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "+"))), + (UTContentOf ([], + ((Range.Normal ), "a"))) + )), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "+"))), + (UTContentOf ([], + ((Range.Normal ), "b"))) + )), + (UTContentOf ([], + ((Range.Normal ), "c"))) + )) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "-'"))), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "-"))), + (UTContentOf ([], + ((Range.Normal ), "a"))) + )), + (UTContentOf ([], + ((Range.Normal ), "b"))) + )) + )), + (UTContentOf ([], + ((Range.Normal ), "c"))) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "+"))), + (UTContentOf ([], + ((Range.Normal ), "a"))) + )), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "+"))), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "-") + )), + (UTContentOf ([], + ((Range.Normal ), "b") + )) + )), + (UTContentOf ([], + ((Range.Normal ), "c"))) + )) + )), + (UTContentOf ([], + ((Range.Normal ), "d"))) + )) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "*"))), + (UTContentOf ([], + ((Range.Normal ), "a"))) + )), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "*'"))), + (UTContentOf ([], + ((Range.Normal ), "b"))) + )), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "/"))), + (UTContentOf ([], + ((Range.Normal ), "c"))) + )), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "mod") + )), + (UTContentOf ([], + ((Range.Normal ), "d") + )) + )), + (UTContentOf ([], + ((Range.Normal ), "e"))) + )) + )) + )) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "*"))), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "-"))), + (UTIntegerConstant 0))), + (UTContentOf ([], + ((Range.Normal ), "a"))) + )) + )), + (UTContentOf ([], + ((Range.Normal ), "b"))) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "||"))), + (UTContentOf ([], + ((Range.Normal ), "a"))) + )), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "&&"))), + (UTContentOf ([], + ((Range.Normal ), "a"))) + )), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "=="))), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), + "^") + )), + (UTContentOf ([], + ((Range.Normal ), + "b") + )) + )), + (UTContentOf ([], + ((Range.Normal ), "c") + )) + )) + )), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), ">") + )), + (UTContentOf ([], + ((Range.Normal ), "d") + )) + )), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), + "<") + )), + (UTContentOf ([], + ((Range.Normal ), + "e") + )) + )), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), + "^") + )), + (UTContentOf ([], + ((Range.Normal ), + "f") + )) + )), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), + "::") + )), + (UTContentOf ([], + ((Range.Normal ), + "g") + )) + )), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), + "+") + )), + (UTContentOf ([], + ((Range.Normal ), + "h") + )) + )), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), + "-'") + )), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), + "-") + )), + (UTContentOf ([], + ((Range.Normal ), + "i") + )) + )), + (UTContentOf ([], + ((Range.Normal ), + "j") + )) + )) + )), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), + "*") + )), + (UTContentOf ([], + ((Range.Normal ), + "k") + )) + )), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), + "*'") + )), + (UTContentOf ([], + ((Range.Normal ), + "l") + )) + )), + (UTApply ([], + (UTApply ([], + (UTContentOf ( + [], + ((Range.Normal ), + "/") + )), + (UTContentOf ( + [], + ((Range.Normal ), + "m") + )) + )), + (UTApply ([], + (UTApply ([], + (UTContentOf ( + [], + ((Range.Normal ), + "mod") + )), + (UTContentOf ( + [], + ((Range.Normal ), + "n") + )) + )), + (UTContentOf ( + [], + ((Range.Normal ), + "o") + )) + )) + )) + )) + )) + )) + )) + )) + )) + )) + )) + )) + )) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "*"))), + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "-"))), + (UTIntegerConstant 0))), + (UTContentOf ([], + ((Range.Normal ), "a"))) + )) + )), + (UTContentOf ([], + ((Range.Normal ), "b"))) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "*"))), + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "not"))), + (UTContentOf ([], + ((Range.Normal ), "a"))) + )) + )), + (UTContentOf ([], + ((Range.Normal ), "b"))) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "*"))), + (UTConstructor ("F", + (UTContentOf ([], + ((Range.Normal ), "a"))) + )) + )), + (UTContentOf ([], + ((Range.Normal ), "b"))) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "*"))), + (UTConstructor ("A", UTUnitConstant)))), + (UTContentOf ([], + ((Range.Normal ), "b"))) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "+"))), + (UTContentOf ([], + ((Range.Normal ), "a"))) + )), + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "f"))), + (UTContentOf ([], + ((Range.Normal ), "b"))) + )) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "-"))), + (UTContentOf ([], + ((Range.Normal ), "f"))) + )), + (UTContentOf ([], + ((Range.Normal ), "b"))) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "&&"))), + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "not"))), + (UTContentOf ([], + ((Range.Normal ), "a"))) + )) + )), + (UTContentOf ([], + ((Range.Normal ), "b"))) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "||"))), + (UTContentOf ([], + ((Range.Normal ), "a"))) + )), + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "not"))), + (UTContentOf ([], + ((Range.Normal ), "b"))) + )) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "*"))), + (UTContentOf ([], + ((Range.Normal ), "a"))) + )), + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "not"))), + (UTContentOf ([], + ((Range.Normal ), "b"))) + )) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "*"))), + (UTContentOf ([], + ((Range.Normal ), "a"))) + )), + (UTConstructor ("F", + (UTContentOf ([], + ((Range.Normal ), "b"))) + )) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "*"))), + (UTContentOf ([], + ((Range.Normal ), "a"))) + )), + (UTConstructor ("B", UTUnitConstant)))) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "*"))), + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "not"))), + (UTContentOf ([], + ((Range.Normal ), "a"))) + )) + )), + (UTContentOf ([], + ((Range.Normal ), "b"))) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "*"))), + (UTConstructor ("F", + (UTContentOf ([], + ((Range.Normal ), "a"))) + )) + )), + (UTContentOf ([], + ((Range.Normal ), "b"))) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "*"))), + (UTConstructor ("A", UTUnitConstant)))), + (UTContentOf ([], + ((Range.Normal ), "b"))) + ))))) + ))); + ((Range.Normal ), + (UTBindValue (Stage1, + (UTNonRec + (((Range.Normal ), "uminus"), + (UTTuple + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "-"))), + (UTIntegerConstant 0))), + (UTIntegerConstant 1))) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "-"))), + (UTIntegerConstant 0))), + (UTIntegerConstant 42))) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "-."))), + (UTFloatConstant 0.))), + (UTFloatConstant 1.))) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "-."))), + (UTFloatConstant 0.))), + (UTFloatConstant 3.14))) + (UTLengthDescription (-1., "mm")) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "-'"))), + (UTLengthDescription (0., "cm")))), + (UTLengthDescription (2.71828, "cm")))) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "-"))), + (UTIntegerConstant 0))), + (UTContentOf ([], + ((Range.Normal ), "x"))) + )) + (UTApply ([], + (UTApply ([], + (UTContentOf ([], + ((Range.Normal ), "-"))), + (UTIntegerConstant 0))), + (UTContentOf ([], + ((Range.Normal ), "x"))) + ))))) + ))) + ]))) ;; variants.saty (UTLibraryFile - (((Range.Normal ), "Variants"), None, - [((Range.Normal ), - (UTBindType - [(((Range.Normal ), "t"), [], - (UTBindVariant - [(UTConstructorBranch ( - ((Range.Normal ), "X"), None)); - (UTConstructorBranch ( - ((Range.Normal ), "Y"), None)) - ])); - (((Range.Normal ), "s"), [], + ([], + (((Range.Normal ), "Variants"), None, + [((Range.Normal ), + (UTBindType + [(((Range.Normal ), "t"), [], (UTBindVariant [(UTConstructorBranch ( - ((Range.Normal ), "Z"), - (Some ((Range.Normal ), - (Types.MTypeName ([], - ((Range.Normal ), "t"), - [])))) - )); + ((Range.Normal ), "X"), None)); (UTConstructorBranch ( - ((Range.Normal ), "W"), - (Some ((Range.Normal ), + ((Range.Normal ), "Y"), None)) + ])); + (((Range.Normal ), "s"), [], + (UTBindVariant + [(UTConstructorBranch ( + ((Range.Normal ), "Z"), + (Some ((Range.Normal ), (Types.MTypeName ([], - ((Range.Normal ), "u"), + ((Range.Normal ), "t"), [])))) - )) - ])) - ])) - ])) + )); + (UTConstructorBranch ( + ((Range.Normal ), "W"), + (Some ((Range.Normal ), + (Types.MTypeName ([], + ((Range.Normal ), "u"), + [])))) + )) + ])) + ])) + ]))) ;; txprod.saty (UTLibraryFile - (((Range.Normal ), "Txprod"), None, - [((Range.Normal ), - (UTBindType - [(((Range.Normal ), "t"), [], - (UTBindSynonym - ((Range.Normal ), - (Types.MProductType - ((Range.Normal ), - (Types.MTypeName ([], - ((Range.Normal ), "a"), []))) - ((Range.Normal ), - (Types.MTypeName ([], - ((Range.Normal ), "b"), []))) - )))); - (((Range.Normal ), "s"), [], + ([], + (((Range.Normal ), "Txprod"), None, + [((Range.Normal ), + (UTBindType + [(((Range.Normal ), "t"), [], (UTBindSynonym - ((Range.Normal ), + ((Range.Normal ), (Types.MProductType - ((Range.Normal ), + ((Range.Normal ), (Types.MTypeName ([], - ((Range.Normal ), "a"), []))) - ((Range.Normal ), + ((Range.Normal ), "a"), []))) + ((Range.Normal ), (Types.MTypeName ([], - ((Range.Normal ), "b"), []))) - ((Range.Normal ), - (Types.MTypeName ([], - ((Range.Normal ), "c"), []))))))) - ])) - ])) + ((Range.Normal ), "b"), []))) + )))); + (((Range.Normal ), "s"), [], + (UTBindSynonym + ((Range.Normal ), + (Types.MProductType + ((Range.Normal ), + (Types.MTypeName ([], + ((Range.Normal ), "a"), + []))) + ((Range.Normal ), + (Types.MTypeName ([], + ((Range.Normal ), "b"), + []))) + ((Range.Normal ), + (Types.MTypeName ([], + ((Range.Normal ), "c"), + []))))))) + ])) + ]))) ;; txlist.saty (UTLibraryFile - (((Range.Normal ), "Txlist"), None, - [((Range.Normal ), - (UTBindType - [(((Range.Normal ), "t"), [], - (UTBindSynonym - ((Range.Normal ), - (Types.MInlineCommandType - [(Types.MArgType ( - [(((Range.Normal ), "foo"), - ((Range.Normal ), - (Types.MTypeName ([], - ((Range.Normal ), "u"), - [])))) - ], - ((Range.Normal ), - (Types.MTypeName ([], - ((Range.Normal ), "s"), - []))) - )) - ])))); - (((Range.Normal ), "t"), [], + ([], + (((Range.Normal ), "Txlist"), None, + [((Range.Normal ), + (UTBindType + [(((Range.Normal ), "t"), [], (UTBindSynonym - ((Range.Normal ), - (Types.MInlineCommandType [])))); - (((Range.Normal ), "t"), [], - (UTBindSynonym - ((Range.Normal ), + ((Range.Normal ), (Types.MInlineCommandType - [(Types.MArgType ([], - ((Range.Normal ), + [(Types.MArgType ( + [(((Range.Normal ), "foo"), + ((Range.Normal ), + (Types.MTypeName ([], + ((Range.Normal ), "u"), + [])))) + ], + ((Range.Normal ), (Types.MTypeName ([], - ((Range.Normal ), "s"), + ((Range.Normal ), "s"), []))) )) ])))); - (((Range.Normal ), "t"), [], - (UTBindSynonym - ((Range.Normal ), - (Types.MInlineCommandType - [(Types.MArgType ([], - ((Range.Normal ), - (Types.MTypeName ([], - ((Range.Normal ), "s"), - []))) - )) - ])))) - ])) - ])) + (((Range.Normal ), "t"), [], + (UTBindSynonym + ((Range.Normal ), + (Types.MInlineCommandType [])))); + (((Range.Normal ), "t"), [], + (UTBindSynonym + ((Range.Normal ), + (Types.MInlineCommandType + [(Types.MArgType ([], + ((Range.Normal ), + (Types.MTypeName ([], + ((Range.Normal ), "s"), + []))) + )) + ])))); + (((Range.Normal ), "t"), [], + (UTBindSynonym + ((Range.Normal ), + (Types.MInlineCommandType + [(Types.MArgType ([], + ((Range.Normal ), + (Types.MTypeName ([], + ((Range.Normal ), "s"), + []))) + )) + ])))) + ])) + ]))) ;; txrecord.saty (UTLibraryFile - (((Range.Normal ), "Txrecord"), None, - [((Range.Normal ), - (UTBindType - [(((Range.Normal ), "t"), [], - (UTBindSynonym - ((Range.Normal ), - (Types.MRecordType ( - [(((Range.Normal ), "x"), - ((Range.Normal ), - (Types.MTypeName ([], - ((Range.Normal ), "a"), - [])))); - (((Range.Normal ), "y"), - ((Range.Normal ), - (Types.MTypeName ([], - ((Range.Normal ), "b"), - [])))) - ], - None))))); - (((Range.Normal ), "t"), [], + ([], + (((Range.Normal ), "Txrecord"), None, + [((Range.Normal ), + (UTBindType + [(((Range.Normal ), "t"), [], (UTBindSynonym - ((Range.Normal ), + ((Range.Normal ), (Types.MRecordType ( - [(((Range.Normal ), "x"), - ((Range.Normal ), + [(((Range.Normal ), "x"), + ((Range.Normal ), (Types.MTypeName ([], - ((Range.Normal ), "a"), + ((Range.Normal ), "a"), [])))); - (((Range.Normal ), "y"), - ((Range.Normal ), + (((Range.Normal ), "y"), + ((Range.Normal ), (Types.MTypeName ([], - ((Range.Normal ), "b"), + ((Range.Normal ), "b"), [])))) ], None))))); - (((Range.Normal ), "t"), [], - (UTBindSynonym - ((Range.Normal ), - (Types.MRecordType ( - [(((Range.Normal ), "x"), - ((Range.Normal ), - (Types.MTypeName ([], - ((Range.Normal ), "a"), - [])))) - ], - None))))) - ])) - ])) + (((Range.Normal ), "t"), [], + (UTBindSynonym + ((Range.Normal ), + (Types.MRecordType ( + [(((Range.Normal ), "x"), + ((Range.Normal ), + (Types.MTypeName ([], + ((Range.Normal ), "a"), + [])))); + (((Range.Normal ), "y"), + ((Range.Normal ), + (Types.MTypeName ([], + ((Range.Normal ), "b"), + [])))) + ], + None))))); + (((Range.Normal ), "t"), [], + (UTBindSynonym + ((Range.Normal ), + (Types.MRecordType ( + [(((Range.Normal ), "x"), + ((Range.Normal ), + (Types.MTypeName ([], + ((Range.Normal ), "a"), + [])))) + ], + None))))) + ])) + ]))) ;; pats.saty (UTLibraryFile - (((Range.Normal ), "Pats"), None, - [((Range.Normal ), - (UTBindValue (Stage1, - (UTNonRec - (((Range.Normal ), "pats-test1"), - (UTPatternMatch ( - (UTContentOf ([], ((Range.Normal ), "a"))), - [(UTPatternBranch ( - ((Range.Normal ), (UTPVariable "b")), - (UTContentOf ([], - ((Range.Normal ), "d"))) - )) - ] - )))) - ))); - ((Range.Normal ), + ([], + (((Range.Normal ), "Pats"), None, + [((Range.Normal ), (UTBindValue (Stage1, (UTNonRec - (((Range.Normal ), "pats-test2"), + (((Range.Normal ), "pats-test1"), (UTPatternMatch ( - (UTContentOf ([], ((Range.Normal ), "a") + (UTContentOf ([], ((Range.Normal ), "a") )), [(UTPatternBranch ( - ((Range.Normal ), (UTPVariable "b")), + ((Range.Normal ), (UTPVariable "b")), (UTContentOf ([], - ((Range.Normal ), "d"))) + ((Range.Normal ), "d"))) )) ] )))) - ))) - ])) + ))); + ((Range.Normal ), + (UTBindValue (Stage1, + (UTNonRec + (((Range.Normal ), "pats-test2"), + (UTPatternMatch ( + (UTContentOf ([], ((Range.Normal ), "a") + )), + [(UTPatternBranch ( + ((Range.Normal ), (UTPVariable "b")), + (UTContentOf ([], + ((Range.Normal ), "d"))) + )) + ] + )))) + ))) + ]))) ;; pattuple.saty (UTLibraryFile - (((Range.Normal ), "Pattuple"), None, - [((Range.Normal ), - (UTBindValue (Stage1, - (UTNonRec - (((Range.Normal ), "pattuple-test"), - (UTPatternMatch ( - (UTContentOf ([], - ((Range.Normal ), "a"))), - [(UTPatternBranch ( - ((Range.Normal ), - (UTPTuple - ((Range.Normal ), - (UTPVariable "b")) - ((Range.Normal ), - (UTPVariable "c")) - )), - (UTContentOf ([], - ((Range.Normal ), "d"))) - )) - ] - )))) - ))) - ])) + ([], + (((Range.Normal ), "Pattuple"), None, + [((Range.Normal ), + (UTBindValue (Stage1, + (UTNonRec + (((Range.Normal ), "pattuple-test"), + (UTPatternMatch ( + (UTContentOf ([], + ((Range.Normal ), "a"))), + [(UTPatternBranch ( + ((Range.Normal ), + (UTPTuple + ((Range.Normal ), + (UTPVariable "b")) + ((Range.Normal ), + (UTPVariable "c")) + )), + (UTContentOf ([], + ((Range.Normal ), "d"))) + )) + ] + )))) + ))) + ]))) ;; patlist.saty (UTLibraryFile - (((Range.Normal ), "Patlist"), None, - [((Range.Normal ), - (UTBindValue (Stage1, - (UTNonRec - (((Range.Normal ), "pat-test"), - (UTPatternMatch ( - (UTContentOf ([], - ((Range.Normal ), "a"))), - [(UTPatternBranch ( - ((Range.Normal ), - (UTPListCons ( - ((Range.Normal ), - (UTPVariable "b")), - ((Range.Dummy "list-pattern-nil"), UTPEndOfList)))), - (UTContentOf ([], - ((Range.Normal ), "c"))) - )); - (UTPatternBranch ( - ((Range.Normal ), + ([], + (((Range.Normal ), "Patlist"), None, + [((Range.Normal ), + (UTBindValue (Stage1, + (UTNonRec + (((Range.Normal ), "pat-test"), + (UTPatternMatch ( + (UTContentOf ([], + ((Range.Normal ), "a"))), + [(UTPatternBranch ( + ((Range.Normal ), (UTPListCons ( - ((Range.Normal ), + ((Range.Normal ), (UTPVariable "b")), - ((Range.Dummy "list-pattern-cons"), - (UTPListCons ( - ((Range.Normal ), - (UTPVariable "c")), - ((Range.Dummy "list-pattern-nil"), UTPEndOfList) - ))) - ))), + ((Range.Dummy "list-pattern-nil"), UTPEndOfList)))), (UTContentOf ([], - ((Range.Normal ), "d"))) + ((Range.Normal ), "c"))) )); - (UTPatternBranch ( - ((Range.Normal ), - (UTPListCons ( - ((Range.Normal ), - (UTPVariable "b")), - ((Range.Dummy "list-pattern-cons"), - (UTPListCons ( - ((Range.Normal ), - (UTPVariable "c")), - ((Range.Dummy "list-pattern-nil"), UTPEndOfList) - ))) - ))), - (UTContentOf ([], - ((Range.Normal ), "d"))) - )) - ] - )))) - ))) - ])) + (UTPatternBranch ( + ((Range.Normal ), + (UTPListCons ( + ((Range.Normal ), + (UTPVariable "b")), + ((Range.Dummy "list-pattern-cons"), + (UTPListCons ( + ((Range.Normal ), + (UTPVariable "c")), + ((Range.Dummy "list-pattern-nil"), UTPEndOfList) + ))) + ))), + (UTContentOf ([], + ((Range.Normal ), "d"))) + )); + (UTPatternBranch ( + ((Range.Normal ), + (UTPListCons ( + ((Range.Normal ), + (UTPVariable "b")), + ((Range.Dummy "list-pattern-cons"), + (UTPListCons ( + ((Range.Normal ), + (UTPVariable "c")), + ((Range.Dummy "list-pattern-nil"), UTPEndOfList) + ))) + ))), + (UTContentOf ([], + ((Range.Normal ), "d"))) + )) + ] + )))) + ))) + ]))) ;; sxlist.saty (UTLibraryFile - (((Range.Normal ), "Sxlist"), None, - [((Range.Normal ), - (UTBindValue (Stage1, - (UTNonRec (((Range.Normal ), "x"), UTEndOfList)) - ))); - ((Range.Normal ), + ([], + (((Range.Normal ), "Sxlist"), None, + [((Range.Normal ), (UTBindValue (Stage1, - (UTNonRec - (((Range.Normal ), "y"), - (UTListCons ((UTInlineText [IT:aa]), - (UTListCons ((UTInlineText [IT:bb]), UTEndOfList)))))) - ))) - ])) + (UTNonRec (((Range.Normal ), "x"), UTEndOfList)) + ))); + ((Range.Normal ), + (UTBindValue (Stage1, + (UTNonRec + (((Range.Normal ), "y"), + (UTListCons ((UTInlineText [IT:aa]), + (UTListCons ((UTInlineText [IT:bb]), UTEndOfList)))))) + ))) + ]))) ;; mathlist.saty (UTLibraryFile - (((Range.Normal ), "Mathlist"), None, - [((Range.Normal ), - (UTBindValue (Stage1, - (UTNonRec (((Range.Normal ), "x"), UTEndOfList)) - ))); - ((Range.Normal ), + ([], + (((Range.Normal ), "Mathlist"), None, + [((Range.Normal ), (UTBindValue (Stage1, (UTNonRec - (((Range.Normal ), "y"), - (UTListCons ( - (UTMathText - [((Range.Normal ), - UTMathTextElement {base = (UTMathTextChar "a"); - sup = None; sub = None}) - ]), - (UTListCons ( - (UTMathText - [((Range.Normal ), - UTMathTextElement {base = (UTMathTextChar "a"); - sup = None; sub = None}); - ((Range.Normal ), - UTMathTextElement {base = (UTMathTextChar "b"); - sup = None; sub = None}) - ]), - UTEndOfList)) - )))) + (((Range.Normal ), "x"), UTEndOfList)) ))); - ((Range.Normal ), - (UTBindValue (Stage1, - (UTNonRec - (((Range.Normal ), "z"), - (UTBlockText - [BC:(UTContentOf ([], - ((Range.Normal ), "+p"))) ( - UTCommandArg ([], - (UTInlineText - [(UTInlineTextEmbeddedMath - (UTMathText - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "a"); sup = None; - sub = None}) - ])); - IT: -; - (UTInlineTextEmbeddedMath - (UTMathText - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "a"); - sup = - (Some (false, - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "1"); - sup = None; sub = None}) - ])); - sub = None}) - ])); - IT: -; - (UTInlineTextEmbeddedMath + ((Range.Normal ), + (UTBindValue (Stage1, + (UTNonRec + (((Range.Normal ), "y"), + (UTListCons ( + (UTMathText + [((Range.Normal ), + UTMathTextElement {base = (UTMathTextChar "a"); + sup = None; sub = None}) + ]), + (UTListCons ( + (UTMathText + [((Range.Normal ), + UTMathTextElement {base = (UTMathTextChar "a"); + sup = None; sub = None}); + ((Range.Normal ), + UTMathTextElement {base = (UTMathTextChar "b"); + sup = None; sub = None}) + ]), + UTEndOfList)) + )))) + ))); + ((Range.Normal ), + (UTBindValue (Stage1, + (UTNonRec + (((Range.Normal ), "z"), + (UTBlockText + [BC:(UTContentOf ([], + ((Range.Normal ), "+p"))) ( + UTCommandArg ([], + (UTInlineText + [(UTInlineTextEmbeddedMath (UTMathText - [((Range.Normal ), + [((Range.Normal ), UTMathTextElement { base = (UTMathTextChar "a"); sup = None; - sub = - (Some (false, - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "2"); - sup = None; sub = None}) - ]))}) - ])); - IT: -; - (UTInlineTextEmbeddedMath - (UTMathText - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "a"); - sup = - (Some (false, - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "1"); - sup = None; sub = None}) - ])); - sub = - (Some (false, - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "2"); - sup = None; sub = None}) - ]))}) - ])); - IT: -; - (UTInlineTextEmbeddedMath - (UTMathText - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "a"); - sup = - (Some (false, - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "1"); - sup = None; sub = None}) - ])); - sub = - (Some (false, - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "2"); - sup = None; sub = None}) - ]))}) - ])); - IT: -; - (UTInlineTextEmbeddedMath - (UTMathText - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "a"); - sup = - (Some (true, - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "′"); - sup = None; sub = None}) - ])); sub = None}) ])); - IT: + IT: ; - (UTInlineTextEmbeddedMath - (UTMathText - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "a"); - sup = - (Some (false, - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "′"); - sup = None; sub = None}); - ((Range.Normal ), + (UTInlineTextEmbeddedMath + (UTMathText + [((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "a"); + sup = + (Some (false, + [((Range.Normal ), UTMathTextElement { base = (UTMathTextChar "1"); sup = None; sub = None}) - ])); - sub = None}) - ])); - IT: + ])); + sub = None}) + ])); + IT: ; - (UTInlineTextEmbeddedMath - (UTMathText - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "a"); - sup = - (Some (true, - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "′"); - sup = None; sub = None}) - ])); - sub = - (Some (false, - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "2"); - sup = None; sub = None}) - ]))}) - ])); - IT: + (UTInlineTextEmbeddedMath + (UTMathText + [((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "a"); sup = None; + sub = + (Some (false, + [((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "2"); + sup = None; sub = None}) + ]))}) + ])); + IT: ; - (UTInlineTextEmbeddedMath - (UTMathText - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "a"); - sup = - (Some (false, - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "′"); - sup = None; sub = None}); - ((Range.Normal ), + (UTInlineTextEmbeddedMath + (UTMathText + [((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "a"); + sup = + (Some (false, + [((Range.Normal ), UTMathTextElement { base = (UTMathTextChar "1"); sup = None; sub = None}) - ])); - sub = - (Some (false, - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "2"); - sup = None; sub = None}) - ]))}) - ])); - IT: + ])); + sub = + (Some (false, + [((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "2"); + sup = None; sub = None}) + ]))}) + ])); + IT: ; - (UTInlineTextEmbeddedMath - (UTMathText - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "a"); - sup = - (Some (false, - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "′"); - sup = None; sub = None}); - ((Range.Normal ), + (UTInlineTextEmbeddedMath + (UTMathText + [((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "a"); + sup = + (Some (false, + [((Range.Normal ), UTMathTextElement { base = (UTMathTextChar "1"); sup = None; sub = None}) - ])); - sub = - (Some (false, - [((Range.Normal ), - UTMathTextElement { - base = (UTMathTextChar "2"); - sup = None; sub = None}) - ]))}) - ])) - ]) - )) - ]))) - ))) - ])) + ])); + sub = + (Some (false, + [((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "2"); + sup = None; sub = None}) + ]))}) + ])); + IT: +; + (UTInlineTextEmbeddedMath + (UTMathText + [((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "a"); + sup = + (Some (true, + [((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "′"); + sup = None; sub = None}) + ])); + sub = None}) + ])); + IT: +; + (UTInlineTextEmbeddedMath + (UTMathText + [((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "a"); + sup = + (Some (false, + [((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "′"); + sup = None; sub = None}); + ((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "1"); + sup = None; sub = None}) + ])); + sub = None}) + ])); + IT: +; + (UTInlineTextEmbeddedMath + (UTMathText + [((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "a"); + sup = + (Some (true, + [((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "′"); + sup = None; sub = None}) + ])); + sub = + (Some (false, + [((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "2"); + sup = None; sub = None}) + ]))}) + ])); + IT: +; + (UTInlineTextEmbeddedMath + (UTMathText + [((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "a"); + sup = + (Some (false, + [((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "′"); + sup = None; sub = None}); + ((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "1"); + sup = None; sub = None}) + ])); + sub = + (Some (false, + [((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "2"); + sup = None; sub = None}) + ]))}) + ])); + IT: +; + (UTInlineTextEmbeddedMath + (UTMathText + [((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "a"); + sup = + (Some (false, + [((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "′"); + sup = None; sub = None}); + ((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "1"); + sup = None; sub = None}) + ])); + sub = + (Some (false, + [((Range.Normal ), + UTMathTextElement { + base = (UTMathTextChar "2"); + sup = None; sub = None}) + ]))}) + ])) + ]) + )) + ]))) + ))) + ]))) ;; toplevel.saty (UTLibraryFile - (((Range.Normal ), "Toplevel"), None, - [((Range.Normal ), - (UTBindType - [(((Range.Normal ), "t"), [], - (UTBindSynonym - ((Range.Normal ), - (Types.MFuncType ([], None, - ((Range.Normal ), - (Types.MTypeName ([], - ((Range.Normal ), "a"), - []))), - ((Range.Normal ), - (Types.MTypeName ([], - ((Range.Normal ), "b"), - []))) - ))))); - (((Range.Normal ), "s"), [], - (UTBindVariant - [(UTConstructorBranch ( - ((Range.Normal ), "A"), None)); - (UTConstructorBranch ( - ((Range.Normal ), "B"), None)) - ])); - (((Range.Normal ), "u"), [], - (UTBindVariant - [(UTConstructorBranch ( - ((Range.Normal ), "A"), None)); - (UTConstructorBranch ( - ((Range.Normal ), "B"), None)) - ])) - ])) - ])) + ([], + (((Range.Normal ), "Toplevel"), None, + [((Range.Normal ), + (UTBindType + [(((Range.Normal ), "t"), [], + (UTBindSynonym + ((Range.Normal ), + (Types.MFuncType ([], None, + ((Range.Normal ), + (Types.MTypeName ([], + ((Range.Normal ), "a"), + []))), + ((Range.Normal ), + (Types.MTypeName ([], + ((Range.Normal ), "b"), + []))) + ))))); + (((Range.Normal ), "s"), [], + (UTBindVariant + [(UTConstructorBranch ( + ((Range.Normal ), "A"), None)); + (UTConstructorBranch ( + ((Range.Normal ), "B"), None)) + ])); + (((Range.Normal ), "u"), [], + (UTBindVariant + [(UTConstructorBranch ( + ((Range.Normal ), "A"), None)); + (UTConstructorBranch ( + ((Range.Normal ), "B"), None)) + ])) + ])) + ]))) diff --git a/test/parsing/parser_test.ml b/test/parsing/parser_test.ml index ff221aa09..1d9a5442f 100644 --- a/test/parsing/parser_test.ml +++ b/test/parsing/parser_test.ml @@ -2,7 +2,13 @@ open Core open Main__ let () = - let proj (_, utsrc) = utsrc in + let proj s = function + | Error(rng) -> + Out_channel.fprintf stderr "%s: parse error: %s\n" s @@ Range.to_string rng; + exit 1 + | Ok(utsrc) -> + utsrc + in Out_channel.print_endline ";;; generated automatically. DO NOT EDIT"; Out_channel.print_endline ";;; To update this file, you should run `dune runtest; dune promote`."; let argv = Sys.get_argv () in @@ -11,18 +17,13 @@ let () = |> List.tl |> Option.value ~default:[] |> List.iter ~f:begin fun fn -> - try - Out_channel.printf "\n;; %s\n" fn; - In_channel.with_file fn - ~f:(fun in_ch -> - Lexing.from_channel in_ch - |> ParserInterface.process fn - ) - |> proj - |> [%derive.show: Types.untyped_source_file] - |> print_endline - with - | ParserInterface.Error(rng) -> - Out_channel.fprintf stderr "%s: parse error: %s\n" argv.(0) @@ Range.to_string rng; - exit 1 + Out_channel.printf "\n;; %s\n" fn; + In_channel.with_file fn + ~f:(fun in_ch -> + Lexing.from_channel in_ch + |> ParserInterface.process_common fn + ) + |> proj (argv.(0)) + |> [%derive.show: Types.untyped_source_file] + |> print_endline end From 4fc527f8cfb60fa117ff55fc7f29376dbfe58cf3 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 25 Oct 2022 00:46:50 +0900 Subject: [PATCH 022/288] make 'demo.saty' compile --- demo/demo.saty | 7 ++- demo/local.satyh | 14 +++-- lib-satysfi/dist/packages/Annot/satysfi.yaml | 6 ++ .../dist/packages/{ => Annot/src}/annot.satyh | 12 ++-- lib-satysfi/dist/packages/Code/satysfi.yaml | 6 ++ .../dist/packages/{ => Code/src}/code.satyh | 14 +++-- .../dist/packages/FootnoteScheme/satysfi.yaml | 6 ++ .../src}/footnote-scheme.satyh | 10 +++- .../dist/packages/Itemize/satysfi.yaml | 6 ++ .../packages/{ => Itemize/src}/itemize.satyh | 12 ++-- lib-satysfi/dist/packages/Proof/satysfi.yaml | 6 ++ .../dist/packages/{ => Proof/src}/proof.satyh | 8 ++- .../dist/packages/StdJaBook/satysfi.yaml | 10 ++++ .../{ => StdJaBook/src}/stdjabook.satyh | 31 +++++----- .../packages/{ => Stdlib/src}/color.satyh | 4 +- .../dist/packages/{ => Stdlib/src}/deco.satyh | 13 ++-- .../packages/{ => Stdlib/src}/hdecoset.satyh | 2 +- .../{ => Stdlib/src}/paper-size.satyh | 0 .../dist/packages/Stdlib/src/stdlib.satyh | 60 +++++++++++++++++++ .../packages/{ => Stdlib/src}/vdecoset.satyh | 4 +- .../dist/packages/Tabular/satysfi.yaml | 6 ++ .../packages/{ => Tabular/src}/tabular.satyh | 2 - src/frontend/packageChecker.ml | 7 ++- 23 files changed, 194 insertions(+), 52 deletions(-) create mode 100644 lib-satysfi/dist/packages/Annot/satysfi.yaml rename lib-satysfi/dist/packages/{ => Annot/src}/annot.satyh (88%) create mode 100644 lib-satysfi/dist/packages/Code/satysfi.yaml rename lib-satysfi/dist/packages/{ => Code/src}/code.satyh (94%) create mode 100644 lib-satysfi/dist/packages/FootnoteScheme/satysfi.yaml rename lib-satysfi/dist/packages/{ => FootnoteScheme/src}/footnote-scheme.satyh (95%) create mode 100644 lib-satysfi/dist/packages/Itemize/satysfi.yaml rename lib-satysfi/dist/packages/{ => Itemize/src}/itemize.satyh (96%) create mode 100644 lib-satysfi/dist/packages/Proof/satysfi.yaml rename lib-satysfi/dist/packages/{ => Proof/src}/proof.satyh (94%) create mode 100644 lib-satysfi/dist/packages/StdJaBook/satysfi.yaml rename lib-satysfi/dist/packages/{ => StdJaBook/src}/stdjabook.satyh (97%) rename lib-satysfi/dist/packages/{ => Stdlib/src}/color.satyh (97%) rename lib-satysfi/dist/packages/{ => Stdlib/src}/deco.satyh (63%) rename lib-satysfi/dist/packages/{ => Stdlib/src}/hdecoset.satyh (99%) rename lib-satysfi/dist/packages/{ => Stdlib/src}/paper-size.satyh (100%) rename lib-satysfi/dist/packages/{ => Stdlib/src}/vdecoset.satyh (99%) create mode 100644 lib-satysfi/dist/packages/Tabular/satysfi.yaml rename lib-satysfi/dist/packages/{ => Tabular/src}/tabular.satyh (98%) diff --git a/demo/demo.saty b/demo/demo.saty index 16b9b644f..481228778 100644 --- a/demo/demo.saty +++ b/demo/demo.saty @@ -1,11 +1,14 @@ -use package Stdjabook +use package Stdlib +use package Math use package Annot use package Code use package Itemize -use package Tabular use package Proof +use package Tabular +use package StdJaBook use Local of `./local` +let open Stdlib in let open Pervasives in let open Math in let open Proof in diff --git a/demo/local.satyh b/demo/local.satyh index d6e93af73..133bb8c27 100644 --- a/demo/local.satyh +++ b/demo/local.satyh @@ -1,11 +1,17 @@ -use package Stdjabook -use package HDecoSet -use package VDecoSet +use package Stdlib +use package Math use package Code - +use package StdJaBook module Local = struct + %- TODO: remove this by using 'open' + module List = Stdlib.List + module Color = Stdlib.Color + module HDecoSet = Stdlib.HDecoSet + module VDecoSet = Stdlib.VDecoSet + + val inline ctx \gray inner = let pads-code = (2pt, 2pt, 2pt, 2pt) in let decoset-code = HDecoSet.rectangle-round-fill 4pt 2pt (Color.gray 0.9) in diff --git a/lib-satysfi/dist/packages/Annot/satysfi.yaml b/lib-satysfi/dist/packages/Annot/satysfi.yaml new file mode 100644 index 000000000..8af472476 --- /dev/null +++ b/lib-satysfi/dist/packages/Annot/satysfi.yaml @@ -0,0 +1,6 @@ +language: "v0.1.0" +main_module: "Annot" +source_directories: + - "./src" +dependencies: + - "Stdlib" diff --git a/lib-satysfi/dist/packages/annot.satyh b/lib-satysfi/dist/packages/Annot/src/annot.satyh similarity index 88% rename from lib-satysfi/dist/packages/annot.satyh rename to lib-satysfi/dist/packages/Annot/src/annot.satyh index 6ead9c9fc..0f5ba267b 100644 --- a/lib-satysfi/dist/packages/annot.satyh +++ b/lib-satysfi/dist/packages/Annot/src/annot.satyh @@ -1,7 +1,4 @@ -@require: pervasives -@require: color -@require: gr -@require: option +use package Stdlib module Annot :> sig val \href : inline [?(border : length * color) string, inline-text] @@ -10,6 +7,13 @@ module Annot :> sig val register-location-frame : string -> deco-set end = struct + %- TODO: remove this by using 'open' + module Option = Stdlib.Option + module Pervasives = Stdlib.Pervasives + module Color = Stdlib.Color + module Gr = Stdlib.Gr + + val link-to-uri-frame uri borderopt = let deco (x, y) w h d = let () = register-link-to-uri uri (x, y) w h d borderopt in diff --git a/lib-satysfi/dist/packages/Code/satysfi.yaml b/lib-satysfi/dist/packages/Code/satysfi.yaml new file mode 100644 index 000000000..ddeb72478 --- /dev/null +++ b/lib-satysfi/dist/packages/Code/satysfi.yaml @@ -0,0 +1,6 @@ +language: "v0.1.0" +main_module: "Code" +source_directories: + - "./src" +dependencies: + - "Stdlib" diff --git a/lib-satysfi/dist/packages/code.satyh b/lib-satysfi/dist/packages/Code/src/code.satyh similarity index 94% rename from lib-satysfi/dist/packages/code.satyh rename to lib-satysfi/dist/packages/Code/src/code.satyh index dbfd431a4..dd597e35a 100644 --- a/lib-satysfi/dist/packages/code.satyh +++ b/lib-satysfi/dist/packages/Code/src/code.satyh @@ -1,8 +1,4 @@ -@require: pervasives -@require: list -@require: color -@require: gr -@require: vdecoset +use package Stdlib module Code % :> sig @@ -19,6 +15,14 @@ module Code % end = struct + %- TODO: remove this by using 'open' + module Pervasives = Stdlib.Pervasives + module List = Stdlib.List + module Color = Stdlib.Color + module Gr = Stdlib.Gr + module VDecoSet = Stdlib.VDecoSet + + signature S = sig val font-family : string val text-color : color diff --git a/lib-satysfi/dist/packages/FootnoteScheme/satysfi.yaml b/lib-satysfi/dist/packages/FootnoteScheme/satysfi.yaml new file mode 100644 index 000000000..7cb36375b --- /dev/null +++ b/lib-satysfi/dist/packages/FootnoteScheme/satysfi.yaml @@ -0,0 +1,6 @@ +language: "v0.1.0" +main_module: "FootnoteScheme" +source_directories: + - "./src" +dependencies: + - "Stdlib" diff --git a/lib-satysfi/dist/packages/footnote-scheme.satyh b/lib-satysfi/dist/packages/FootnoteScheme/src/footnote-scheme.satyh similarity index 95% rename from lib-satysfi/dist/packages/footnote-scheme.satyh rename to lib-satysfi/dist/packages/FootnoteScheme/src/footnote-scheme.satyh index 7b6d2c64b..4aef5f167 100644 --- a/lib-satysfi/dist/packages/footnote-scheme.satyh +++ b/lib-satysfi/dist/packages/FootnoteScheme/src/footnote-scheme.satyh @@ -1,6 +1,4 @@ -@require: pervasives -@require: color -@require: gr +use package Stdlib module FootnoteScheme :> sig val initialize : unit -> unit @@ -9,6 +7,12 @@ module FootnoteScheme :> sig val main-no-number : context -> (unit -> inline-boxes) -> (unit -> block-boxes) -> inline-boxes end = struct + %- TODO: remove this by using 'open' + module Pervasives = Stdlib.Pervasives + module Color = Stdlib.Color + module Gr = Stdlib.Gr + + val mutable footnote-ref <- 0 val mutable first-footnote <- true diff --git a/lib-satysfi/dist/packages/Itemize/satysfi.yaml b/lib-satysfi/dist/packages/Itemize/satysfi.yaml new file mode 100644 index 000000000..4c5976e25 --- /dev/null +++ b/lib-satysfi/dist/packages/Itemize/satysfi.yaml @@ -0,0 +1,6 @@ +language: "v0.1.0" +main_module: "Itemize" +source_directories: + - "./src" +dependencies: + - "Stdlib" diff --git a/lib-satysfi/dist/packages/itemize.satyh b/lib-satysfi/dist/packages/Itemize/src/itemize.satyh similarity index 96% rename from lib-satysfi/dist/packages/itemize.satyh rename to lib-satysfi/dist/packages/Itemize/src/itemize.satyh index 33509441d..05cea8a39 100644 --- a/lib-satysfi/dist/packages/itemize.satyh +++ b/lib-satysfi/dist/packages/Itemize/src/itemize.satyh @@ -1,7 +1,4 @@ -@require: pervasives -@require: list -@require: option -@require: gr +use package Stdlib module Itemize :> sig val +listing : block [?(break : bool) itemize] @@ -10,6 +7,13 @@ module Itemize :> sig val \enumerate : inline [itemize] end = struct + %- TODO: remove this by using 'open' + module List = Stdlib.List + module Option = Stdlib.Option + module Pervasives = Stdlib.Pervasives + module Gr = Stdlib.Gr + + val (+++>) = List.fold-left (+++) val concat-blocks = (+++>) block-nil diff --git a/lib-satysfi/dist/packages/Proof/satysfi.yaml b/lib-satysfi/dist/packages/Proof/satysfi.yaml new file mode 100644 index 000000000..115edb7a3 --- /dev/null +++ b/lib-satysfi/dist/packages/Proof/satysfi.yaml @@ -0,0 +1,6 @@ +language: "v0.1.0" +main_module: "Proof" +source_directories: + - "./src" +dependencies: + - "Stdlib" diff --git a/lib-satysfi/dist/packages/proof.satyh b/lib-satysfi/dist/packages/Proof/src/proof.satyh similarity index 94% rename from lib-satysfi/dist/packages/proof.satyh rename to lib-satysfi/dist/packages/Proof/src/proof.satyh index 528ec4c11..c264bed66 100644 --- a/lib-satysfi/dist/packages/proof.satyh +++ b/lib-satysfi/dist/packages/Proof/src/proof.satyh @@ -1,4 +1,4 @@ -@require: gr +use package Stdlib module Proof :> sig @@ -7,6 +7,12 @@ module Proof :> sig end = struct + %- TODO: remove this by using 'open' + module List = Stdlib.List + module Pervasives = Stdlib.Pervasives + module Gr = Stdlib.Gr + + val math ctx \math-space len = embed-inline-to-math MathOrd (inline-skip len) diff --git a/lib-satysfi/dist/packages/StdJaBook/satysfi.yaml b/lib-satysfi/dist/packages/StdJaBook/satysfi.yaml new file mode 100644 index 000000000..275b120a8 --- /dev/null +++ b/lib-satysfi/dist/packages/StdJaBook/satysfi.yaml @@ -0,0 +1,10 @@ +language: "v0.1.0" +main_module: "StdJaBook" +source_directories: + - "./src" +dependencies: + - "Stdlib" + - "Math" + - "Annot" + - "Code" + - "FootnoteScheme" diff --git a/lib-satysfi/dist/packages/stdjabook.satyh b/lib-satysfi/dist/packages/StdJaBook/src/stdjabook.satyh similarity index 97% rename from lib-satysfi/dist/packages/stdjabook.satyh rename to lib-satysfi/dist/packages/StdJaBook/src/stdjabook.satyh index 33fb7ac42..6fc735353 100644 --- a/lib-satysfi/dist/packages/stdjabook.satyh +++ b/lib-satysfi/dist/packages/StdJaBook/src/stdjabook.satyh @@ -1,14 +1,8 @@ -% -*- coding: utf-8 -*- -@require: pervasives -@require: gr -@require: list -@require: math -@require: code -@require: color -@require: option -@require: annot -@require: footnote-scheme -@require: paper-size +use package Stdlib +use package Math +use package Annot +use package Code +use package FootnoteScheme module StdJaBook :> sig @@ -21,9 +15,9 @@ module StdJaBook :> sig paper-size : length * length, text-width : length, text-height : length, - text-origin : Pervasives.point, - header-origin : Pervasives.point, - footer-origin : Pervasives.point, + text-origin : Stdlib.Pervasives.point, + header-origin : Stdlib.Pervasives.point, + footer-origin : Stdlib.Pervasives.point, header-width : length, footer-width : length, ) (| @@ -53,6 +47,15 @@ module StdJaBook :> sig end = struct + %- TODO: remove this by using 'open' + module Option = Stdlib.Option + module List = Stdlib.List + module Pervasives = Stdlib.Pervasives + module Gr = Stdlib.Gr + module Color = Stdlib.Color + module PaperSize = Stdlib.PaperSize + + type toc-element = | TOCElementSection of string * inline-text | TOCElementSubsection of string * inline-text diff --git a/lib-satysfi/dist/packages/color.satyh b/lib-satysfi/dist/packages/Stdlib/src/color.satyh similarity index 97% rename from lib-satysfi/dist/packages/color.satyh rename to lib-satysfi/dist/packages/Stdlib/src/color.satyh index bac70ce69..30f2fef55 100644 --- a/lib-satysfi/dist/packages/color.satyh +++ b/lib-satysfi/dist/packages/Stdlib/src/color.satyh @@ -1,5 +1,5 @@ -module Color -:> sig +module Color :> sig + val gray : float -> color val rgb : float -> float -> float -> color val black : color diff --git a/lib-satysfi/dist/packages/deco.satyh b/lib-satysfi/dist/packages/Stdlib/src/deco.satyh similarity index 63% rename from lib-satysfi/dist/packages/deco.satyh rename to lib-satysfi/dist/packages/Stdlib/src/deco.satyh index c761d3293..b3ec2a55c 100644 --- a/lib-satysfi/dist/packages/deco.satyh +++ b/lib-satysfi/dist/packages/Stdlib/src/deco.satyh @@ -1,17 +1,18 @@ -@require: gr +use Gr module Deco :> sig val empty : deco val simple-frame : length -> color -> color -> deco end = struct - val empty _ _ _ _ = [] + val empty _ _ _ _ = + unite-graphics [] val simple-frame t scolor fcolor (x, y) w h d = let path = Gr.rectangle (x, y -' d) (x +' w, y +' h) in - [ - fill fcolor path, - stroke t scolor path, - ] + unite-graphics [ + fill fcolor path, + stroke t scolor path, + ] end diff --git a/lib-satysfi/dist/packages/hdecoset.satyh b/lib-satysfi/dist/packages/Stdlib/src/hdecoset.satyh similarity index 99% rename from lib-satysfi/dist/packages/hdecoset.satyh rename to lib-satysfi/dist/packages/Stdlib/src/hdecoset.satyh index b0a764e15..2c9d5ac3c 100644 --- a/lib-satysfi/dist/packages/hdecoset.satyh +++ b/lib-satysfi/dist/packages/Stdlib/src/hdecoset.satyh @@ -1,4 +1,4 @@ -@require: gr +use Gr module HDecoSet :> sig val empty : deco-set diff --git a/lib-satysfi/dist/packages/paper-size.satyh b/lib-satysfi/dist/packages/Stdlib/src/paper-size.satyh similarity index 100% rename from lib-satysfi/dist/packages/paper-size.satyh rename to lib-satysfi/dist/packages/Stdlib/src/paper-size.satyh diff --git a/lib-satysfi/dist/packages/Stdlib/src/stdlib.satyh b/lib-satysfi/dist/packages/Stdlib/src/stdlib.satyh index 7d7fbccda..03d2e842b 100644 --- a/lib-satysfi/dist/packages/Stdlib/src/stdlib.satyh +++ b/lib-satysfi/dist/packages/Stdlib/src/stdlib.satyh @@ -2,7 +2,12 @@ use Option use List use Pervasives use Geom +use Color use Gr +use PaperSize +use Deco +use HDecoSet +use VDecoSet module Stdlib :> sig module Option : sig @@ -59,6 +64,24 @@ module Stdlib :> sig val atan2-point : point -> point -> float val div-perp : point -> point -> float -> length -> point end + module Color : sig + val gray : float -> color + val rgb : float -> float -> float -> color + val black : color + val white : color + val red : color + val yellow : color + val orange : color + val blue : color + + % web color names + val brown : color + val cyan : color + val green : color + val magenta : color + val pink : color + val purple : color + end module Gr : sig type point = Pervasives.point %TODO (enhance): erase this val rectangle : point -> point -> path @@ -82,10 +105,47 @@ module Stdlib :> sig val rotate-graphics : point -> float -> graphics -> graphics val scale-graphics : point -> float -> float -> graphics -> graphics end + module PaperSize : sig + val persistent ~a0 : length * length + val persistent ~a1 : length * length + val persistent ~a2 : length * length + val persistent ~a3 : length * length + val persistent ~a4 : length * length + val persistent ~a5 : length * length + val persistent ~a6 : length * length + val persistent ~a7 : length * length + val persistent ~a8 : length * length + val persistent ~a9 : length * length + val persistent ~a10 : length * length + + val persistent ~us-letter : length * length + val persistent ~us-legal : length * length + end + module Deco : sig + val empty : deco + val simple-frame : length -> color -> color -> deco + end + module HDecoSet : sig + val empty : deco-set + val simple-frame-stroke : length -> color -> deco-set + val rectangle-round-fill : length -> length -> color -> deco-set + end + module VDecoSet : sig + val empty : deco-set + val simple-frame-stroke : length -> color -> deco-set + val simple-frame : length -> color -> color -> deco-set + val paper : deco-set + val quote-round : length -> length -> color -> deco-set + end end = struct module Option = Option module List = List module Pervasives = Pervasives module Geom = Geom + module Color = Color module Gr = Gr + module PaperSize = PaperSize + module Deco = Deco + module HDecoSet = HDecoSet + module VDecoSet = VDecoSet end diff --git a/lib-satysfi/dist/packages/vdecoset.satyh b/lib-satysfi/dist/packages/Stdlib/src/vdecoset.satyh similarity index 99% rename from lib-satysfi/dist/packages/vdecoset.satyh rename to lib-satysfi/dist/packages/Stdlib/src/vdecoset.satyh index 6ce6f4b62..30611a39b 100644 --- a/lib-satysfi/dist/packages/vdecoset.satyh +++ b/lib-satysfi/dist/packages/Stdlib/src/vdecoset.satyh @@ -1,5 +1,5 @@ -@require: color -@require: gr +use Color +use Gr module VDecoSet :> sig val empty : deco-set diff --git a/lib-satysfi/dist/packages/Tabular/satysfi.yaml b/lib-satysfi/dist/packages/Tabular/satysfi.yaml new file mode 100644 index 000000000..b5a76adcb --- /dev/null +++ b/lib-satysfi/dist/packages/Tabular/satysfi.yaml @@ -0,0 +1,6 @@ +language: "v0.1.0" +main_module: "Tabular" +source_directories: + - "./src" +dependencies: + - "Stdlib" diff --git a/lib-satysfi/dist/packages/tabular.satyh b/lib-satysfi/dist/packages/Tabular/src/tabular.satyh similarity index 98% rename from lib-satysfi/dist/packages/tabular.satyh rename to lib-satysfi/dist/packages/Tabular/src/tabular.satyh index a22e83e33..ddc276554 100644 --- a/lib-satysfi/dist/packages/tabular.satyh +++ b/lib-satysfi/dist/packages/Tabular/src/tabular.satyh @@ -1,5 +1,3 @@ -@require: list - module Tabular :> sig val \tabular : inline [ diff --git a/src/frontend/packageChecker.ml b/src/frontend/packageChecker.ml index fc551b83d..f899501bd 100644 --- a/src/frontend/packageChecker.ml +++ b/src/frontend/packageChecker.ml @@ -41,7 +41,7 @@ let add_dependency_to_type_environment ~(package_only : bool) (header : header_e begin match (kind, genv |> GlobalTypeenv.find_opt modnm) with | (LocalDependency, None) -> - assert false + failwith (Printf.sprintf "TODO: add_dependency_to_type_environment %s" modnm) | (PackageDependency, None) -> err @@ UnknownPackageDependency(rng, modnm) @@ -122,10 +122,12 @@ let main (tyenv_prim : Typeenv.t) (genv : global_type_environment) (package : pa let main_document (tyenv_prim : Typeenv.t) (genv : global_type_environment) (sorted_locals : (abs_path * untyped_library_file) list) (utdoc : abs_path * untyped_document_file) : ((abs_path * binding list) list * abstract_tree) ok = let open ResultMonad in - let* (_, libacc) = + Format.printf "****LOCALS: %s\n" (sorted_locals |> List.map (fun (_, (_, ((_, modnm), _, _))) -> modnm) |> String.concat ", "); (* TODO: remove this *) + let* (genv, libacc) = sorted_locals |> foldM (fun (genv, libacc) (abspath, utlib) -> let (header, (modident, utsig_opt, utbinds)) = utlib in let (_, modnm) = modident in + Format.printf "****ADD: %s %a\n" modnm (Format.pp_print_list pp_header_element) header; (* TODO: remove this *) let* ((_quant, ssig), binds) = let* tyenv = tyenv_prim |> add_dependency_to_type_environment ~package_only:false header genv in typecheck_library_file ~for_struct:tyenv ~for_sig:tyenv abspath utsig_opt utbinds @@ -139,6 +141,7 @@ let main_document (tyenv_prim : Typeenv.t) (genv : global_type_environment) (sor (* Typecheck the document: *) let* ast_doc = let (abspath, (header, utast)) = utdoc in + Format.printf "****ADD TO DOC: %a\n" (Format.pp_print_list pp_header_element) header; (* TODO: remove this *) let* tyenv = tyenv_prim |> add_dependency_to_type_environment ~package_only:false header genv in typecheck_document_file tyenv abspath utast in From f09ba19a342738a762921c81742c96fd1d270581 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 25 Oct 2022 01:12:12 +0900 Subject: [PATCH 023/288] fix how to install packages --- install-libs.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/install-libs.sh b/install-libs.sh index 9c7dd1170..c770ff390 100755 --- a/install-libs.sh +++ b/install-libs.sh @@ -13,6 +13,6 @@ install -m 644 lib-satysfi/dist/hash/* ${LIBDIR}/dist/hash install -d ${LIBDIR}/dist/hyph install -m 644 lib-satysfi/dist/hyph/* ${LIBDIR}/dist/hyph install -d ${LIBDIR}/dist/packages -install -m 644 lib-satysfi/dist/packages/* ${LIBDIR}/dist/packages +find lib-satysfi/dist/packages/ -type f -exec install -m 644 "{}" ${LIBDIR}/dist/packages \; install -d ${LIBDIR}/dist/md install -m 644 lib-satysfi/dist/md/* ${LIBDIR}/dist/md From 1ef280634b81daed5bf7eea7d6f0995ef3612ddc Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 25 Oct 2022 01:38:26 +0900 Subject: [PATCH 024/288] fix how to install packages (2) --- install-libs.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/install-libs.sh b/install-libs.sh index c770ff390..597b9adf2 100755 --- a/install-libs.sh +++ b/install-libs.sh @@ -13,6 +13,6 @@ install -m 644 lib-satysfi/dist/hash/* ${LIBDIR}/dist/hash install -d ${LIBDIR}/dist/hyph install -m 644 lib-satysfi/dist/hyph/* ${LIBDIR}/dist/hyph install -d ${LIBDIR}/dist/packages -find lib-satysfi/dist/packages/ -type f -exec install -m 644 "{}" ${LIBDIR}/dist/packages \; +(cd lib-satysfi && find dist/packages -type f -exec install -Dm 644 "{}" "${LIBDIR}/{}" \;) install -d ${LIBDIR}/dist/md install -m 644 lib-satysfi/dist/md/* ${LIBDIR}/dist/md From 979a9b09c7c6730f084e9bec92ff212c6392b79b Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 25 Oct 2022 01:53:31 +0900 Subject: [PATCH 025/288] make 'doc-primitives.saty' compile --- doc/doc-primitives.saty | 13 +++++++------ doc/local-math.satyh | 2 +- doc/local.satyh | 19 ++++++++++++------- doc/paren.satyh | 8 ++++++-- 4 files changed, 26 insertions(+), 16 deletions(-) diff --git a/doc/doc-primitives.saty b/doc/doc-primitives.saty index ab4bde2f1..c321c572f 100644 --- a/doc/doc-primitives.saty +++ b/doc/doc-primitives.saty @@ -1,10 +1,11 @@ -% -*- coding: utf-8 -*- -@require: pervasives -@require: itemize -@require: stdjabook -@import: local -@import: local-math +use package Stdlib +use package Math +use package Itemize +use package StdJaBook +use Local of `local` +use LocalMath of `local-math` +let open Stdlib in let open Pervasives in let open Itemize in let open Math in diff --git a/doc/local-math.satyh b/doc/local-math.satyh index 12c24625c..c89d29dc4 100644 --- a/doc/local-math.satyh +++ b/doc/local-math.satyh @@ -1,4 +1,4 @@ -@require: math +use package Math module LocalMath = struct diff --git a/doc/local.satyh b/doc/local.satyh index f8bb30297..8a7478c77 100644 --- a/doc/local.satyh +++ b/doc/local.satyh @@ -1,13 +1,18 @@ -@require: pervasives -@require: math -@require: stdjabook -@require: vdecoset -@require: hdecoset - -@import: paren +use package Stdlib +use package Math +use package StdJaBook +use LocalParen of `paren` module Local = struct + %- TODO: remove this by using 'open' + module List = Stdlib.List + module Pervasives = Stdlib.Pervasives + module Color = Stdlib.Color + module VDecoSet = Stdlib.VDecoSet + module HDecoSet = Stdlib.HDecoSet + + type type-syntax = | TypeName of inline-text | TypeConstructor of inline-text * list type-syntax diff --git a/doc/paren.satyh b/doc/paren.satyh index 5ba69ca78..4ae07a9d2 100644 --- a/doc/paren.satyh +++ b/doc/paren.satyh @@ -1,8 +1,12 @@ -@require: math -@require: gr +use package Stdlib +use package Math module LocalParen = struct + %- TODO: remove this by using 'open' + module Gr = Stdlib.Gr + + val record-paren-left hgt dpt ctx = let fontsize = get-font-size ctx in let hgtaxis = fontsize *' get-math-axis-height-ratio ctx in From 4feef392d4b24d9dec00b36bba2b4fce7a47d471 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 25 Oct 2022 02:05:40 +0900 Subject: [PATCH 026/288] make 'doc-lang.saty' compile --- doc/doc-lang.saty | 8 +++-- lib-satysfi/dist/packages/StdJa/satysfi.yaml | 9 ++++++ .../dist/packages/{ => StdJa/src}/stdja.satyh | 30 ++++++++++--------- 3 files changed, 30 insertions(+), 17 deletions(-) create mode 100644 lib-satysfi/dist/packages/StdJa/satysfi.yaml rename lib-satysfi/dist/packages/{ => StdJa/src}/stdja.satyh (97%) diff --git a/doc/doc-lang.saty b/doc/doc-lang.saty index a9e364fbb..7cc71fae0 100644 --- a/doc/doc-lang.saty +++ b/doc/doc-lang.saty @@ -1,7 +1,9 @@ -% -*- coding: utf-8 -*- -@require: stdja -@import: local-math +use package Stdlib +use package Math +use package StdJa +use LocalMath of `local-math` +let open Stdlib in let open Pervasives in let open StdJa in let open LocalMath in diff --git a/lib-satysfi/dist/packages/StdJa/satysfi.yaml b/lib-satysfi/dist/packages/StdJa/satysfi.yaml new file mode 100644 index 000000000..73582dfdb --- /dev/null +++ b/lib-satysfi/dist/packages/StdJa/satysfi.yaml @@ -0,0 +1,9 @@ +language: "v0.1.0" +main_module: "StdJa" +source_directories: + - "./src" +dependencies: + - "Stdlib" + - "Math" + - "Code" + - "Annot" diff --git a/lib-satysfi/dist/packages/stdja.satyh b/lib-satysfi/dist/packages/StdJa/src/stdja.satyh similarity index 97% rename from lib-satysfi/dist/packages/stdja.satyh rename to lib-satysfi/dist/packages/StdJa/src/stdja.satyh index dc869826a..3075a3dcb 100644 --- a/lib-satysfi/dist/packages/stdja.satyh +++ b/lib-satysfi/dist/packages/StdJa/src/stdja.satyh @@ -1,14 +1,7 @@ -% -*- coding: utf-8 -*- -@require: pervasives -@require: gr -@require: list -@require: math -@require: code -@require: color -@require: option -@require: paper-size -@require: annot - +use package Stdlib +use package Math +use package Code +use package Annot module StdJa :> sig @@ -20,9 +13,9 @@ module StdJa :> sig paper-size : length * length, text-width : length, text-height : length, - text-origin : Pervasives.point, - header-origin : Pervasives.point, - footer-origin : Pervasives.point, + text-origin : Stdlib.Pervasives.point, + header-origin : Stdlib.Pervasives.point, + footer-origin : Stdlib.Pervasives.point, header-width : length, footer-width : length, ) (| @@ -49,6 +42,15 @@ module StdJa :> sig end = struct + %- TODO: remove this by using 'open' + module Option = Stdlib.Option + module List = Stdlib.List + module Pervasives = Stdlib.Pervasives + module Color = Stdlib.Color + module Gr = Stdlib.Gr + module PaperSize = Stdlib.PaperSize + + type toc-element = | TOCElementSection of string * inline-text | TOCElementSubsection of string * inline-text From 28f83a19affd5c0b3a81450989c647612908e2da Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 25 Oct 2022 02:20:11 +0900 Subject: [PATCH 027/288] make 'tests/*.saty' compile --- .../dist/packages/StdJaReport/satysfi.yaml | 10 ++++++ .../{ => StdJaReport/src}/stdjareport.satyh | 31 ++++++++++--------- tests/clip.saty | 6 ++-- tests/glue1.saty | 2 +- tests/head.satyh | 13 +++++--- tests/images/test.saty | 6 ++-- tests/macro1.saty | 4 +-- tests/math-typefaces.saty | 7 +++-- tests/math2.saty | 5 ++- tests/staged1.saty | 4 +-- tests/text_mode/test.saty | 2 +- 11 files changed, 55 insertions(+), 35 deletions(-) create mode 100644 lib-satysfi/dist/packages/StdJaReport/satysfi.yaml rename lib-satysfi/dist/packages/{ => StdJaReport/src}/stdjareport.satyh (97%) diff --git a/lib-satysfi/dist/packages/StdJaReport/satysfi.yaml b/lib-satysfi/dist/packages/StdJaReport/satysfi.yaml new file mode 100644 index 000000000..5d0b19e7c --- /dev/null +++ b/lib-satysfi/dist/packages/StdJaReport/satysfi.yaml @@ -0,0 +1,10 @@ +language: "v0.1.0" +main_module: "StdJaReport" +source_directories: + - "./src" +dependencies: + - "Stdlib" + - "Math" + - "Code" + - "Annot" + - "FootnoteScheme" \ No newline at end of file diff --git a/lib-satysfi/dist/packages/stdjareport.satyh b/lib-satysfi/dist/packages/StdJaReport/src/stdjareport.satyh similarity index 97% rename from lib-satysfi/dist/packages/stdjareport.satyh rename to lib-satysfi/dist/packages/StdJaReport/src/stdjareport.satyh index 681d8d7b2..0283ca0a9 100644 --- a/lib-satysfi/dist/packages/stdjareport.satyh +++ b/lib-satysfi/dist/packages/StdJaReport/src/stdjareport.satyh @@ -1,14 +1,8 @@ -% -*- coding: utf-8 -*- -@require: pervasives -@require: gr -@require: list -@require: math -@require: code -@require: color -@require: option -@require: annot -@require: paper-size -@require: footnote-scheme +use package Stdlib +use package Math +use package Code +use package Annot +use package FootnoteScheme module StdJaReport :> sig @@ -17,9 +11,9 @@ module StdJaReport :> sig show-page-number : bool, text-width : length, text-height : length, - text-origin : Pervasives.point, - header-origin : Pervasives.point, - footer-origin : Pervasives.point, + text-origin : Stdlib.Pervasives.point, + header-origin : Stdlib.Pervasives.point, + footer-origin : Stdlib.Pervasives.point, header-width : length, footer-width : length, ) (| @@ -55,6 +49,15 @@ module StdJaReport :> sig end = struct + %- TODO: remove this by using 'open' + module Pervasives = Stdlib.Pervasives + module Gr = Stdlib.Gr + module List = Stdlib.List + module Color = Stdlib.Color + module Option = Stdlib.Option + module PaperSize = Stdlib.PaperSize + + % type toc-element = % | TOCElementChapter of string * inline-text % | TOCElementSection of string * inline-text diff --git a/tests/clip.saty b/tests/clip.saty index e6bca67a3..edda9de02 100644 --- a/tests/clip.saty +++ b/tests/clip.saty @@ -1,7 +1,7 @@ -% -*- coding: utf-8 -*- -@import: head -@import: ../lib-satysfi/dist/packages/color +use package Stdlib +use Head of `head` +let open Stdlib in let open Pervasives in let open Head in diff --git a/tests/glue1.saty b/tests/glue1.saty index 6c4bede5d..c20b1edb4 100644 --- a/tests/glue1.saty +++ b/tests/glue1.saty @@ -1,4 +1,4 @@ -@import: head +use Head of `head` let open Head in let inline ctx \glueneg = inline-glue 0pt 0pt (0pt -' 100pt) in diff --git a/tests/head.satyh b/tests/head.satyh index 186354e2b..02c5b4372 100644 --- a/tests/head.satyh +++ b/tests/head.satyh @@ -1,10 +1,15 @@ -@require: list -@require: math -@require: proof -@require: paper-size +use package Stdlib +use package Math +use package Proof module Head = struct + %- TODO: remove this by using 'open' + module List = Stdlib.List + module Pervasives = Stdlib.Pervasives + module PaperSize = Stdlib.PaperSize + + val form-paragraph = line-break true true val gray x = Gray(x) diff --git a/tests/images/test.saty b/tests/images/test.saty index bf2417d9a..c76c3f6c8 100644 --- a/tests/images/test.saty +++ b/tests/images/test.saty @@ -1,6 +1,6 @@ -@require: stdja -@require: itemize -@require: annot +use package StdJa +use package Itemize +use package Annot let inline ctx \insert-image w path = let img = load-image path in diff --git a/tests/macro1.saty b/tests/macro1.saty index 95595de99..d88298c17 100644 --- a/tests/macro1.saty +++ b/tests/macro1.saty @@ -1,5 +1,5 @@ -@require: stdjareport -@import: macro1-local +use package StdJaReport +use Macro1Local of `macro1-local` let open StdJaReport in document (| diff --git a/tests/math-typefaces.saty b/tests/math-typefaces.saty index 617bb29ba..208359896 100644 --- a/tests/math-typefaces.saty +++ b/tests/math-typefaces.saty @@ -1,6 +1,9 @@ -@require: stdjareport -@require: itemize +use package Stdlib +use package Math +use package Itemize +use package StdJaReport +let open Stdlib in let open Pervasives in let open Math in let open Itemize in diff --git a/tests/math2.saty b/tests/math2.saty index a55a8bccb..0eedd1562 100644 --- a/tests/math2.saty +++ b/tests/math2.saty @@ -1,6 +1,5 @@ -% -*- coding: utf-8 -*- -@import: head -@require: math +use package Math +use Head of `head` let open Math in let open Head in diff --git a/tests/staged1.saty b/tests/staged1.saty index 6fb838795..31a7ac382 100644 --- a/tests/staged1.saty +++ b/tests/staged1.saty @@ -1,5 +1,5 @@ -@require: stdja -@import: staged1-local +use package StdJa +use Staged1Local of `staged1-local` let open StdJa in let inline \show-int n = diff --git a/tests/text_mode/test.saty b/tests/text_mode/test.saty index 9d50a62ec..00e571a70 100644 --- a/tests/text_mode/test.saty +++ b/tests/text_mode/test.saty @@ -1,4 +1,4 @@ -@import: head +use Head of `head` let open Head in document '< From a925135e4ca2976e6f19144d9e248fdafb861b5b Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 25 Oct 2022 02:23:28 +0900 Subject: [PATCH 028/288] slight changes --- lib-satysfi/dist/packages/StdJa/src/stdja.satyh | 2 +- lib-satysfi/dist/packages/StdJaBook/src/stdjabook.satyh | 2 +- lib-satysfi/dist/packages/StdJaReport/satysfi.yaml | 2 +- lib-satysfi/dist/packages/StdJaReport/src/stdjareport.satyh | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/lib-satysfi/dist/packages/StdJa/src/stdja.satyh b/lib-satysfi/dist/packages/StdJa/src/stdja.satyh index 3075a3dcb..ce70e7d7f 100644 --- a/lib-satysfi/dist/packages/StdJa/src/stdja.satyh +++ b/lib-satysfi/dist/packages/StdJa/src/stdja.satyh @@ -13,7 +13,7 @@ module StdJa :> sig paper-size : length * length, text-width : length, text-height : length, - text-origin : Stdlib.Pervasives.point, + text-origin : Stdlib.Pervasives.point, %- TODO: remove this by using 'open' header-origin : Stdlib.Pervasives.point, footer-origin : Stdlib.Pervasives.point, header-width : length, diff --git a/lib-satysfi/dist/packages/StdJaBook/src/stdjabook.satyh b/lib-satysfi/dist/packages/StdJaBook/src/stdjabook.satyh index 6fc735353..e21e20956 100644 --- a/lib-satysfi/dist/packages/StdJaBook/src/stdjabook.satyh +++ b/lib-satysfi/dist/packages/StdJaBook/src/stdjabook.satyh @@ -15,7 +15,7 @@ module StdJaBook :> sig paper-size : length * length, text-width : length, text-height : length, - text-origin : Stdlib.Pervasives.point, + text-origin : Stdlib.Pervasives.point, %- TODO: remove this by using 'open' header-origin : Stdlib.Pervasives.point, footer-origin : Stdlib.Pervasives.point, header-width : length, diff --git a/lib-satysfi/dist/packages/StdJaReport/satysfi.yaml b/lib-satysfi/dist/packages/StdJaReport/satysfi.yaml index 5d0b19e7c..4d5231e8f 100644 --- a/lib-satysfi/dist/packages/StdJaReport/satysfi.yaml +++ b/lib-satysfi/dist/packages/StdJaReport/satysfi.yaml @@ -7,4 +7,4 @@ dependencies: - "Math" - "Code" - "Annot" - - "FootnoteScheme" \ No newline at end of file + - "FootnoteScheme" diff --git a/lib-satysfi/dist/packages/StdJaReport/src/stdjareport.satyh b/lib-satysfi/dist/packages/StdJaReport/src/stdjareport.satyh index 0283ca0a9..5e998f742 100644 --- a/lib-satysfi/dist/packages/StdJaReport/src/stdjareport.satyh +++ b/lib-satysfi/dist/packages/StdJaReport/src/stdjareport.satyh @@ -11,7 +11,7 @@ module StdJaReport :> sig show-page-number : bool, text-width : length, text-height : length, - text-origin : Stdlib.Pervasives.point, + text-origin : Stdlib.Pervasives.point, %- TODO: remove this by using 'open' header-origin : Stdlib.Pervasives.point, footer-origin : Stdlib.Pervasives.point, header-width : length, From 14a23d0f0fb49381b192a20f58cab7f72cad1ee1 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 25 Oct 2022 02:46:00 +0900 Subject: [PATCH 029/288] make 'math1.saty' compile --- doc/math1.saty | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/doc/math1.saty b/doc/math1.saty index cefcea0c1..149bd21c0 100644 --- a/doc/math1.saty +++ b/doc/math1.saty @@ -1,9 +1,10 @@ -% -*- coding: utf-8 -*- -@require: stdja -@require: proof -@require: tabular -@require: gr +use package Stdlib +use package Math +use package Proof +use package Tabular +use package StdJa +let open Stdlib in let open Pervasives in let open Math in let open Proof in From 3e0c34c50a128f171b17ee9ebb906bc0be6cb38e Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 25 Oct 2022 03:40:58 +0900 Subject: [PATCH 030/288] fix CI about 'install -D' in macOS --- .github/workflows/ci.yml | 14 ++++++++++++-- install-libs.sh | 29 +++++++++++++++-------------- 2 files changed, 27 insertions(+), 16 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 339b84dbe..2671cf1e4 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -32,13 +32,19 @@ jobs: # See https://docs.github.com/en/actions/reference/context-and-expression-syntax-for-github-actions#runner-context # and https://github.com/ocaml/setup-ocaml/blob/4ac56b0fd440c3eef30fd1e34c96e0c740a807da/src/constants.ts#L45 run: | - if [ "${{ runner.os }}" = "Windows" ] ; then + if [ "${{ runner.os }}" = "Windows" ]; then DEFAULT_OPAM_REPO="https://github.com/fdopen/opam-repository-mingw.git#opam2" else DEFAULT_OPAM_REPO="https://github.com/ocaml/opam-repository.git" fi echo "::set-output name=opam-repo-default::$(echo "$DEFAULT_OPAM_REPO")" + - name: Install tools + run: | + if [ "${{ matrix.os }}" == 'macos-latest' ]; then + brew install coreutils + fi + - name: Setup OCaml ${{ matrix.ocaml-version }} and pin satysfi uses: ocaml/setup-ocaml@v2 with: @@ -70,7 +76,11 @@ jobs: if [ -z "$(ls lib-satysfi/dist/fonts)" ]; then ./download-fonts.sh fi - ./install-libs.sh ~/.satysfi + if [ "${{ matrix.os }}" == 'macos-latest' ]; then + ./install-libs.sh ~/.satysfi /opt/homebrew/opt/coreutils/libexec/gnubin/install + else + ./install-libs.sh ~/.satysfi install + fi - name: Build demo docs run: | diff --git a/install-libs.sh b/install-libs.sh index 597b9adf2..25e19cbf8 100755 --- a/install-libs.sh +++ b/install-libs.sh @@ -1,18 +1,19 @@ #!/bin/sh LIBDIR=${1:-/usr/local/share/satysfi} +INSTALL=${2:-install} -install -d ${LIBDIR} -install -d ${LIBDIR}/dist -install -d ${LIBDIR}/dist/unidata -install -m 644 lib-satysfi/dist/unidata/*.txt ${LIBDIR}/dist/unidata -install -d ${LIBDIR}/dist/fonts -install -m 644 lib-satysfi/dist/fonts/* ${LIBDIR}/dist/fonts -install -d ${LIBDIR}/dist/hash -install -m 644 lib-satysfi/dist/hash/* ${LIBDIR}/dist/hash -install -d ${LIBDIR}/dist/hyph -install -m 644 lib-satysfi/dist/hyph/* ${LIBDIR}/dist/hyph -install -d ${LIBDIR}/dist/packages -(cd lib-satysfi && find dist/packages -type f -exec install -Dm 644 "{}" "${LIBDIR}/{}" \;) -install -d ${LIBDIR}/dist/md -install -m 644 lib-satysfi/dist/md/* ${LIBDIR}/dist/md +"${INSTALL}" -d "${LIBDIR}" +"${INSTALL}" -d "${LIBDIR}/dist" +"${INSTALL}" -d "${LIBDIR}/dist/unidata" +"${INSTALL}" -m 644 lib-satysfi/dist/unidata/*.txt "${LIBDIR}/dist/unidata" +"${INSTALL}" -d "${LIBDIR}/dist/fonts" +"${INSTALL}" -m 644 lib-satysfi/dist/fonts/* "${LIBDIR}/dist/fonts" +"${INSTALL}" -d "${LIBDIR}/dist/hash" +"${INSTALL}" -m 644 lib-satysfi/dist/hash/* "${LIBDIR}/dist/hash" +"${INSTALL}" -d "${LIBDIR}/dist/hyph" +"${INSTALL}" -m 644 lib-satysfi/dist/hyph/* "${LIBDIR}/dist/hyph" +"${INSTALL}" -d "${LIBDIR}/dist/packages" +(cd lib-satysfi && find dist/packages -type f -exec "${INSTALL}" -Dm 644 "{}" "${LIBDIR}/{}" \;) +"${INSTALL}" -d "${LIBDIR}/dist/md" +"${INSTALL}" -m 644 lib-satysfi/dist/md/* "${LIBDIR}/dist/md" From 99114eaac4d8e2e17f67e45d9a1b434732a6d40e Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 25 Oct 2022 03:49:42 +0900 Subject: [PATCH 031/288] fix CI about 'install -D' in macOS (2) --- .github/workflows/ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 2671cf1e4..eaa510a50 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -77,7 +77,7 @@ jobs: ./download-fonts.sh fi if [ "${{ matrix.os }}" == 'macos-latest' ]; then - ./install-libs.sh ~/.satysfi /opt/homebrew/opt/coreutils/libexec/gnubin/install + ./install-libs.sh ~/.satysfi ginstall else ./install-libs.sh ~/.satysfi install fi From 044b02fc8525454aed08365a52c618434b5e1b84 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 25 Oct 2022 23:22:10 +0900 Subject: [PATCH 032/288] re-support Markdown inputs --- lib-satysfi/dist/md/mdja.satysfi-md | 50 ++-- lib-satysfi/dist/packages/MDJa/satysfi.yaml | 11 + .../dist/packages/{ => MDJa/src}/mdja.satyh | 274 +++++++++--------- src/frontend/closedFileDependencyResolver.ml | 5 +- src/frontend/main.ml | 35 ++- src/frontend/openFileDependencyResolver.ml | 93 +++--- src/frontend/openFileDependencyResolver.mli | 3 +- src/frontend/openPackageDependencyResolver.ml | 3 - src/frontend/packageChecker.ml | 5 +- tests/Makefile | 2 + tests/md/Makefile | 16 + tests/md/test.md | 108 +++++++ 12 files changed, 371 insertions(+), 234 deletions(-) create mode 100644 lib-satysfi/dist/packages/MDJa/satysfi.yaml rename lib-satysfi/dist/packages/{ => MDJa/src}/mdja.satyh (60%) create mode 100644 tests/md/Makefile create mode 100644 tests/md/test.md diff --git a/lib-satysfi/dist/md/mdja.satysfi-md b/lib-satysfi/dist/md/mdja.satysfi-md index 1fccf5ad0..e8264fe20 100644 --- a/lib-satysfi/dist/md/mdja.satysfi-md +++ b/lib-satysfi/dist/md/mdja.satysfi-md @@ -1,35 +1,35 @@ { - "depends": ["mdja"], + "depends": ["MDJa"], "document": "MDJa.document", "header-default": "(| title = {}; author = {}; |)", - "paragraph": "+p", - "hr": "+hr", - "h1": "+h1", - "h2": "+h2", - "h3": "+h3", - "h4": "+h4", - "h5": "+h5", - "h6": "+h6", - "ul-inline": "+ul", - "ul-block": "+ul-block", - "ol-inline": "+ol", - "ol-block": "+ol-block", + "paragraph": "+MDJa.p", + "hr": "+MDJa.hr", + "h1": "+MDJa.h1", + "h2": "+MDJa.h2", + "h3": "+MDJa.h3", + "h4": "+MDJa.h4", + "h5": "+MDJa.h5", + "h6": "+MDJa.h6", + "ul-inline": "+MDJa.ul", + "ul-block": "+MDJa.ul-block", + "ol-inline": "+MDJa.ol", + "ol-block": "+MDJa.ol-block", "code-block": [ - ("console", "+console") + ("console", "+MDJa.console") ], - "code-block-default": "+code", - "blockquote": "+quote", - "err-block": "+error", + "code-block-default": "+MDJa.code", + "blockquote": "+MDJa.quote", + "err-block": "+MDJa.error", - "emph": "\\emph", - "bold": "\\bold", + "emph": "\\MDJa.emph", + "bold": "\\MDJa.bold", "hard-break": , "code": [ ], - "code-default": "\\code", - "url": "\\link", - "reference": "\\reference", - "img": "\\img", - "embed-block": "\\embed-block", - "err-inline": "\\error" + "code-default": "\\MDJa.code", + "url": "\\MDJa.link", + "reference": "\\MDJa.reference", + "img": "\\MDJa.img", + "embed-block": "\\MDJa.embed-block", + "err-inline": "\\MDJa.error" } diff --git a/lib-satysfi/dist/packages/MDJa/satysfi.yaml b/lib-satysfi/dist/packages/MDJa/satysfi.yaml new file mode 100644 index 000000000..f6f90312e --- /dev/null +++ b/lib-satysfi/dist/packages/MDJa/satysfi.yaml @@ -0,0 +1,11 @@ +language: "v0.1.0" +main_module: "MDJa" +source_directories: + - "./src" +dependencies: + - "Stdlib" + - "Math" + - "Code" + - "Itemize" + - "Annot" + - "FootnoteScheme" diff --git a/lib-satysfi/dist/packages/mdja.satyh b/lib-satysfi/dist/packages/MDJa/src/mdja.satyh similarity index 60% rename from lib-satysfi/dist/packages/mdja.satyh rename to lib-satysfi/dist/packages/MDJa/src/mdja.satyh index c1bbc148d..25a2acd5f 100644 --- a/lib-satysfi/dist/packages/mdja.satyh +++ b/lib-satysfi/dist/packages/MDJa/src/mdja.satyh @@ -1,99 +1,103 @@ -@require: pervasives -@require: code -@require: math -@require: itemize -@require: color -@require: hdecoset -@require: vdecoset -@require: annot - - -module MDJa : sig - val document : 'a -> block-text -> document - constraint 'a :: (| - title : inline-text; - author : inline-text; - |) - - direct +h1 : [inline-text; block-text] block-cmd - direct +h2 : [inline-text; block-text] block-cmd - direct +h3 : [inline-text; block-text] block-cmd - direct +h4 : [inline-text; block-text] block-cmd - direct +p : [inline-text] block-cmd - direct +ul : [inline-text list] block-cmd - direct +ul-block : [block-text list] block-cmd - direct +ol : [inline-text list] block-cmd - direct +code : [string] block-cmd - direct +console : [string] block-cmd - direct +quote : [block-text] block-cmd - direct +hr : [] block-cmd - direct +error : [string] block-cmd - - direct \code : [string] inline-cmd - direct \emph : [inline-text] inline-cmd - direct \bold : [inline-text] inline-cmd - direct \link : [string; inline-text] inline-cmd - direct \reference : [string; string; (string * string) option] inline-cmd - direct \img : [string; string; string] inline-cmd - direct \hard-break : [] inline-cmd - direct \embed-block : [block-text] inline-cmd - direct \error : [string] inline-cmd +use package Stdlib +use package Math +use package Code +use package Itemize +use package Annot + +module MDJa :> sig + val document : (| + title : inline-text, + author : inline-text, + |) -> block-text -> document + + val +h1 : block [inline-text, block-text] + val +h2 : block [inline-text, block-text] + val +h3 : block [inline-text, block-text] + val +h4 : block [inline-text, block-text] + val +p : block [inline-text] + val +ul : block [list inline-text] + val +ul-block : block [list block-text] + val +ol : block [list inline-text] + val +code : block [string] + val +console : block [string] + val +quote : block [block-text] + val +hr : block [] + val +error : block [string] + + val \code : inline [string] + val \emph : inline [inline-text] + val \bold : inline [inline-text] + val \link : inline [string, inline-text] + val \reference : inline [string, string, option (string * string)] + val \img : inline [string, string, string] + val \hard-break : inline [] + val \embed-block : inline [block-text] + val \error : inline [string] end = struct + %- TODO: remove this by using 'open' + module List = Stdlib.List + module Pervasives = Stdlib.Pervasives + module Color = Stdlib.Color + module Gr = Stdlib.Gr + module PaperSize = Stdlib.PaperSize + module HDecoSet = Stdlib.HDecoSet + module VDecoSet = Stdlib.VDecoSet - let paper = A4Paper - let text-origin = (80pt, 100pt) - let text-width = 440pt - let text-height = 630pt - let footer-origin = (40pt, 780pt) - let skip-before-content = 20pt + val paper = PaperSize.a4 + val text-origin = (80pt, 100pt) + val text-width = 440pt + val text-height = 630pt + val footer-origin = (40pt, 780pt) - let font-size-main = 12pt - let font-size-title = 20pt - let font-size-h1 = 18pt - let font-size-h2 = 16pt - let font-size-h3 = 14pt - let font-size-h4 = 12.5pt + val skip-before-content = 20pt - let font-ratio-cjk = 0.88 + val font-size-main = 12pt + val font-size-title = 20pt + val font-size-h1 = 18pt + val font-size-h2 = 16pt + val font-size-h3 = 14pt + val font-size-h4 = 12.5pt - let font-latin-roman = (`Junicode` , 1., 0.) - let font-latin-italic = (`Junicode-it`, 1., 0.) - let font-latin-sans = (`lmsans` , 1., 0.) - let font-latin-mono = (`lmmono` , 1., 0.) + val font-ratio-cjk = 0.88 - let font-cjk-gothic = (`ipaexg`, font-ratio-cjk, 0.) - let font-cjk-mincho = (`ipaexm`, font-ratio-cjk, 0.) + val font-latin-roman = (`Junicode` , 1., 0.) + val font-latin-italic = (`Junicode-it`, 1., 0.) + val font-latin-sans = (`lmsans` , 1., 0.) + val font-latin-mono = (`lmmono` , 1., 0.) - let hr-margin = 5mm - let hr-thickness = 1pt + val font-cjk-gothic = (`ipaexg`, font-ratio-cjk, 0.) + val font-cjk-mincho = (`ipaexm`, font-ratio-cjk, 0.) - let code-background = Gray(0.875) + val hr-margin = 5mm + val hr-thickness = 1pt - let text-color-link = RGB(0.0, 0.5, 1.0) + val code-background = Gray(0.875) + val text-color-link = RGB(0.0, 0.5, 1.0) - let-mutable h1-number <- 0 - let-mutable h2-number <- 0 - let-mutable h3-number <- 0 - let-mutable h4-number <- 0 - let-mutable h5-number <- 0 - let-mutable h6-number <- 0 - let-mutable reference-acc <- [] + val mutable h1-number <- 0 + val mutable h2-number <- 0 + val mutable h3-number <- 0 + val mutable h4-number <- 0 + val mutable h5-number <- 0 + val mutable h6-number <- 0 + val mutable reference-acc <- [] - let set-latin-font font ctx = + + val set-latin-font font ctx = ctx |> set-font Latin font - let set-cjk-font font ctx = + val set-cjk-font font ctx = ctx |> set-font Kana font |> set-font HanIdeographic font - let initial-context = - get-initial-context text-width (command \math) + val initial-context = + get-initial-context text-width (command \Math.math) |> set-dominant-narrow-script Latin |> set-dominant-wide-script Kana |> set-latin-font font-latin-roman @@ -102,45 +106,45 @@ end = struct |> set-space-ratio 0.275 0.08 0.12 - let footer pbinfo = + val footer pbinfo = let it-nombre = embed-string (arabic pbinfo#page-number) in let ctx = initial-context in line-break true true ctx (inline-fil ++ read-inline ctx {— #it-nombre; —} ++ inline-fil) - let make-title-context ctx = + val make-title-context ctx = ctx |> set-font-size font-size-title |> set-latin-font font-latin-roman |> set-cjk-font font-cjk-mincho - let pads-zero = (0pt, 0pt, 0pt, 0pt) + val pads-zero = (0pt, 0pt, 0pt, 0pt) - let-inline ctx \link url it = + val inline ctx \link url it = inline-frame-breakable pads-zero (Annot.link-to-uri-frame url None) (read-inline (ctx |> set-text-color text-color-link) it) - let-inline ctx \jump key-pdf-loc it = + val inline ctx \jump key-pdf-loc it = inline-frame-breakable pads-zero (Annot.link-to-location-frame key-pdf-loc None) (read-inline (ctx |> set-text-color text-color-link) it) - let set-heading-font size ctx = + val set-heading-font size ctx = ctx |> set-latin-font font-latin-sans |> set-cjk-font font-cjk-gothic |> set-font-size size - let h1-heading = set-heading-font font-size-h1 - let h2-heading = set-heading-font font-size-h2 - let h3-heading = set-heading-font font-size-h3 - let h4-heading = set-heading-font font-size-h4 + val h1-heading = set-heading-font font-size-h1 + val h2-heading = set-heading-font font-size-h2 + val h3-heading = set-heading-font font-size-h3 + val h4-heading = set-heading-font font-size-h4 - let document rcd bt = + val document rcd bt = let ctx = initial-context in let bb-title = let ctx = ctx |> make-title-context in @@ -174,42 +178,43 @@ end = struct line-break true false ctx (read-inline ctx {参考文献} ++ inline-fil) in bb-heading +++ bb-body + end in let pagecontf _ = (| - text-origin = text-origin; - text-height = text-height; + text-origin = text-origin, + text-height = text-height, |) in let pagepartsf pbinfo = (| - header-origin = (0pt, 0pt); - header-content = block-nil; - footer-origin = footer-origin; - footer-content = footer pbinfo; + header-origin = (0pt, 0pt), + header-content = block-nil, + footer-origin = footer-origin, + footer-content = footer pbinfo, |) in page-break paper pagecontf pagepartsf (List.fold-left (+++) block-nil [ - bb-title; bb-author; - block-skip skip-before-content; - bb-main; - bb-reference; + bb-title, bb-author, + block-skip skip-before-content, + bb-main, + bb-reference, ]) - let increment-counter counter counter-children = + val increment-counter counter counter-children = let () = counter <- !counter + 1 in counter-children |> List.iter (fun r -> (r <- 0)) - let heading-scheme ctx bb-title bt = + val heading-scheme ctx bb-title bt = let bb-content = read-block ctx bt in bb-title +++ bb-content - let-block ctx +h1 it bt = - let () = increment-counter h1-number [h2-number; h3-number; h4-number; h5-number; h6-number] in + val block ctx +h1 it bt = + let () = increment-counter h1-number [h2-number, h3-number, h4-number, h5-number, h6-number] in let bb-title = let s-num = arabic !h1-number in let it-num = embed-string s-num in @@ -220,8 +225,8 @@ end = struct heading-scheme ctx bb-title bt - let-block ctx +h2 it bt = - let () = increment-counter h2-number [h3-number; h4-number; h5-number; h6-number] in + val block ctx +h2 it bt = + let () = increment-counter h2-number [h3-number, h4-number, h5-number, h6-number] in let bb-title = let s-num = arabic !h1-number ^ `.` ^ arabic !h2-number in let it-num = embed-string s-num in @@ -232,8 +237,8 @@ end = struct heading-scheme ctx bb-title bt - let-block ctx +h3 it bt = - let () = increment-counter h3-number [h4-number; h5-number; h6-number] in + val block ctx +h3 it bt = + let () = increment-counter h3-number [h4-number, h5-number, h6-number] in let bb-title = let s-num = arabic !h1-number ^ `.` ^ arabic !h2-number ^ `.` ^ arabic !h3-number in let it-num = embed-string s-num in @@ -244,7 +249,7 @@ end = struct heading-scheme ctx bb-title bt - let-block ctx +h4 it bt = + val block ctx +h4 it bt = let bb-title = let s-num = arabic !h1-number ^ `.` ^ arabic !h2-number ^ `.` ^ arabic !h3-number ^ `.` ^ arabic !h4-number in let it-num = embed-string s-num in @@ -255,54 +260,54 @@ end = struct heading-scheme ctx bb-title bt - let get-quad-size ctx = + val get-quad-size ctx = get-font-size ctx *' font-ratio-cjk - let-block ctx +p it = + val block ctx +p it = let indent-size = 0pt in % get-quad-size ctx in line-break true true ctx (inline-skip indent-size ++ read-inline ctx it ++ inline-fil) - let-block +ul its = + val block +ul its = let items = its |> List.map (fun it -> Item(it, [])) in - '<+listing?:(true)(Item({}, items));> + '<+Itemize.listing?(break = true)(Item({}, items));> - let-inline ctx \embed-block bt = + val inline ctx \embed-ul-block bt = embed-block-breakable ctx (read-block ctx bt) ++ inline-fil - let-block ctx +ul-block bts = + val block ctx +ul-block bts = let items = bts |> List.map (fun bt -> ( - Item({\embed-block(bt);}, []) + Item({\embed-ul-block(bt);}, []) )) in - read-block ctx '<+listing?:(true)(Item({}, items));> + read-block ctx '<+Itemize.listing?(break = true)(Item({}, items));> - let-block +ol its = + val block +ol its = let items = its |> List.map (fun it -> Item(it, [])) in - '<+enumerate(Item({}, items));> + '<+Itemize.enumerate(Item({}, items));> - let fix-block-code s = + val fix-block-code s = string-unexplode [0x0A] ^ s % dirty trick; should fix '+Code.code' and the parser of SATySFi - let-block ctx +code s = + val block ctx +code s = let ctx = set-font-size (get-font-size ctx *' 0.875) ctx in read-block ctx '<+Code.code(fix-block-code s);> - let-block +console s = + val block +console s = '<+Code.console(fix-block-code s);> - let-block ctx +quote it = + val block ctx +quote it = let qsize = get-quad-size ctx in let pads = (qsize, 0pt, 0pt, 0pt) in let decoset = VDecoSet.quote-round 6pt 4pt (Gray(0.75)) in @@ -310,23 +315,23 @@ end = struct (fun ctx -> read-block ctx it) - let-block ctx +hr = + val block ctx +hr = let w = get-text-width ctx in let h = hr-margin +' hr-thickness *' 0.5 in let color = (Gray(0.75)) in line-break true true ctx (inline-graphics w h h (fun (x, y) -> - [ stroke hr-thickness color (Gr.line (x, y) (x +' w, y)); ] + stroke hr-thickness color (Gr.line (x, y) (x +' w, y)) )) - let-block ctx +error s = + val block ctx +error s = let ctx = ctx |> set-text-color Color.red in let it = embed-string s in line-break true true ctx (read-inline ctx {ERROR (B): \"#it;\"} ++ inline-fil) - let-inline ctx \emph it = + val inline ctx \emph it = let ctx = ctx |> set-cjk-font font-cjk-gothic |> set-latin-font font-latin-sans @@ -334,15 +339,15 @@ end = struct read-inline ctx it - let-inline \bold it = + val inline \bold it = {\emph(it);} - let strut h d = - inline-graphics 0pt h d (fun _ -> []) + val strut h d = + inline-graphics 0pt h d (fun _ -> unite-graphics []) - let-inline ctx \code s = + val inline ctx \code s = let ib-strut = strut 8pt 3pt in let ib = let ctx = @@ -358,7 +363,7 @@ end = struct script-guard Latin (inline-frame-breakable pads decoset ib) - let-inline ctx \url s = + val inline ctx \url s = let ctx = ctx |> set-latin-font font-latin-mono |> set-cjk-font font-cjk-gothic @@ -366,7 +371,7 @@ end = struct read-inline ctx (embed-string s) - let-inline ctx \reference tag display opt = + val inline ctx \reference tag display opt = let it = embed-string display in match opt with | None -> @@ -382,19 +387,18 @@ end = struct let key-pdf-loc = `reference:` ^ tag in let it-tag = embed-string tag in read-inline ctx {\jump(key-pdf-loc){#it; [#it-tag;]}} + end - let-inline ctx \img alt src title = + val inline ctx \img alt src title = use-image-by-width (load-image src) 5cm - let-inline ctx \hard-break = - mandatory-break ctx - + val inline ctx \hard-break = + Pervasives.mandatory-break ctx - let-inline ctx \embed-block bt = + val inline ctx \embed-block bt = inline-fil ++ embed-block-breakable ctx (read-block ctx bt) ++ omit-skip-after - - let-inline ctx \error s = + val inline ctx \error s = let ctx = ctx |> set-text-color Color.red in let it = embed-string s in read-inline ctx {ERROR (I): \"#it;\"} diff --git a/src/frontend/closedFileDependencyResolver.ml b/src/frontend/closedFileDependencyResolver.ml index 96d6696fb..df7a62bbc 100644 --- a/src/frontend/closedFileDependencyResolver.ml +++ b/src/frontend/closedFileDependencyResolver.ml @@ -22,14 +22,14 @@ let main (utlibs : (abs_path * untyped_library_file) list) : ((abs_path * untype | Error(_) -> assert false | Ok(pair) -> pair in - let entry = (modnm, utlib, vertex) in + let entry = (utlib, vertex) in (graph, modnm_to_path |> ModuleNameMap.add modnm abspath, Alist.extend entryacc entry) ) (FileDependencyGraph.empty, ModuleNameMap.empty, Alist.empty) in (* Add edges: *) let* graph = - entryacc |> Alist.to_list |> foldM (fun graph (modnm, utlib, vertex) -> + entryacc |> Alist.to_list |> foldM (fun graph (utlib, vertex) -> let (header, _) = utlib in header |> foldM (fun graph headerelem -> match headerelem with @@ -46,7 +46,6 @@ let main (utlibs : (abs_path * untyped_library_file) list) : ((abs_path * untype assert false | Some(vertex_sub) -> - Printf.printf "****SRC DEP: %s ---> %s\n" modnm modnm_sub; (* TODO: remove this *) let graph = graph |> FileDependencyGraph.add_edge ~from:vertex ~to_:vertex_sub in return graph end diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 6d0aab1d9..f1935e95a 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -395,6 +395,12 @@ let error_log_environment suspended = NormalLine(Printf.sprintf "file '%s' is not a document; it lacks a return value." fname); ] + | CannotUseHeaderUse(rng) -> + report_error Interface [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine("cannot specify 'use ...' here; use 'use ... of ...' instead."); + ] + | FailedToParse(rng) -> report_error Parser [ NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); @@ -1140,7 +1146,7 @@ let build Logging.dump_file dump_file_exists abspath_dump; (* Resolve dependency of the document and the local source files: *) - let (package_names, sorted_locals, utdoc) = + let (package_names, sorted_locals, utdoc_opt) = match OpenFileDependencyResolver.main abspath_in with | Ok(triple) -> triple | Error(e) -> raise (OpenFileDependencyError(e)) @@ -1168,16 +1174,21 @@ let build ) (GlobalTypeenv.empty, Alist.empty) in - (* Typechecking and elaboration: *) - let (libs_local, ast_doc) = - match PackageChecker.main_document tyenv_prim genv sorted_locals (abspath_in, utdoc) with - | Ok(pair) -> pair - | Error(e) -> raise (PackageCheckError(e)) - in - let libs = Alist.to_list (Alist.append libacc libs_local) in + match utdoc_opt with + | None -> + () - if type_check_only then - () - else - preprocess_and_evaluate env libs ast_doc abspath_in abspath_out abspath_dump + | Some(utdoc) -> + (* Typechecking and elaboration: *) + let (libs_local, ast_doc) = + match PackageChecker.main_document tyenv_prim genv sorted_locals (abspath_in, utdoc) with + | Ok(pair) -> pair + | Error(e) -> raise (PackageCheckError(e)) + in + let libs = Alist.to_list (Alist.append libacc libs_local) in + + if type_check_only then + () + else + preprocess_and_evaluate env libs ast_doc abspath_in abspath_out abspath_dump ) diff --git a/src/frontend/openFileDependencyResolver.ml b/src/frontend/openFileDependencyResolver.ml index b863f7587..7b359b7a0 100644 --- a/src/frontend/openFileDependencyResolver.ml +++ b/src/frontend/openFileDependencyResolver.ml @@ -8,6 +8,7 @@ type error = | CannotReadFileOwingToSystem of string | LibraryContainsWholeReturnValue of abs_path | DocumentLacksWholeReturnValue of abs_path + | CannotUseHeaderUse of Range.t | FailedToParse of Range.t type 'a ok = ('a, error) result @@ -35,30 +36,24 @@ let get_candidate_file_extensions () = | TextMode(formats) -> List.append (formats |> List.map (fun s -> ".satyh-" ^ s)) [ ".satyg" ] -(* -let get_package_abs_path (package : string) : abs_path = - let extcands = get_candidate_file_extensions () in - Config.resolve_package_exn package extcands -*) - - type local_or_package = | Local of module_name ranged * abs_path | Package of module_name ranged -let get_header (curdir : string) (headerelem : header_element) : local_or_package = +let get_header (curdir : string) (headerelem : header_element) : local_or_package ok = + let open ResultMonad in match headerelem with | HeaderUsePackage(modident) -> - Package(modident) + return @@ Package(modident) - | HeaderUse(_) -> - failwith "TODO (error): cannot use 'use X' here; use 'use X of path' instead" + | HeaderUse((rng, _)) -> + err @@ CannotUseHeaderUse(rng) | HeaderUseOf(modident, s_relpath) -> let extcands = get_candidate_file_extensions () in let abspath = Config.resolve_local_exn curdir s_relpath extcands in - Local(modident, abspath) + return @@ Local(modident, abspath) let rec register_library_file (graph : FileDependencyGraph.t) (package_names : PackageNameSet.t) ~prev:(vertex_prev_opt : FileDependencyGraph.vertex option) (abspath : abs_path) : (PackageNameSet.t * FileDependencyGraph.t) ok = @@ -94,7 +89,8 @@ let rec register_library_file (graph : FileDependencyGraph.t) (package_names : P | Some(vertex_prev) -> graph |> FileDependencyGraph.add_edge ~from:vertex_prev ~to_:vertex in header |> foldM (fun (package_names, graph) headerelem -> - match get_header curdir headerelem with + let* local_or_package = get_header curdir headerelem in + match local_or_package with | Package((_, main_module_name)) -> return (package_names |> PackageNameSet.add main_module_name, graph) @@ -103,7 +99,7 @@ let rec register_library_file (graph : FileDependencyGraph.t) (package_names : P ) (package_names, graph) -let register_document_file (graph : FileDependencyGraph.t) (package_names : PackageNameSet.t) (abspath_in : abs_path) : (PackageNameSet.t * FileDependencyGraph.t * untyped_document_file) ok = +let register_document_file (abspath_in : abs_path) : (PackageNameSet.t * FileDependencyGraph.t * untyped_document_file) ok = let open ResultMonad in Logging.begin_to_parse_file abspath_in; let curdir = Filename.dirname (get_abs_path_string abspath_in) in @@ -119,71 +115,66 @@ let register_document_file (graph : FileDependencyGraph.t) (package_names : Pack let (header, _) = utdoc in let* (package_names, graph) = header |> foldM (fun (package_names, graph) headerelem -> - match get_header curdir headerelem with + let* local_or_package = get_header curdir headerelem in + match local_or_package with | Package((_, main_module_name)) -> return (package_names |> PackageNameSet.add main_module_name, graph) | Local(_, abspath_sub) -> register_library_file graph package_names ~prev:None abspath_sub - ) (package_names, graph) + ) (PackageNameSet.empty, FileDependencyGraph.empty) in return (package_names, graph, utdoc) -(* -let register_markdown_file (graph : FileDependencyGraph.t) (setting : string) (abspath_in : abs_path) : FileDependencyGraph.t = + +let register_markdown_file (setting : string) (abspath_in : abs_path) : (PackageNameSet.t * untyped_document_file) ok = + let open ResultMonad in Logging.begin_to_parse_file abspath_in; let (cmdrcd, depends) = let abspath = Config.resolve_lib_file_exn (make_lib_path (Filename.concat "dist/md" (setting ^ ".satysfi-md"))) + (* TODO: error handling by `ResultMonad` *) in LoadMDSetting.main abspath in - let utast = + let* utast = match MyUtil.string_of_file abspath_in with - | Ok(data) -> DecodeMD.decode cmdrcd data - | Error(msg) -> raise (CannotReadFileOwingToSystem(msg)) + | Ok(data) -> return (DecodeMD.decode cmdrcd data) + | Error(msg) -> err (CannotReadFileOwingToSystem(msg)) in - let (graph, vertex) = - match graph |> FileDependencyGraph.add_vertex abspath_in (DocumentFile(utast)) with - | Error(_) -> assert false - | Ok(pair) -> pair + let package_names = + depends |> List.fold_left (fun package_names main_module_name -> + package_names |> PackageNameSet.add main_module_name + ) PackageNameSet.empty in - depends |> List.fold_left (fun graph package -> - let abspath_sub = get_package_abs_path package in - match graph |> FileDependencyGraph.get_vertex abspath_sub with - | Some(vertex_sub) -> - graph |> FileDependencyGraph.add_edge ~from:vertex ~to_:vertex_sub - - | None -> - register_library_file graph ~prev:vertex abspath_sub - - ) graph -*) + let header = + depends |> List.map (fun main_module_name -> + HeaderUsePackage((Range.dummy "md-header", main_module_name)) + ) + in + return (package_names, (header, utast)) -let main (abspath_in : abs_path) : (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file) ok = +let main (abspath_in : abs_path) : (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file option) ok = let open ResultMonad in - let graph = FileDependencyGraph.empty in - let package_names = PackageNameSet.empty in - let* (package_names, graph, utdoc) = + let* (package_names, graph, utdoc_opt) = match OptionState.get_input_kind () with | OptionState.SATySFi -> if has_library_extension abspath_in && OptionState.is_type_check_only () then - failwith "TODO: --type-check-only" -(* - register_library_file graph package_names ~prev:None abspath_in -*) + let graph = FileDependencyGraph.empty in + let package_names = PackageNameSet.empty in + let* (package_names, graph) = register_library_file graph package_names ~prev:None abspath_in in + return (package_names, graph, None) else - register_document_file graph package_names abspath_in + let* (package_names, graph, utdoc) = register_document_file abspath_in in + return (package_names, graph, Some(utdoc)) - | OptionState.Markdown(_setting) -> - failwith "TODO: Markdown" -(* - register_markdown_file graph setting abspath_in -*) + | OptionState.Markdown(setting) -> + let* (package_names, utdoc) = register_markdown_file setting abspath_in in + return (package_names, FileDependencyGraph.empty, Some(utdoc)) in let* sorted_locals = FileDependencyGraph.topological_sort graph |> Result.map_error (fun cycle -> CyclicFileDependency(cycle)) in - return (package_names, sorted_locals, utdoc) + return (package_names, sorted_locals, utdoc_opt) diff --git a/src/frontend/openFileDependencyResolver.mli b/src/frontend/openFileDependencyResolver.mli index 4bf14a8a7..b8c9437df 100644 --- a/src/frontend/openFileDependencyResolver.mli +++ b/src/frontend/openFileDependencyResolver.mli @@ -7,6 +7,7 @@ type error = | CannotReadFileOwingToSystem of string | LibraryContainsWholeReturnValue of abs_path | DocumentLacksWholeReturnValue of abs_path + | CannotUseHeaderUse of Range.t | FailedToParse of Range.t -val main : abs_path -> (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file, error) result +val main : abs_path -> (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file option, error) result diff --git a/src/frontend/openPackageDependencyResolver.ml b/src/frontend/openPackageDependencyResolver.ml index 5c114483f..68c955540 100644 --- a/src/frontend/openPackageDependencyResolver.ml +++ b/src/frontend/openPackageDependencyResolver.ml @@ -38,7 +38,6 @@ let rec add_package (graph : graph) ~prev:(vertex_prev_opt : vertex option) (mai return graph | None -> - Printf.printf "****PACKAGE: %s\n" main_module_name; (* TODO: remove this *) let* absdir = Config.resolve_package_directory main_module_name |> Result.map_error (fun cands -> PackageDirectoryNotFound(cands)) @@ -59,7 +58,6 @@ let rec add_package (graph : graph) ~prev:(vertex_prev_opt : vertex option) (mai | Some(vertex_prev) -> graph |> PackageDependencyGraph.add_edge ~from:vertex_prev ~to_:vertex in package.dependencies |> foldM (fun graph main_module_name_dep -> - Printf.printf "****DEP2: %s ---> %s\n" main_module_name main_module_name_dep; (* TODO: remove this *) add_package graph ~prev:(Some(vertex)) main_module_name_dep ) graph else @@ -81,5 +79,4 @@ let main (package_name_set_init : PackageNameSet.t) : (package_info list) ok = PackageDependencyGraph.topological_sort graph |> Result.map_error (fun cycle -> CyclicPackageDependency(cycle)) in - Printf.printf "****SORTED: %s\n" (pairs |> List.map (fun (n, _) -> n) |> String.concat " > "); (* TODO: remove this *) return (pairs |> List.map (fun (_, package) -> package)) diff --git a/src/frontend/packageChecker.ml b/src/frontend/packageChecker.ml index f899501bd..c7f46ad10 100644 --- a/src/frontend/packageChecker.ml +++ b/src/frontend/packageChecker.ml @@ -41,7 +41,7 @@ let add_dependency_to_type_environment ~(package_only : bool) (header : header_e begin match (kind, genv |> GlobalTypeenv.find_opt modnm) with | (LocalDependency, None) -> - failwith (Printf.sprintf "TODO: add_dependency_to_type_environment %s" modnm) + assert false | (PackageDependency, None) -> err @@ UnknownPackageDependency(rng, modnm) @@ -122,12 +122,10 @@ let main (tyenv_prim : Typeenv.t) (genv : global_type_environment) (package : pa let main_document (tyenv_prim : Typeenv.t) (genv : global_type_environment) (sorted_locals : (abs_path * untyped_library_file) list) (utdoc : abs_path * untyped_document_file) : ((abs_path * binding list) list * abstract_tree) ok = let open ResultMonad in - Format.printf "****LOCALS: %s\n" (sorted_locals |> List.map (fun (_, (_, ((_, modnm), _, _))) -> modnm) |> String.concat ", "); (* TODO: remove this *) let* (genv, libacc) = sorted_locals |> foldM (fun (genv, libacc) (abspath, utlib) -> let (header, (modident, utsig_opt, utbinds)) = utlib in let (_, modnm) = modident in - Format.printf "****ADD: %s %a\n" modnm (Format.pp_print_list pp_header_element) header; (* TODO: remove this *) let* ((_quant, ssig), binds) = let* tyenv = tyenv_prim |> add_dependency_to_type_environment ~package_only:false header genv in typecheck_library_file ~for_struct:tyenv ~for_sig:tyenv abspath utsig_opt utbinds @@ -141,7 +139,6 @@ let main_document (tyenv_prim : Typeenv.t) (genv : global_type_environment) (sor (* Typecheck the document: *) let* ast_doc = let (abspath, (header, utast)) = utdoc in - Format.printf "****ADD TO DOC: %a\n" (Format.pp_print_list pp_header_element) header; (* TODO: remove this *) let* tyenv = tyenv_prim |> add_dependency_to_type_environment ~package_only:false header genv in typecheck_document_file tyenv abspath utast in diff --git a/tests/Makefile b/tests/Makefile index 17b20efcc..b0fd5d8ee 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -28,6 +28,7 @@ all:: $(TARGETS) all:: (cd images; make) (cd text_mode; make) + (cd md; make) clean:: rm -f *.pdf *.satysfi-aux @@ -35,6 +36,7 @@ clean:: clean:: (cd images; make clean) (cd text_mode; make clean) + (cd md; make clean) clip.pdf: head.satyh first.pdf: head.satyh diff --git a/tests/md/Makefile b/tests/md/Makefile new file mode 100644 index 000000000..d2c624aa9 --- /dev/null +++ b/tests/md/Makefile @@ -0,0 +1,16 @@ +TARGETS = \ + test.pdf \ + +SATYSFI ?= satysfi + +.PHONY: all clean + +.SUFFIXES: .saty .pdf + +.saty.pdf: + $(SATYSFI) --markdown "mdja" $< -o $@ + +all:: $(TARGETS) + +clean: + rm -f *.pdf *.satysfi-aux diff --git a/tests/md/test.md b/tests/md/test.md new file mode 100644 index 000000000..58667e57c --- /dev/null +++ b/tests/md/test.md @@ -0,0 +1,108 @@ + + +I am in the process of changing the language design for SATySFi v0.1.0 about optional parameters. It will be a breaking change (i.e. not backward compatible with SATySFi v0.0.x), and I will introduce it here. + +First appearance: + +- Dec 30, 2021. [SATySFi Wiki](https://github.com/gfngfn/SATySFi/wiki/%E3%83%A9%E3%83%99%E3%83%AB%E3%81%A4%E3%81%8D%E3%82%AA%E3%83%97%E3%82%B7%E3%83%A7%E3%83%B3%E5%BC%95%E6%95%B0%E3%81%AE%E5%9E%8B%E3%82%B7%E3%82%B9%E3%83%86%E3%83%A0) (written in Japanese) + + +# Motivation of the Reformulation + +Originally, SATySFi v0.0.x has a mechanism of non-labeled optional parameters/arguments, and it can be used with `?:` like the following: + +``` ++section?:(`sec:sample`)?:(`Sample`){Sample}< + ... the contents of the section ... +> +``` + +Optional arguments do not have a label, and thereby are distinguished by their order. In the example above, the first optional argument is a tag for the cross reference, and the second one is for the title of the section displayed in the Outline of the resulting PDF file. As well as commands, ordinary functions can take optional parameters: + +``` +let increment ?diff-opt n = + match diff-opt with + | Some(d) -> n + d + | None -> n + 1 +in +(increment 42, increment ?:57 42) + % --> (43, 99) +``` + +The reason why a mechanism of non-labeled optional parameters was adopted is that the language design was inspired by that of LaTeX, where optional parameters are conventionally given in a non-labeled manner: + +``` +\parbox[c]{6em}{…}, $\sqrt[3]{2}$ +``` + +It has, however, lead to the following significant inconvenience, partly because there came to be more use cases of optional parameters than expected: + +- Since optional arguments are distinguished only by their order, in many cases where you use or read functions that have optional parameters it is difficult to comprehend in what order each argument should be specified. + +- When you want to omit a former parameter and to give an argument to a latter one, you have to do some cumbersome workaround–to “explicitly omit” the former one by `?*`. + + ``` + +section?*?:(`Sample`){Sample}< + ... the contents of the section ... + > + ``` + +To remove this kind of burden, I came upon the idea of reformulating the mechanism of optional parameters into labeled one where one can give optional arguments like the following: + +``` ++section?(ref = `sec:sample`, outline = `Sample`){Sample}< + ... the contents of the section ... +> +``` + +As you can see, optional arguments can be specified by `?(label1 = arg1, …, labelN = argN)`. You can omit the whole part `?(...)` if you don’t want to specify any optional argument. Ordinary functions can take labeled optional parameters as well: + +``` +let increment ?(diff = diff-opt) n = + match diff-opt with + | Some(d) -> n + d + | None -> n + 1 + end +in +(increment 42, increment ?(diff = 57) 42) +``` + +This will bring the following benefits: + +- Since optional arguments are labeled, it is easy to read for what purpose each argument is specified. +- Since optional arguments can be in a ramdom order, you don’t have to do any workaround like the one using `?*`. +- Because types of optional parameters/arguments can be statically inferred as usual, type errors will be reported when one gives an argument of a type incompatible to the expected one. + +It seems also good to me that one can give default values as follows when defining optional parameters: + +``` +let increment ?(diff = d = 1) n = + n + d +in +(increment 42, increment ?(diff = 57) 42) +``` + + +# The Detail of the Type System + +## Extension to Function Types, Function Abstractions, and Function Applications + +(omitted) + + +## Polymorphism + +(omitted) + + +# Conclusion + +This article has introduced a mechanism of labeled optional parameters designed and implemented for SATySFi v0.1.0, and explained that it is based on the row polymorphism. + + +# References + +1. Benedict R. Gaster and Mark P. Jones. [A polymorphic type system for extensible records and variants](https://web.cecs.pdx.edu/~mpj/pubs/96-3.pdf), 1996. From 2716b67ca2afc56aec1fa32866fb36824b703d0d Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 26 Oct 2022 00:49:36 +0900 Subject: [PATCH 033/288] fix Makefile --- tests/md/Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/md/Makefile b/tests/md/Makefile index d2c624aa9..69230abb1 100644 --- a/tests/md/Makefile +++ b/tests/md/Makefile @@ -5,9 +5,9 @@ SATYSFI ?= satysfi .PHONY: all clean -.SUFFIXES: .saty .pdf +.SUFFIXES: .md .pdf -.saty.pdf: +.md.pdf: $(SATYSFI) --markdown "mdja" $< -o $@ all:: $(TARGETS) From 8009f32db106fea8dff4bb2a5d1fe6a0623d427c Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 26 Oct 2022 01:33:03 +0900 Subject: [PATCH 034/288] make packages support the text mode --- src/frontend/main.ml | 12 +++++-- src/frontend/openFileDependencyResolver.ml | 31 ++++++++----------- src/frontend/openFileDependencyResolver.mli | 2 +- src/frontend/openPackageDependencyResolver.ml | 10 +++--- .../openPackageDependencyResolver.mli | 14 +++++++++ src/frontend/packageReader.ml | 3 +- src/frontend/packageReader.mli | 12 +++++++ 7 files changed, 56 insertions(+), 28 deletions(-) create mode 100644 src/frontend/openPackageDependencyResolver.mli create mode 100644 src/frontend/packageReader.mli diff --git a/src/frontend/main.ml b/src/frontend/main.ml index f1935e95a..84893b07a 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1074,6 +1074,12 @@ let make_absolute_if_relative ~(origin : string) (s : string) : abs_path = make_abs_path abspath_str +let get_candidate_file_extensions () = + match OptionState.get_output_mode () with + | PdfMode -> [ ".satyh"; ".satyg" ] + | TextMode(formats) -> List.append (formats |> List.map (fun s -> ".satyh-" ^ s)) [ ".satyg" ] + + let build ~(fpath_in : string) ~(fpath_out_opt : string option) @@ -1145,16 +1151,18 @@ let build let (tyenv_prim, env, dump_file_exists) = initialize abspath_dump in Logging.dump_file dump_file_exists abspath_dump; + let extensions = get_candidate_file_extensions () in + (* Resolve dependency of the document and the local source files: *) let (package_names, sorted_locals, utdoc_opt) = - match OpenFileDependencyResolver.main abspath_in with + match OpenFileDependencyResolver.main ~extensions abspath_in with | Ok(triple) -> triple | Error(e) -> raise (OpenFileDependencyError(e)) in (* Resolve dependency among packages that the document depends on: *) let sorted_packages = - match OpenPackageDependencyResolver.main package_names with + match OpenPackageDependencyResolver.main ~extensions package_names with | Ok(sorted_packages) -> sorted_packages | Error(e) -> raise (OpenPackageDependencyError(e)) in diff --git a/src/frontend/openFileDependencyResolver.ml b/src/frontend/openFileDependencyResolver.ml index 7b359b7a0..d4138e0a5 100644 --- a/src/frontend/openFileDependencyResolver.ml +++ b/src/frontend/openFileDependencyResolver.ml @@ -30,18 +30,12 @@ let has_library_extension (abspath : abs_path) : bool = end -let get_candidate_file_extensions () = - match OptionState.get_output_mode () with - | PdfMode -> [ ".satyh"; ".satyg" ] - | TextMode(formats) -> List.append (formats |> List.map (fun s -> ".satyh-" ^ s)) [ ".satyg" ] - - type local_or_package = | Local of module_name ranged * abs_path | Package of module_name ranged -let get_header (curdir : string) (headerelem : header_element) : local_or_package ok = +let get_header (extensions : string list) (curdir : string) (headerelem : header_element) : local_or_package ok = let open ResultMonad in match headerelem with | HeaderUsePackage(modident) -> @@ -51,12 +45,11 @@ let get_header (curdir : string) (headerelem : header_element) : local_or_packag err @@ CannotUseHeaderUse(rng) | HeaderUseOf(modident, s_relpath) -> - let extcands = get_candidate_file_extensions () in - let abspath = Config.resolve_local_exn curdir s_relpath extcands in + let abspath = Config.resolve_local_exn curdir s_relpath extensions in return @@ Local(modident, abspath) -let rec register_library_file (graph : FileDependencyGraph.t) (package_names : PackageNameSet.t) ~prev:(vertex_prev_opt : FileDependencyGraph.vertex option) (abspath : abs_path) : (PackageNameSet.t * FileDependencyGraph.t) ok = +let rec register_library_file (extensions : string list) (graph : FileDependencyGraph.t) (package_names : PackageNameSet.t) ~prev:(vertex_prev_opt : FileDependencyGraph.vertex option) (abspath : abs_path) : (PackageNameSet.t * FileDependencyGraph.t) ok = let open ResultMonad in match graph |> FileDependencyGraph.get_vertex abspath with | Some(vertex) -> @@ -89,17 +82,17 @@ let rec register_library_file (graph : FileDependencyGraph.t) (package_names : P | Some(vertex_prev) -> graph |> FileDependencyGraph.add_edge ~from:vertex_prev ~to_:vertex in header |> foldM (fun (package_names, graph) headerelem -> - let* local_or_package = get_header curdir headerelem in + let* local_or_package = get_header extensions curdir headerelem in match local_or_package with | Package((_, main_module_name)) -> return (package_names |> PackageNameSet.add main_module_name, graph) | Local(_modident_sub, abspath_sub) -> - register_library_file graph package_names ~prev:(Some(vertex)) abspath_sub + register_library_file extensions graph package_names ~prev:(Some(vertex)) abspath_sub ) (package_names, graph) -let register_document_file (abspath_in : abs_path) : (PackageNameSet.t * FileDependencyGraph.t * untyped_document_file) ok = +let register_document_file (extensions : string list) (abspath_in : abs_path) : (PackageNameSet.t * FileDependencyGraph.t * untyped_document_file) ok = let open ResultMonad in Logging.begin_to_parse_file abspath_in; let curdir = Filename.dirname (get_abs_path_string abspath_in) in @@ -115,13 +108,13 @@ let register_document_file (abspath_in : abs_path) : (PackageNameSet.t * FileDep let (header, _) = utdoc in let* (package_names, graph) = header |> foldM (fun (package_names, graph) headerelem -> - let* local_or_package = get_header curdir headerelem in + let* local_or_package = get_header extensions curdir headerelem in match local_or_package with | Package((_, main_module_name)) -> return (package_names |> PackageNameSet.add main_module_name, graph) | Local(_, abspath_sub) -> - register_library_file graph package_names ~prev:None abspath_sub + register_library_file extensions graph package_names ~prev:None abspath_sub ) (PackageNameSet.empty, FileDependencyGraph.empty) in return (package_names, graph, utdoc) @@ -155,7 +148,7 @@ let register_markdown_file (setting : string) (abspath_in : abs_path) : (Package return (package_names, (header, utast)) -let main (abspath_in : abs_path) : (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file option) ok = +let main ~(extensions : string list) (abspath_in : abs_path) : (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file option) ok = let open ResultMonad in let* (package_names, graph, utdoc_opt) = match OptionState.get_input_kind () with @@ -163,10 +156,12 @@ let main (abspath_in : abs_path) : (PackageNameSet.t * (abs_path * untyped_libra if has_library_extension abspath_in && OptionState.is_type_check_only () then let graph = FileDependencyGraph.empty in let package_names = PackageNameSet.empty in - let* (package_names, graph) = register_library_file graph package_names ~prev:None abspath_in in + let* (package_names, graph) = + register_library_file extensions graph package_names ~prev:None abspath_in + in return (package_names, graph, None) else - let* (package_names, graph, utdoc) = register_document_file abspath_in in + let* (package_names, graph, utdoc) = register_document_file extensions abspath_in in return (package_names, graph, Some(utdoc)) | OptionState.Markdown(setting) -> diff --git a/src/frontend/openFileDependencyResolver.mli b/src/frontend/openFileDependencyResolver.mli index b8c9437df..eaa68933c 100644 --- a/src/frontend/openFileDependencyResolver.mli +++ b/src/frontend/openFileDependencyResolver.mli @@ -10,4 +10,4 @@ type error = | CannotUseHeaderUse of Range.t | FailedToParse of Range.t -val main : abs_path -> (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file option, error) result +val main : extensions:(string list) -> abs_path -> (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file option, error) result diff --git a/src/frontend/openPackageDependencyResolver.ml b/src/frontend/openPackageDependencyResolver.ml index 68c955540..e8ff401a9 100644 --- a/src/frontend/openPackageDependencyResolver.ml +++ b/src/frontend/openPackageDependencyResolver.ml @@ -22,7 +22,7 @@ type graph = package_info PackageDependencyGraph.t type vertex = PackageDependencyGraph.Vertex.t -let rec add_package (graph : graph) ~prev:(vertex_prev_opt : vertex option) (main_module_name : module_name) : graph ok = +let rec add_package (extensions : string list) (graph : graph) ~prev:(vertex_prev_opt : vertex option) (main_module_name : module_name) : graph ok = let open ResultMonad in match graph |> PackageDependencyGraph.get_vertex main_module_name with | Some(vertex) -> @@ -43,7 +43,7 @@ let rec add_package (graph : graph) ~prev:(vertex_prev_opt : vertex option) (mai |> Result.map_error (fun cands -> PackageDirectoryNotFound(cands)) in let* package = - PackageReader.main absdir + PackageReader.main ~extensions absdir |> Result.map_error (fun e -> PackageReadingError(e)) in if String.equal package.main_module_name main_module_name then @@ -58,7 +58,7 @@ let rec add_package (graph : graph) ~prev:(vertex_prev_opt : vertex option) (mai | Some(vertex_prev) -> graph |> PackageDependencyGraph.add_edge ~from:vertex_prev ~to_:vertex in package.dependencies |> foldM (fun graph main_module_name_dep -> - add_package graph ~prev:(Some(vertex)) main_module_name_dep + add_package extensions graph ~prev:(Some(vertex)) main_module_name_dep ) graph else err @@ MainModuleNameMismatch{ @@ -67,12 +67,12 @@ let rec add_package (graph : graph) ~prev:(vertex_prev_opt : vertex option) (mai } -let main (package_name_set_init : PackageNameSet.t) : (package_info list) ok = +let main ~(extensions : string list) (package_name_set_init : PackageNameSet.t) : (package_info list) ok = let open ResultMonad in let main_module_names_init = package_name_set_init |> PackageNameSet.elements in let* graph = main_module_names_init |> foldM (fun graph main_module_name -> - add_package graph ~prev:None main_module_name + add_package extensions graph ~prev:None main_module_name ) PackageDependencyGraph.empty in let* pairs = diff --git a/src/frontend/openPackageDependencyResolver.mli b/src/frontend/openPackageDependencyResolver.mli new file mode 100644 index 000000000..bfe1b121f --- /dev/null +++ b/src/frontend/openPackageDependencyResolver.mli @@ -0,0 +1,14 @@ + +open Types + +type error = + | MainModuleNameMismatch of { + expected : module_name; + got : module_name; + } + | PackageDirectoryNotFound of string list + | PackageReadingError of PackageReader.error + | CyclicPackageDependency of (module_name * package_info) cycle +[@@deriving show] + +val main : extensions:(string list) -> PackageNameSet.t -> (package_info list, error) result diff --git a/src/frontend/packageReader.ml b/src/frontend/packageReader.ml index c6763df77..e03bae009 100644 --- a/src/frontend/packageReader.ml +++ b/src/frontend/packageReader.ml @@ -67,7 +67,7 @@ let listup_sources_in_directory (extensions : string list) (absdir_src : abs_pat ) -let main (absdir_package : abs_path) : package_info ok = +let main ~(extensions : string list) (absdir_package : abs_path) : package_info ok = let open ResultMonad in let* config = load_config absdir_package in let* package = @@ -82,7 +82,6 @@ let main (absdir_package : abs_path) : package_info ok = make_abs_path (Filename.concat (get_abs_path_string absdir_package) source_directory) ) in - let extensions = [ ".satyh"; ".satyg" ] in (* TODO: generalize this to the text mode *) let abspaths_src = absdirs_src |> List.map (listup_sources_in_directory extensions) |> List.concat in let* acc = abspaths_src |> foldM (fun acc abspath_src -> diff --git a/src/frontend/packageReader.mli b/src/frontend/packageReader.mli new file mode 100644 index 000000000..636390815 --- /dev/null +++ b/src/frontend/packageReader.mli @@ -0,0 +1,12 @@ + +open MyUtil +open Types + +type error = + | PackageConfigNotFound of abs_path + | PackageConfigError of YamlDecoder.error + | FailedToParse of Range.t + | NotALibraryFile of abs_path +[@@deriving show] + +val main : extensions:(string list) -> abs_path -> (package_info, error) result From 37ce6f6248b4f986d627a3f8aaa0365410a43cf5 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 26 Oct 2022 02:21:20 +0900 Subject: [PATCH 035/288] refactor the parser by introducing type 'parse_error' --- src/frontend/main.ml | 30 ++++++++++++++------- src/frontend/openFileDependencyResolver.ml | 2 +- src/frontend/openFileDependencyResolver.mli | 2 +- src/frontend/packageReader.ml | 4 +-- src/frontend/packageReader.mli | 2 +- src/frontend/parser.mly | 5 ++-- src/frontend/parserInterface.ml | 8 +++--- src/frontend/parserInterface.mli | 6 ++--- src/frontend/types.cppo.ml | 12 ++++++++- 9 files changed, 44 insertions(+), 27 deletions(-) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 84893b07a..585bf9814 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -401,10 +401,26 @@ let error_log_environment suspended = NormalLine("cannot specify 'use ...' here; use 'use ... of ...' instead."); ] - | FailedToParse(rng) -> - report_error Parser [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - ] + | FailedToParse(e) -> + begin + match e with + | CannotProgressParsing(rng) -> + report_error Parser [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + ] + + | IllegalItemDepth{ range = rng; before; current } -> + report_error Parser [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "illegal item depth %d after %d" before current); + ] + + | EmptyInputFile(rng) -> + report_error Parser [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine("empty input."); + ] + end end | OpenPackageDependencyError(e) -> @@ -546,12 +562,6 @@ let error_log_environment suspended = NormalLine(s); ] - | ParseErrorDetail(rng, s) -> - report_error Parser [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(s) - ] - | LoadMDSetting.MultipleCodeNameDesignation(rng, s) -> report_error System [ NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); diff --git a/src/frontend/openFileDependencyResolver.ml b/src/frontend/openFileDependencyResolver.ml index d4138e0a5..451ff8249 100644 --- a/src/frontend/openFileDependencyResolver.ml +++ b/src/frontend/openFileDependencyResolver.ml @@ -9,7 +9,7 @@ type error = | LibraryContainsWholeReturnValue of abs_path | DocumentLacksWholeReturnValue of abs_path | CannotUseHeaderUse of Range.t - | FailedToParse of Range.t + | FailedToParse of parse_error type 'a ok = ('a, error) result diff --git a/src/frontend/openFileDependencyResolver.mli b/src/frontend/openFileDependencyResolver.mli index eaa68933c..61ad60e7b 100644 --- a/src/frontend/openFileDependencyResolver.mli +++ b/src/frontend/openFileDependencyResolver.mli @@ -8,6 +8,6 @@ type error = | LibraryContainsWholeReturnValue of abs_path | DocumentLacksWholeReturnValue of abs_path | CannotUseHeaderUse of Range.t - | FailedToParse of Range.t + | FailedToParse of parse_error val main : extensions:(string list) -> abs_path -> (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file option, error) result diff --git a/src/frontend/packageReader.ml b/src/frontend/packageReader.ml index e03bae009..4491f042a 100644 --- a/src/frontend/packageReader.ml +++ b/src/frontend/packageReader.ml @@ -5,7 +5,7 @@ open Types type error = | PackageConfigNotFound of abs_path | PackageConfigError of YamlDecoder.error - | FailedToParse of Range.t + | FailedToParse of parse_error | NotALibraryFile of abs_path [@@deriving show { with_path = false }] @@ -87,7 +87,7 @@ let main ~(extensions : string list) (absdir_package : abs_path) : package_info abspaths_src |> foldM (fun acc abspath_src -> let* utsrc = Logging.begin_to_parse_file abspath_src; - ParserInterface.process_file abspath_src |> Result.map_error (fun rng -> FailedToParse(rng)) + ParserInterface.process_file abspath_src |> Result.map_error (fun e -> FailedToParse(e)) in match utsrc with | UTLibraryFile(utlib) -> diff --git a/src/frontend/packageReader.mli b/src/frontend/packageReader.mli index 636390815..47a4a5839 100644 --- a/src/frontend/packageReader.mli +++ b/src/frontend/packageReader.mli @@ -5,7 +5,7 @@ open Types type error = | PackageConfigNotFound of abs_path | PackageConfigError of YamlDecoder.error - | FailedToParse of Range.t + | FailedToParse of parse_error | NotALibraryFile of abs_path [@@deriving show] diff --git a/src/frontend/parser.mly b/src/frontend/parser.mly index b0a73eaa4..96b472e85 100644 --- a/src/frontend/parser.mly +++ b/src/frontend/parser.mly @@ -209,8 +209,7 @@ let newresitmz = insert_last [] resitmz 1 depth utast in make_list_to_itemize_sub newresitmz tail depth else - raise (ParseErrorDetail(rng, "syntax error: illegal item depth " - ^ (string_of_int depth) ^ " after " ^ (string_of_int crrntdp))) + raise (ParseError(IllegalItemDepth{ range = rng; before = depth; current = crrntdp })) let make_list_to_itemize (lst : (Range.t * int * untyped_abstract_tree) list) = @@ -365,7 +364,7 @@ main: | header=list(headerelem); utast=expr; EOI { UTDocumentFile(header, utast) } | rng=EOI - { raise (ParseErrorDetail(rng, "empty input")) } + { raise (ParseError(EmptyInputFile(rng))) } ; main_lib: | MODULE; modident=UPPER; utsig_opt=option(sig_annot); EXACT_EQ; STRUCT; utbinds=list(bind); END diff --git a/src/frontend/parserInterface.ml b/src/frontend/parserInterface.ml index 3299712f4..a8d07686e 100644 --- a/src/frontend/parserInterface.ml +++ b/src/frontend/parserInterface.ml @@ -1,6 +1,4 @@ -exception InternalError of Range.t - module I = Parser.MenhirInterpreter open MyUtil @@ -18,7 +16,7 @@ let k_fail chkpt = let cnumS = lposS.Lexing.pos_cnum - lposS.Lexing.pos_bol in let cnumE = lposE.Lexing.pos_cnum - lposE.Lexing.pos_bol in let rng = Range.make lposS.Lexing.pos_fname lposS.Lexing.pos_lnum cnumS cnumE in - raise (InternalError(rng)) + raise (ParseError(CannotProgressParsing(rng))) | _ -> assert false @@ -32,8 +30,8 @@ let process_common (fname : string) (lexbuf : Lexing.lexbuf) = try return @@ I.loop_handle k_success k_fail supplier (Parser.Incremental.main lexbuf.Lexing.lex_curr_p) with - | InternalError(rng) -> - err rng + | ParseError(e) -> + err e let process_file (abspath : abs_path) = diff --git a/src/frontend/parserInterface.mli b/src/frontend/parserInterface.mli index d6c30a79b..1d0b114f9 100644 --- a/src/frontend/parserInterface.mli +++ b/src/frontend/parserInterface.mli @@ -2,8 +2,8 @@ open MyUtil open Types -val process_common : string -> Lexing.lexbuf -> (untyped_source_file, Range.t) result +val process_common : string -> Lexing.lexbuf -> (untyped_source_file, parse_error) result -val process_file : abs_path -> (untyped_source_file, Range.t) result +val process_file : abs_path -> (untyped_source_file, parse_error) result -val process_text : string -> string -> (untyped_source_file, Range.t) result +val process_text : string -> string -> (untyped_source_file, parse_error) result diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index 15e9696b9..7609b748e 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -4,7 +4,17 @@ open GraphicBase open SyntaxBase open MyUtil -exception ParseErrorDetail of Range.t * string +type parse_error = + | CannotProgressParsing of Range.t + | IllegalItemDepth of { + range : Range.t; + before : int; + current : int; + } + | EmptyInputFile of Range.t +[@@deriving show { with_path = false }] + +exception ParseError of parse_error let string_of_uchar (uch : Uchar.t) : string = From 47bc8a7611ebec3f533f07f025d685aa06ba4088 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 26 Oct 2022 02:58:55 +0900 Subject: [PATCH 036/288] unite errors into 'config_error' --- src/frontend/closedFileDependencyResolver.ml | 8 +- src/frontend/closedFileDependencyResolver.mli | 8 +- src/frontend/configError.ml | 27 + src/frontend/main.ml | 930 +++++++++--------- src/frontend/openFileDependencyResolver.ml | 11 +- src/frontend/openFileDependencyResolver.mli | 11 +- src/frontend/openPackageDependencyResolver.ml | 18 +- .../openPackageDependencyResolver.mli | 13 +- src/frontend/packageChecker.ml | 17 +- src/frontend/packageChecker.mli | 9 + src/frontend/packageReader.ml | 10 +- src/frontend/packageReader.mli | 10 +- src/frontend/typeError.ml | 1 - 13 files changed, 546 insertions(+), 527 deletions(-) create mode 100644 src/frontend/configError.ml create mode 100644 src/frontend/packageChecker.mli diff --git a/src/frontend/closedFileDependencyResolver.ml b/src/frontend/closedFileDependencyResolver.ml index df7a62bbc..7c5d453dd 100644 --- a/src/frontend/closedFileDependencyResolver.ml +++ b/src/frontend/closedFileDependencyResolver.ml @@ -1,13 +1,9 @@ open MyUtil open Types +open ConfigError -type error = - | FileModuleNotFound of Range.t * module_name - | CyclicFileDependency of (abs_path * untyped_library_file) cycle -[@@deriving show { with_path = false }] - -type 'a ok = ('a, error) result +type 'a ok = ('a, config_error) result let main (utlibs : (abs_path * untyped_library_file) list) : ((abs_path * untyped_library_file) list) ok = diff --git a/src/frontend/closedFileDependencyResolver.mli b/src/frontend/closedFileDependencyResolver.mli index 8ed41e2fb..4bc9b8e64 100644 --- a/src/frontend/closedFileDependencyResolver.mli +++ b/src/frontend/closedFileDependencyResolver.mli @@ -1,10 +1,6 @@ open MyUtil open Types +open ConfigError -type error = - | FileModuleNotFound of Range.t * module_name - | CyclicFileDependency of (abs_path * untyped_library_file) cycle -[@@deriving show] - -val main : (abs_path * untyped_library_file) list -> ((abs_path * untyped_library_file) list, error) result +val main : (abs_path * untyped_library_file) list -> ((abs_path * untyped_library_file) list, config_error) result diff --git a/src/frontend/configError.ml b/src/frontend/configError.ml new file mode 100644 index 000000000..5ebe93f2a --- /dev/null +++ b/src/frontend/configError.ml @@ -0,0 +1,27 @@ + +open MyUtil +open Types + + +type config_error = + | CyclicFileDependency of (abs_path * untyped_library_file) cycle + | CannotReadFileOwingToSystem of string + | LibraryContainsWholeReturnValue of abs_path + | DocumentLacksWholeReturnValue of abs_path + | CannotUseHeaderUse of Range.t + | FailedToParse of parse_error + | MainModuleNameMismatch of { + expected : module_name; + got : module_name; + } + | PackageDirectoryNotFound of string list + | PackageConfigNotFound of abs_path + | PackageConfigError of YamlDecoder.error + | NotALibraryFile of abs_path + | CyclicPackageDependency of (module_name * package_info) cycle + | TypeError of TypeError.type_error + | FileModuleNotFound of Range.t * module_name + | NotADocumentFile of abs_path * mono_type + | NotAStringFile of abs_path * mono_type + | NoMainModule of module_name + | UnknownPackageDependency of Range.t * module_name diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 585bf9814..d7da5e905 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -2,14 +2,13 @@ open MyUtil open Types open StaticEnv +open ConfigError open TypeError exception NoLibraryRootDesignation exception ShouldSpecifyOutputFile -exception OpenFileDependencyError of OpenFileDependencyResolver.error -exception OpenPackageDependencyError of OpenPackageDependencyResolver.error -exception PackageCheckError of PackageChecker.error +exception ConfigError of config_error (* Initialization that should be performed before every cross-reference-solving loop *) @@ -346,6 +345,418 @@ let make_unification_error_message (dispmap : DisplayMap.t) (ue : unification_er [] (* TODO (error): detailed report *) +let report_parse_error = function + | CannotProgressParsing(rng) -> + report_error Parser [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + ] + + | IllegalItemDepth{ range = rng; before; current } -> + report_error Parser [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "illegal item depth %d after %d" before current); + ] + + | EmptyInputFile(rng) -> + report_error Parser [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine("empty input."); + ] + + +let report_type_error = function + | UndefinedVariable(rng, varnm, candidates) -> + let candidates_message_lines = + match make_candidates_message candidates with + | None -> [] + | Some(s) -> [ NormalLine(s) ] + in + report_error Typechecker (List.concat [ + [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "undefined variable '%s'." varnm); + ]; + candidates_message_lines; + ]) + + | UndefinedConstructor(rng, constrnm, candidates) -> + let candidates_message_lines = + match make_candidates_message candidates with + | None -> [] + | Some(s) -> [ NormalLine(s) ] + in + report_error Typechecker (List.concat [ + [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "undefined constructor '%s'." constrnm); + ]; + candidates_message_lines; + ]) + + | UndefinedTypeName(rng, tynm) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "undefined type '%s'." tynm); + ] + + | UndefinedTypeVariable(rng, tyvarnm) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "undefined type variable '%s'." tyvarnm); + ] + + | UndefinedRowVariable(rng, rowvarnm) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "undefined row variable '%s'." rowvarnm); + ] + + | UndefinedKindName(rng, kdnm) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "undefined kind '%s'." kdnm); + ] + + | UndefinedModuleName(rng, modnm) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "undefined module '%s'." modnm); + ] + + | UndefinedSignatureName(rng, signm) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "undefined signature '%s'." signm); + ] + | UndefinedMacro(rng, csnm) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "undefined macro '%s'." csnm); + ] + + | InvalidNumberOfMacroArguments(rng, macparamtys) -> + report_error Typechecker (List.append [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine("invalid number of macro arguments; types expected on arguments are:"); + ] (macparamtys |> List.map (function + | LateMacroParameter(ty) -> DisplayLine(Printf.sprintf "* %s" (Display.show_mono_type ty)) + | EarlyMacroParameter(ty) -> DisplayLine(Printf.sprintf "* ~%s" (Display.show_mono_type ty)) + ))) + + | LateMacroArgumentExpected(rng, ty) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine("an early macro argument is given, but a late argument of type"); + DisplayLine(Display.show_mono_type ty); + NormalLine("is expected."); + ] + + | EarlyMacroArgumentExpected(rng, ty) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine("a late macro argument is given, but an early argument of type"); + DisplayLine(Display.show_mono_type ty); + NormalLine("is expected."); + ] + + | UnknownUnitOfLength(rng, unitnm) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "undefined unit of length '%s'." unitnm); + ] + + | InlineCommandInMath(rng) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine("an inline command is used as a math command."); + ] + + | MathCommandInInline(rng) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine("a math command is used as an inline command."); + ] + + | BreaksValueRestriction(rng) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine("this expression breaks the value restriction;"); + NormalLine("it should be a syntactic function."); + ] + + | MultiplePatternVariable(rng1, rng2, varnm) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s" (Range.to_string rng1)); + NormalLine(Printf.sprintf "and at %s:" (Range.to_string rng2)); + NormalLine(Printf.sprintf "pattern variable '%s' is bound more than once." varnm); + ] + + | LabelUsedMoreThanOnce(rng, label) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "'%s' is used more than once." label); + ] + + | InvalidExpressionAsToStaging(rng, stage) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine("invalid expression as to stage;"); + NormalLine(Printf.sprintf "should be used at %s." (string_of_stage stage)); + ] + + | InvalidOccurrenceAsToStaging(rng, varnm, stage) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "invalid occurrence of variable '%s' as to stage;" varnm); + NormalLine(Printf.sprintf "should be used at %s." (string_of_stage stage)); + ] + + | ApplicationOfNonFunction(rng, ty) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine("this expression has type"); + DisplayLine(Display.show_mono_type ty); + NormalLine("and thus it cannot be applied to arguments."); + ] + + + | MultiCharacterMathScriptWithoutBrace(rng) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine("more than one character is used as a math sub/superscript without braces;"); + NormalLine("use braces for making association explicit."); + ] + + | IllegalNumberOfTypeArguments(rng, tynm, lenexp, lenerr) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "'%s' is expected to have %d type argument(s)," tynm lenexp); + NormalLine(Printf.sprintf "but it has %d type argument(s) here." lenerr); + ] + + | TypeUnificationError(((rng1, _) as ty1), ((rng2, _) as ty2), ue) -> + let dispmap = + DisplayMap.empty + |> Display.collect_ids_mono ty1 + |> Display.collect_ids_mono ty2 + in + let strty1 = Display.show_mono_type_by_map dispmap ty1 in + let strty2 = Display.show_mono_type_by_map dispmap ty2 in + let strrng1 = Range.to_string rng1 in + let strrng2 = Range.to_string rng2 in + let (posmsg, strtyA, strtyB, additional) = + match (Range.is_dummy rng1, Range.is_dummy rng2) with + | (true, true) -> + (Printf.sprintf "(cannot report position; '%s', '%s')" (Range.message rng1) (Range.message rng2), + strty1, strty2, []) + + | (true, false) -> + (Printf.sprintf "at %s:" strrng2, strty2, strty1, []) + + | (false, true) -> + (Printf.sprintf "at %s:" strrng1, strty1, strty2, []) + + | (false, false) -> + (Printf.sprintf "at %s:" strrng1, strty1, strty2, + [ + NormalLine("This constraint is required by the expression"); + NormalLine(Printf.sprintf "at %s." strrng2); + ]) + in + let detail = make_unification_error_message dispmap ue in + report_error Typechecker (List.concat [ + [ + NormalLine(posmsg); + NormalLine("this expression has type"); + DisplayLine(Printf.sprintf "%s," strtyA); + NormalLine("but is expected of type"); + DisplayLine(Printf.sprintf "%s." strtyB); + ]; + detail; + additional; + ]) + + | RowUnificationError(rng, row1, row2, ue) -> + let dispmap = + DisplayMap.empty + |> Display.collect_ids_mono_row row1 + |> Display.collect_ids_mono_row row2 + in + let str_row1 = Display.show_mono_row_by_map dispmap row1 |> Option.value ~default:"" in + let str_row2 = Display.show_mono_row_by_map dispmap row2 |> Option.value ~default:"" in + let detail = make_unification_error_message dispmap ue in + report_error Typechecker (List.concat [ + [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine("the option row is"); + DisplayLine(str_row1); + NormalLine("and"); + DisplayLine(Printf.sprintf "%s," str_row2); + NormalLine("at the same time, but these are incompatible."); + ]; + detail; + ]) + + | TypeParameterBoundMoreThanOnce(rng, tyvarnm) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "type variable %s is bound more than once." tyvarnm); + ] + + | ConflictInSignature(rng, member) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "'%s' is declared more than once in a signature." member); + ] + + | NotAStructureSignature(rng, _fsig) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine("not a structure signature (TODO (enhance): detailed report)"); + ] + + | NotAFunctorSignature(rng, _ssig) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine("not a functor signature (TODO (enhance): detailed report)"); + ] + + | MissingRequiredValueName(rng, x, pty) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "missing required value '%s' of type" x); + DisplayLine(Display.show_poly_type pty); + ] + + | MissingRequiredMacroName(rng, csnm, pmacty) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "missing required macro '%s' of type" csnm); + DisplayLine(Display.show_poly_macro_type pmacty); + ] + + | MissingRequiredConstructorName(rng, ctornm, _centry) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "missing required constructor '%s' (TODO (enhance): detailed report)" ctornm); + ] + + | MissingRequiredTypeName(rng, tynm, arity) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "missing required type '%s' of arity %d" tynm arity); + ] + + | MissingRequiredModuleName(rng, modnm, _modsig) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "missing required module '%s' (TODO (enhance): detailed report)" modnm); + ] + + | MissingRequiredSignatureName(rng, signm, _absmodsig) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "missing required signature '%s' (TODO (enhance): detailed report)" signm); + ] + + | NotASubtypeAboutValue(rng, x, pty1, pty2) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "not a subtype about value '%s'; type" x); + DisplayLine(Display.show_poly_type pty1); + NormalLine("is not a subtype of"); + DisplayLine(Display.show_poly_type pty2); + ] + + | NotASubtypeAboutValueStage(rng, x, stage1, stage2) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "not a subtype about the stage of value '%s';" x); + DisplayLine(string_of_stage stage1); + NormalLine("is not consistent with"); + DisplayLine(string_of_stage stage2); + ] + + | NotASubtypeAboutMacro(rng, csnm, pmacty1, pmacty2) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "not a subtype about macro '%s'; type" csnm); + DisplayLine(Display.show_poly_macro_type pmacty1); + NormalLine("is not a subtype of"); + DisplayLine(Display.show_poly_macro_type pmacty2); + ] + + | NotASubtypeAboutConstructor(rng, ctornm, _tyscheme1, _tyscheme2) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "not a subtype about constructor '%s' (TODO (enhance): detailed report)" ctornm); + ] + + | NotASubtypeAboutType(rng, tynm, _tentry1, _tentry2) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "not a subtype about type '%s' (TODO (enhance): detailed report)" tynm); + ] + + | NotASubtypeSignature(rng, _modsig1, _modsig2) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine("not a subtype signature (TODO (enhance): detailed report)"); + ] + + | UnexpectedOptionalLabel(rng, label, ty_cmd) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "unexpected application of label '%s';" label); + NormalLine(Printf.sprintf "the command used here has type"); + DisplayLine(Display.show_mono_type ty_cmd); + ] + + | InvalidArityOfCommandApplication(rng, arity_expected, arity_actual) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "this command expects %d argument(s)," arity_expected); + NormalLine(Printf.sprintf "but is applied to %d argument(s) here." arity_actual); + ] + + | CannotRestrictTransparentType(rng, tynm) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "cannot restrict transparent type '%s'." tynm); + ] + + | KindContradiction(rng, tynm, kd_expected, kd_actual) -> + let Kind(bkds_expected) = kd_expected in + let Kind(bkds_actual) = kd_actual in + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "type '%s' expects %d type argument(s)," tynm (List.length bkds_expected)); + NormalLine(Printf.sprintf "but is applied to %d type argument(s)." (List.length bkds_actual)); + ] + + | CyclicSynonymTypeDefinition(cycle) -> + let pairs = + match cycle with + | Loop(pair) -> [ pair ] + | Cycle(pairs) -> pairs |> TupleList.to_list + in + let lines = + pairs |> List.map (fun (tynm, data) -> + let rng = data.SynonymDependencyGraph.position in + DisplayLine(Printf.sprintf "- '%s' (%s)" tynm (Range.to_string rng)) + ) + in + report_error Typechecker + (NormalLine("the following synonym types are cyclic:") :: lines) + + | MultipleSynonymTypeDefinition(tynm, rng1, rng2) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s" (Range.to_string rng1)); + NormalLine(Printf.sprintf "and %s:" (Range.to_string rng2)); + NormalLine(Printf.sprintf "synonym type '%s' is defined more than once." tynm); + ] + + let error_log_environment suspended = try suspended () @@ -363,69 +774,6 @@ let error_log_environment suspended = NormalLine("or specify configuration search paths with -C option."); ] - | OpenFileDependencyError(e) -> - begin - match e with - | CyclicFileDependency(cycle) -> - let pairs = - match cycle with - | Loop(pair) -> [ pair ] - | Cycle(pairs) -> pairs |> TupleList.to_list - in - report_error Interface ( - (NormalLine("cyclic dependency detected:")) :: - (pairs |> List.map (fun (abspath, _) -> DisplayLine(get_abs_path_string abspath))) - ) - - | CannotReadFileOwingToSystem(msg) -> - report_error Interface [ - NormalLine("cannot read file:"); - DisplayLine(msg); - ] - - | LibraryContainsWholeReturnValue(abspath) -> - let fname = get_abs_path_string abspath in - report_error Interface [ - NormalLine(Printf.sprintf "file '%s' is not a library; it has a return value." fname); - ] - - | DocumentLacksWholeReturnValue(abspath) -> - let fname = get_abs_path_string abspath in - report_error Interface [ - NormalLine(Printf.sprintf "file '%s' is not a document; it lacks a return value." fname); - ] - - | CannotUseHeaderUse(rng) -> - report_error Interface [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine("cannot specify 'use ...' here; use 'use ... of ...' instead."); - ] - - | FailedToParse(e) -> - begin - match e with - | CannotProgressParsing(rng) -> - report_error Parser [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - ] - - | IllegalItemDepth{ range = rng; before; current } -> - report_error Parser [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "illegal item depth %d after %d" before current); - ] - - | EmptyInputFile(rng) -> - report_error Parser [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine("empty input."); - ] - end - end - - | OpenPackageDependencyError(e) -> - failwith (Format.asprintf "TODO (error): %a" OpenPackageDependencyResolver.pp_error e) - | Config.PackageNotFound(package, pathcands) -> report_error Interface (List.append [ NormalLine("package file not found:"); @@ -605,423 +953,125 @@ let error_log_environment suspended = NormalLine(Printf.sprintf "missing required key '%s'." key); ] - | PackageCheckError(NotADocumentFile(abspath_in, ty)) -> - let fname = convert_abs_path_to_show abspath_in in - report_error Typechecker [ - NormalLine(Printf.sprintf "file '%s' is not a document file; it is of type" fname); - DisplayLine(Display.show_mono_type ty); - ] - - | PackageCheckError(NotAStringFile(abspath_in, ty)) -> - let fname = convert_abs_path_to_show abspath_in in - report_error Typechecker [ - NormalLine(Printf.sprintf "file '%s' is not a file for generating text; it is of type" fname); - DisplayLine(Display.show_mono_type ty); - ] - - | PackageCheckError(ClosedFileDependencyError(e)) -> - failwith (Format.asprintf "TODO (error): %a" ClosedFileDependencyResolver.pp_error e) - - | PackageCheckError(NoMainModule(_)) -> - failwith "TODO (error): NoMainModule" - - | PackageCheckError(UnknownPackageDependency(rng, modnm)) -> - failwith (Format.asprintf "TODO (error): %a %s" Range.pp rng modnm) - - | PackageCheckError(TypeError(tyerr)) -> + | ConfigError(e) -> begin - match tyerr with - | UndefinedVariable(rng, varnm, candidates) -> - let candidates_message_lines = - match make_candidates_message candidates with - | None -> [] - | Some(s) -> [ NormalLine(s) ] - in - report_error Typechecker (List.concat [ - [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "undefined variable '%s'." varnm); - ]; - candidates_message_lines; - ]) - - | UndefinedConstructor(rng, constrnm, candidates) -> - let candidates_message_lines = - match make_candidates_message candidates with - | None -> [] - | Some(s) -> [ NormalLine(s) ] - in - report_error Typechecker (List.concat [ - [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "undefined constructor '%s'." constrnm); - ]; - candidates_message_lines; - ]) - - | UndefinedTypeName(rng, tynm) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "undefined type '%s'." tynm); - ] - - | UndefinedTypeVariable(rng, tyvarnm) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "undefined type variable '%s'." tyvarnm); - ] - - | UndefinedRowVariable(rng, rowvarnm) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "undefined row variable '%s'." rowvarnm); - ] - - | UndefinedKindName(rng, kdnm) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "undefined kind '%s'." kdnm); - ] - - | UndefinedModuleName(rng, modnm) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "undefined module '%s'." modnm); - ] - - | UndefinedSignatureName(rng, signm) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "undefined signature '%s'." signm); - ] - | UndefinedMacro(rng, csnm) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "undefined macro '%s'." csnm); - ] - - | InvalidNumberOfMacroArguments(rng, macparamtys) -> - report_error Typechecker (List.append [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine("invalid number of macro arguments; types expected on arguments are:"); - ] (macparamtys |> List.map (function - | LateMacroParameter(ty) -> DisplayLine(Printf.sprintf "* %s" (Display.show_mono_type ty)) - | EarlyMacroParameter(ty) -> DisplayLine(Printf.sprintf "* ~%s" (Display.show_mono_type ty)) - ))) - - | LateMacroArgumentExpected(rng, ty) -> + match e with + | NotADocumentFile(abspath_in, ty) -> + let fname = convert_abs_path_to_show abspath_in in report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine("an early macro argument is given, but a late argument of type"); + NormalLine(Printf.sprintf "file '%s' is not a document file; it is of type" fname); DisplayLine(Display.show_mono_type ty); - NormalLine("is expected."); ] - | EarlyMacroArgumentExpected(rng, ty) -> + | NotAStringFile(abspath_in, ty) -> + let fname = convert_abs_path_to_show abspath_in in report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine("a late macro argument is given, but an early argument of type"); + NormalLine(Printf.sprintf "file '%s' is not a file for generating text; it is of type" fname); DisplayLine(Display.show_mono_type ty); - NormalLine("is expected."); ] - | UnknownUnitOfLength(rng, unitnm) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "undefined unit of length '%s'." unitnm); - ] - - | InlineCommandInMath(rng) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine("an inline command is used as a math command."); - ] - - | MathCommandInInline(rng) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine("a math command is used as an inline command."); - ] - - | BreaksValueRestriction(rng) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine("this expression breaks the value restriction;"); - NormalLine("it should be a syntactic function."); - ] - - | MultiplePatternVariable(rng1, rng2, varnm) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s" (Range.to_string rng1)); - NormalLine(Printf.sprintf "and at %s:" (Range.to_string rng2)); - NormalLine(Printf.sprintf "pattern variable '%s' is bound more than once." varnm); - ] - - | LabelUsedMoreThanOnce(rng, label) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "'%s' is used more than once." label); - ] - - | InvalidExpressionAsToStaging(rng, stage) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine("invalid expression as to stage;"); - NormalLine(Printf.sprintf "should be used at %s." (string_of_stage stage)); - ] - - | InvalidOccurrenceAsToStaging(rng, varnm, stage) -> - report_error Typechecker [ + | FileModuleNotFound(rng, modnm) -> + report_error Interface [ NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "invalid occurrence of variable '%s' as to stage;" varnm); - NormalLine(Printf.sprintf "should be used at %s." (string_of_stage stage)); + NormalLine(Printf.sprintf "cannot find a source file that defines module '%s'." modnm); ] - | ApplicationOfNonFunction(rng, ty) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine("this expression has type"); - DisplayLine(Display.show_mono_type ty); - NormalLine("and thus it cannot be applied to arguments."); + | NoMainModule(modnm) -> + report_error Interface [ + NormalLine(Printf.sprintf "no main module '%s'." modnm); ] - - | MultiCharacterMathScriptWithoutBrace(rng) -> - report_error Typechecker [ + | UnknownPackageDependency(rng, modnm) -> + report_error Interface [ NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine("more than one character is used as a math sub/superscript without braces;"); - NormalLine("use braces for making association explicit."); + NormalLine(Printf.sprintf "dependency on unknown package '%s'" modnm); ] - | IllegalNumberOfTypeArguments(rng, tynm, lenexp, lenerr) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "'%s' is expected to have %d type argument(s)," tynm lenexp); - NormalLine(Printf.sprintf "but it has %d type argument(s) here." lenerr); - ] + | TypeError(tyerr) -> + report_type_error tyerr - | TypeUnificationError(((rng1, _) as ty1), ((rng2, _) as ty2), ue) -> - let dispmap = - DisplayMap.empty - |> Display.collect_ids_mono ty1 - |> Display.collect_ids_mono ty2 - in - let strty1 = Display.show_mono_type_by_map dispmap ty1 in - let strty2 = Display.show_mono_type_by_map dispmap ty2 in - let strrng1 = Range.to_string rng1 in - let strrng2 = Range.to_string rng2 in - let (posmsg, strtyA, strtyB, additional) = - match (Range.is_dummy rng1, Range.is_dummy rng2) with - | (true, true) -> - (Printf.sprintf "(cannot report position; '%s', '%s')" (Range.message rng1) (Range.message rng2), - strty1, strty2, []) - - | (true, false) -> - (Printf.sprintf "at %s:" strrng2, strty2, strty1, []) - - | (false, true) -> - (Printf.sprintf "at %s:" strrng1, strty1, strty2, []) - - | (false, false) -> - (Printf.sprintf "at %s:" strrng1, strty1, strty2, - [ - NormalLine("This constraint is required by the expression"); - NormalLine(Printf.sprintf "at %s." strrng2); - ]) - in - let detail = make_unification_error_message dispmap ue in - report_error Typechecker (List.concat [ - [ - NormalLine(posmsg); - NormalLine("this expression has type"); - DisplayLine(Printf.sprintf "%s," strtyA); - NormalLine("but is expected of type"); - DisplayLine(Printf.sprintf "%s." strtyB); - ]; - detail; - additional; - ]) - - | RowUnificationError(rng, row1, row2, ue) -> - let dispmap = - DisplayMap.empty - |> Display.collect_ids_mono_row row1 - |> Display.collect_ids_mono_row row2 + | CyclicFileDependency(cycle) -> + let pairs = + match cycle with + | Loop(pair) -> [ pair ] + | Cycle(pairs) -> pairs |> TupleList.to_list in - let str_row1 = Display.show_mono_row_by_map dispmap row1 |> Option.value ~default:"" in - let str_row2 = Display.show_mono_row_by_map dispmap row2 |> Option.value ~default:"" in - let detail = make_unification_error_message dispmap ue in - report_error Typechecker (List.concat [ - [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine("the option row is"); - DisplayLine(str_row1); - NormalLine("and"); - DisplayLine(Printf.sprintf "%s," str_row2); - NormalLine("at the same time, but these are incompatible."); - ]; - detail; - ]) - - | TypeParameterBoundMoreThanOnce(rng, tyvarnm) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "type variable %s is bound more than once." tyvarnm); - ] - - | ConflictInSignature(rng, member) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "'%s' is declared more than once in a signature." member); - ] - - | NotAStructureSignature(rng, _fsig) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine("not a structure signature (TODO (enhance): detailed report)"); - ] - - | NotAFunctorSignature(rng, _ssig) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine("not a functor signature (TODO (enhance): detailed report)"); - ] - - | MissingRequiredValueName(rng, x, pty) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "missing required value '%s' of type" x); - DisplayLine(Display.show_poly_type pty); - ] - - | MissingRequiredMacroName(rng, csnm, pmacty) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "missing required macro '%s' of type" csnm); - DisplayLine(Display.show_poly_macro_type pmacty); - ] - - | MissingRequiredConstructorName(rng, ctornm, _centry) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "missing required constructor '%s' (TODO (enhance): detailed report)" ctornm); - ] - - | MissingRequiredTypeName(rng, tynm, arity) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "missing required type '%s' of arity %d" tynm arity); - ] - - | MissingRequiredModuleName(rng, modnm, _modsig) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "missing required module '%s' (TODO (enhance): detailed report)" modnm); - ] - - | MissingRequiredSignatureName(rng, signm, _absmodsig) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "missing required signature '%s' (TODO (enhance): detailed report)" signm); - ] + report_error Interface ( + (NormalLine("cyclic dependency detected:")) :: + (pairs |> List.map (fun (abspath, _) -> DisplayLine(get_abs_path_string abspath))) + ) - | NotASubtypeAboutValue(rng, x, pty1, pty2) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "not a subtype about value '%s'; type" x); - DisplayLine(Display.show_poly_type pty1); - NormalLine("is not a subtype of"); - DisplayLine(Display.show_poly_type pty2); + | CannotReadFileOwingToSystem(msg) -> + report_error Interface [ + NormalLine("cannot read file:"); + DisplayLine(msg); ] - | NotASubtypeAboutValueStage(rng, x, stage1, stage2) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "not a subtype about the stage of value '%s';" x); - DisplayLine(string_of_stage stage1); - NormalLine("is not consistent with"); - DisplayLine(string_of_stage stage2); + | LibraryContainsWholeReturnValue(abspath) -> + let fname = get_abs_path_string abspath in + report_error Interface [ + NormalLine(Printf.sprintf "file '%s' is not a library; it has a return value." fname); ] - | NotASubtypeAboutMacro(rng, csnm, pmacty1, pmacty2) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "not a subtype about macro '%s'; type" csnm); - DisplayLine(Display.show_poly_macro_type pmacty1); - NormalLine("is not a subtype of"); - DisplayLine(Display.show_poly_macro_type pmacty2); + | DocumentLacksWholeReturnValue(abspath) -> + let fname = get_abs_path_string abspath in + report_error Interface [ + NormalLine(Printf.sprintf "file '%s' is not a document; it lacks a return value." fname); ] - | NotASubtypeAboutConstructor(rng, ctornm, _tyscheme1, _tyscheme2) -> - report_error Typechecker [ + | CannotUseHeaderUse(rng) -> + report_error Interface [ NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "not a subtype about constructor '%s' (TODO (enhance): detailed report)" ctornm); + NormalLine("cannot specify 'use ...' here; use 'use ... of ...' instead."); ] - | NotASubtypeAboutType(rng, tynm, _tentry1, _tentry2) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "not a subtype about type '%s' (TODO (enhance): detailed report)" tynm); - ] + | FailedToParse(e) -> + report_parse_error e - | NotASubtypeSignature(rng, _modsig1, _modsig2) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine("not a subtype signature (TODO (enhance): detailed report)"); + | MainModuleNameMismatch{ expected; got } -> + report_error Interface [ + NormalLine(Printf.sprintf "main module name mismatch; expected '%s' but got '%s'." expected got); ] - | UnexpectedOptionalLabel(rng, label, ty_cmd) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "unexpected application of label '%s';" label); - NormalLine(Printf.sprintf "the command used here has type"); - DisplayLine(Display.show_mono_type ty_cmd); - ] + | PackageDirectoryNotFound(candidate_paths) -> + let lines = + candidate_paths |> List.map (fun path -> + DisplayLine(Printf.sprintf "- %s" path) + ) + in + report_error Interface + (NormalLine("cannot find package directory. candidates:") :: lines) - | InvalidArityOfCommandApplication(rng, arity_expected, arity_actual) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "this command expects %d argument(s)," arity_expected); - NormalLine(Printf.sprintf "but is applied to %d argument(s) here." arity_actual); + | PackageConfigNotFound(abspath) -> + report_error Interface [ + NormalLine("cannot find a package config at:"); + DisplayLine(get_abs_path_string abspath); ] - | CannotRestrictTransparentType(rng, tynm) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "cannot restrict transparent type '%s'." tynm); + | PackageConfigError(_) -> + report_error Interface [ + NormalLine("package config error (TODO: detailed reports)"); ] - | KindContradiction(rng, tynm, kd_expected, kd_actual) -> - let Kind(bkds_expected) = kd_expected in - let Kind(bkds_actual) = kd_actual in - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "type '%s' expects %d type argument(s)," tynm (List.length bkds_expected)); - NormalLine(Printf.sprintf "but is applied to %d type argument(s)." (List.length bkds_actual)); + | NotALibraryFile(abspath) -> + report_error Interface [ + NormalLine("the following file is expected to be a library file, but is not:"); + DisplayLine(get_abs_path_string abspath); ] - | CyclicSynonymTypeDefinition(cycle) -> + | CyclicPackageDependency(cycle) -> let pairs = match cycle with | Loop(pair) -> [ pair ] | Cycle(pairs) -> pairs |> TupleList.to_list in let lines = - pairs |> List.map (fun (tynm, data) -> - let rng = data.SynonymDependencyGraph.position in - DisplayLine(Printf.sprintf "- '%s' (%s)" tynm (Range.to_string rng)) + pairs |> List.map (fun (modnm, _package) -> + DisplayLine(Printf.sprintf "- '%s'" modnm) ) in - report_error Typechecker - (NormalLine("the following synonym types are cyclic:") :: lines) - - | MultipleSynonymTypeDefinition(tynm, rng1, rng2) -> - report_error Typechecker [ - NormalLine(Printf.sprintf "at %s" (Range.to_string rng1)); - NormalLine(Printf.sprintf "and %s:" (Range.to_string rng2)); - NormalLine(Printf.sprintf "synonym type '%s' is defined more than once." tynm); - ] - + report_error Interface + (NormalLine("the following packages are cyclic:") :: lines) end | Evaluator.EvalError(s) @@ -1167,14 +1217,14 @@ let build let (package_names, sorted_locals, utdoc_opt) = match OpenFileDependencyResolver.main ~extensions abspath_in with | Ok(triple) -> triple - | Error(e) -> raise (OpenFileDependencyError(e)) + | Error(e) -> raise (ConfigError(e)) in (* Resolve dependency among packages that the document depends on: *) let sorted_packages = match OpenPackageDependencyResolver.main ~extensions package_names with | Ok(sorted_packages) -> sorted_packages - | Error(e) -> raise (OpenPackageDependencyError(e)) + | Error(e) -> raise (ConfigError(e)) in (* Typecheck every package: *) @@ -1184,7 +1234,7 @@ let build let (ssig, libs) = match PackageChecker.main tyenv_prim genv package with | Ok(pair) -> pair - | Error(e) -> raise (PackageCheckError(e)) + | Error(e) -> raise (ConfigError(e)) in let genv = genv |> GlobalTypeenv.add main_module_name ssig in let libacc = Alist.append libacc libs in @@ -1201,7 +1251,7 @@ let build let (libs_local, ast_doc) = match PackageChecker.main_document tyenv_prim genv sorted_locals (abspath_in, utdoc) with | Ok(pair) -> pair - | Error(e) -> raise (PackageCheckError(e)) + | Error(e) -> raise (ConfigError(e)) in let libs = Alist.to_list (Alist.append libacc libs_local) in diff --git a/src/frontend/openFileDependencyResolver.ml b/src/frontend/openFileDependencyResolver.ml index 451ff8249..fa26ced38 100644 --- a/src/frontend/openFileDependencyResolver.ml +++ b/src/frontend/openFileDependencyResolver.ml @@ -1,17 +1,10 @@ open MyUtil open Types +open ConfigError -type error = - | CyclicFileDependency of (abs_path * untyped_library_file) cycle - | CannotReadFileOwingToSystem of string - | LibraryContainsWholeReturnValue of abs_path - | DocumentLacksWholeReturnValue of abs_path - | CannotUseHeaderUse of Range.t - | FailedToParse of parse_error - -type 'a ok = ('a, error) result +type 'a ok = ('a, config_error) result let has_library_extension (abspath : abs_path) : bool = diff --git a/src/frontend/openFileDependencyResolver.mli b/src/frontend/openFileDependencyResolver.mli index 61ad60e7b..be3410128 100644 --- a/src/frontend/openFileDependencyResolver.mli +++ b/src/frontend/openFileDependencyResolver.mli @@ -1,13 +1,6 @@ open MyUtil open Types +open ConfigError -type error = - | CyclicFileDependency of (abs_path * untyped_library_file) cycle - | CannotReadFileOwingToSystem of string - | LibraryContainsWholeReturnValue of abs_path - | DocumentLacksWholeReturnValue of abs_path - | CannotUseHeaderUse of Range.t - | FailedToParse of parse_error - -val main : extensions:(string list) -> abs_path -> (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file option, error) result +val main : extensions:(string list) -> abs_path -> (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file option, config_error) result diff --git a/src/frontend/openPackageDependencyResolver.ml b/src/frontend/openPackageDependencyResolver.ml index e8ff401a9..d50eb7b56 100644 --- a/src/frontend/openPackageDependencyResolver.ml +++ b/src/frontend/openPackageDependencyResolver.ml @@ -1,19 +1,10 @@ open MyUtil open Types +open ConfigError -type error = - | MainModuleNameMismatch of { - expected : module_name; - got : module_name; - } - | PackageDirectoryNotFound of string list - | PackageReadingError of PackageReader.error - | CyclicPackageDependency of (module_name * package_info) cycle -[@@deriving show { with_path = false }] - -type 'a ok = ('a, error) result +type 'a ok = ('a, config_error) result module PackageDependencyGraph = DependencyGraph.Make(String) @@ -42,10 +33,7 @@ let rec add_package (extensions : string list) (graph : graph) ~prev:(vertex_pre Config.resolve_package_directory main_module_name |> Result.map_error (fun cands -> PackageDirectoryNotFound(cands)) in - let* package = - PackageReader.main ~extensions absdir - |> Result.map_error (fun e -> PackageReadingError(e)) - in + let* package = PackageReader.main ~extensions absdir in if String.equal package.main_module_name main_module_name then let (graph, vertex) = match graph |> PackageDependencyGraph.add_vertex main_module_name package with diff --git a/src/frontend/openPackageDependencyResolver.mli b/src/frontend/openPackageDependencyResolver.mli index bfe1b121f..2fd704bbd 100644 --- a/src/frontend/openPackageDependencyResolver.mli +++ b/src/frontend/openPackageDependencyResolver.mli @@ -1,14 +1,5 @@ open Types +open ConfigError -type error = - | MainModuleNameMismatch of { - expected : module_name; - got : module_name; - } - | PackageDirectoryNotFound of string list - | PackageReadingError of PackageReader.error - | CyclicPackageDependency of (module_name * package_info) cycle -[@@deriving show] - -val main : extensions:(string list) -> PackageNameSet.t -> (package_info list, error) result +val main : extensions:(string list) -> PackageNameSet.t -> (package_info list, config_error) result diff --git a/src/frontend/packageChecker.ml b/src/frontend/packageChecker.ml index c7f46ad10..ea8033bf7 100644 --- a/src/frontend/packageChecker.ml +++ b/src/frontend/packageChecker.ml @@ -2,18 +2,9 @@ open MyUtil open Types open StaticEnv -open TypeError +open ConfigError - -type error = - | TypeError of type_error - | ClosedFileDependencyError of ClosedFileDependencyResolver.error - | NotADocumentFile of abs_path * mono_type - | NotAStringFile of abs_path * mono_type - | NoMainModule of module_name - | UnknownPackageDependency of Range.t * module_name - -type 'a ok = ('a, error) result +type 'a ok = ('a, config_error) result type dependency_kind = PackageDependency | LocalDependency @@ -88,9 +79,7 @@ let main (tyenv_prim : Typeenv.t) (genv : global_type_environment) (package : pa let utlibs = package.modules in (* Resolve dependency among the source files in the package: *) - let* sorted_utlibs = - ClosedFileDependencyResolver.main utlibs |> Result.map_error (fun e -> ClosedFileDependencyError(e)) - in + let* sorted_utlibs = ClosedFileDependencyResolver.main utlibs in (* Typecheck each source file: *) let* (_genv, libacc, ssig_opt) = diff --git a/src/frontend/packageChecker.mli b/src/frontend/packageChecker.mli new file mode 100644 index 000000000..fbcb15de4 --- /dev/null +++ b/src/frontend/packageChecker.mli @@ -0,0 +1,9 @@ + +open MyUtil +open Types +open StaticEnv +open ConfigError + +val main : type_environment -> global_type_environment -> package_info -> (struct_signature * (abs_path * binding list) list, config_error) result + +val main_document : type_environment -> global_type_environment -> (abs_path * untyped_library_file) list -> abs_path * untyped_document_file -> ((abs_path * binding list) list * abstract_tree, config_error) result diff --git a/src/frontend/packageReader.ml b/src/frontend/packageReader.ml index 4491f042a..44fe2b72e 100644 --- a/src/frontend/packageReader.ml +++ b/src/frontend/packageReader.ml @@ -1,15 +1,9 @@ open MyUtil open Types +open ConfigError -type error = - | PackageConfigNotFound of abs_path - | PackageConfigError of YamlDecoder.error - | FailedToParse of parse_error - | NotALibraryFile of abs_path -[@@deriving show { with_path = false }] - -type 'a ok = ('a, error) result +type 'a ok = ('a, config_error) result type relative_path = string diff --git a/src/frontend/packageReader.mli b/src/frontend/packageReader.mli index 47a4a5839..5274186dc 100644 --- a/src/frontend/packageReader.mli +++ b/src/frontend/packageReader.mli @@ -1,12 +1,6 @@ open MyUtil open Types +open ConfigError -type error = - | PackageConfigNotFound of abs_path - | PackageConfigError of YamlDecoder.error - | FailedToParse of parse_error - | NotALibraryFile of abs_path -[@@deriving show] - -val main : extensions:(string list) -> abs_path -> (package_info, error) result +val main : extensions:(string list) -> abs_path -> (package_info, config_error) result diff --git a/src/frontend/typeError.ml b/src/frontend/typeError.ml index 72c453ea6..8812df190 100644 --- a/src/frontend/typeError.ml +++ b/src/frontend/typeError.ml @@ -1,7 +1,6 @@ open Types open StaticEnv - open SyntaxBase From f24aa55e9e7d28497dda8394b7f837d76a5ad188 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 26 Oct 2022 03:00:52 +0900 Subject: [PATCH 037/288] fix the parser test --- test/parsing/parser_test.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/parsing/parser_test.ml b/test/parsing/parser_test.ml index 1d9a5442f..c7c2250f8 100644 --- a/test/parsing/parser_test.ml +++ b/test/parsing/parser_test.ml @@ -3,8 +3,8 @@ open Main__ let () = let proj s = function - | Error(rng) -> - Out_channel.fprintf stderr "%s: parse error: %s\n" s @@ Range.to_string rng; + | Error(e) -> + Out_channel.fprintf stderr "%s: parse error: %s\n" s @@ Types.show_parse_error e; exit 1 | Ok(utsrc) -> utsrc From 860cbbae8d68d5c40f9908fb52a10322a1506e4e Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 26 Oct 2022 04:03:10 +0900 Subject: [PATCH 038/288] refactor 'Config' etc. --- src/config.ml | 101 ++------------ src/config.mli | 16 +-- src/frontend/configError.ml | 5 + src/frontend/fontInfo.ml | 150 ++++++++++++--------- src/frontend/fontInfo.mli | 4 +- src/frontend/main.ml | 71 +++++----- src/frontend/openFileDependencyResolver.ml | 11 +- src/frontend/primitives.cppo.ml | 14 +- src/frontend/primitives.mli | 7 +- 9 files changed, 169 insertions(+), 210 deletions(-) diff --git a/src/config.ml b/src/config.ml index b0e3ee49a..a61adcc26 100644 --- a/src/config.ml +++ b/src/config.ml @@ -1,10 +1,6 @@ open MyUtil - -exception PackageNotFound of string * abs_path list -exception LibraryFileNotFound of lib_path * abs_path list -exception LibraryFilesNotFound of lib_path list * abs_path list -exception ImportedFileNotFound of string * abs_path list +open ConfigError let satysfi_root_dirs : (string list) ref = ref [] @@ -25,90 +21,20 @@ let resolve_directory fn = | Sys_error(_) -> None -(* -- - `resolve_lib_file` receives a file path relative to `LIBROOT` - and returns its corresponding absolute path. - -- *) -let resolve_lib_file_scheme (relpath : lib_path) : string option * string list = +(* Receives a file path relative to `LIBROOT` + and returns its corresponding absolute path. *) +let resolve_lib_file (relpath : lib_path) : (abs_path, config_error) result = let dirs = !satysfi_root_dirs in let relpathstr = get_lib_path_string relpath in let pathcands = dirs |> List.map (fun dir -> Filename.concat dir relpathstr) in - (first_some resolve pathcands, pathcands) - - -let resolve_lib_file_opt (relpath : lib_path) : abs_path option = - let (opt, _) = resolve_lib_file_scheme relpath in - opt |> Option.map make_abs_path - - -let resolve_lib_file_exn (relpath : lib_path) : abs_path = - let (opt, pathcands) = resolve_lib_file_scheme relpath in - match opt with - | None -> raise (LibraryFileNotFound(relpath, pathcands |> List.map make_abs_path)) - | Some(abspathstr) -> make_abs_path abspathstr - - -let resolve_lib_file_from_candidates_exn (relpaths : lib_path list) : abs_path = - let rec aux candacc = function - | [] -> - raise (LibraryFilesNotFound(relpaths, candacc |> Alist.to_list |> List.map make_abs_path)) - - | relpath :: tail -> - let (opt, pathcands) = resolve_lib_file_scheme relpath in - begin - match opt with - | Some(abspathstr) -> make_abs_path abspathstr - | None -> aux (Alist.append candacc pathcands) tail - end - in - aux Alist.empty relpaths - - -let resolve_package_res (relbasename : string) (extcands : string list) : (abs_path, abs_path list) result = - let withexts = - extcands |> List.map (fun extcand -> relbasename ^ extcand) - in - let dirs = !satysfi_root_dirs in - let pathcands = - dirs |> List.map (fun dir -> - withexts |> List.map (fun withext -> - Filename.concat dir withext - ) - ) |> List.concat - in - match MyUtil.first_some resolve pathcands with - | None -> Error(pathcands |> List.map make_abs_path) - | Some(p) -> Ok(make_abs_path p) - - -(* -- - `resolve_package_exn` receives - - - `package`: a package name (i.e. a relative path from `LIBROOT/local/packages` or `LIBROOT/dist/packages` without file extension) - - `extcands`: a list of candidates of the file extension (first match, i.e., earlier entry has the higher priority) - - and returns the absolute path of the package. - -- *) -let resolve_package_exn package extcands = - match resolve_package_res (Filename.concat "local/packages" package) extcands with - | Error(pathcands_local) -> - begin - match resolve_package_res (Filename.concat "dist/packages" package) extcands with - | Error(pathcands_dist) -> - let pathcands = List.append pathcands_local pathcands_dist in - raise (PackageNotFound(package, pathcands)) - - | Ok(fn_dist) -> - fn_dist - end - - | Ok(fn_local) -> - fn_local + match first_some resolve pathcands with + | Some(abspathstr) -> Ok(make_abs_path abspathstr) + | None -> Error(CannotFindLibraryFile(relpath, pathcands)) -let resolve_package_directory main_module_name = +let resolve_package_directory (main_module_name : string) = let open ResultMonad in let dirs = !satysfi_root_dirs in let pathcands_local = @@ -126,9 +52,10 @@ let resolve_package_directory main_module_name = | Some(p) -> return p -let resolve_local_exn dir s extcands = - let pathwithoutext = Filename.concat dir s in - let pathcands = extcands |> List.map (fun ext -> pathwithoutext ^ ext) in +let resolve_local ~(extensions : string list) ~origin:(dir : string) ~relative:(s : string) = + let open ResultMonad in + let path_without_ext = Filename.concat dir s in + let pathcands = extensions |> List.map (fun ext -> path_without_ext ^ ext) in match first_some resolve pathcands with - | None -> raise (ImportedFileNotFound(s, pathcands |> List.map make_abs_path)) - | Some(pathstr) -> make_abs_path pathstr + | None -> err @@ LocalFileNotFound{ relative = s; candidates = pathcands } + | Some(pathstr) -> return @@ make_abs_path pathstr diff --git a/src/config.mli b/src/config.mli index 57e81214f..7faef2d84 100644 --- a/src/config.mli +++ b/src/config.mli @@ -1,21 +1,11 @@ open MyUtil - -exception PackageNotFound of string * abs_path list -exception LibraryFileNotFound of lib_path * abs_path list -exception LibraryFilesNotFound of lib_path list * abs_path list -exception ImportedFileNotFound of string * abs_path list +open ConfigError val initialize : string list -> unit -val resolve_lib_file_opt : lib_path -> abs_path option - -val resolve_lib_file_exn : lib_path -> abs_path - -val resolve_lib_file_from_candidates_exn : lib_path list -> abs_path - -val resolve_package_exn : string -> string list -> abs_path +val resolve_lib_file : lib_path -> (abs_path, config_error) result val resolve_package_directory : string -> (abs_path, string list) result -val resolve_local_exn : string -> string -> string list -> abs_path +val resolve_local : extensions:(string list) -> origin:string -> relative:string -> (abs_path, config_error) result diff --git a/src/frontend/configError.ml b/src/frontend/configError.ml index 5ebe93f2a..9d5f81a5b 100644 --- a/src/frontend/configError.ml +++ b/src/frontend/configError.ml @@ -25,3 +25,8 @@ type config_error = | NotAStringFile of abs_path * mono_type | NoMainModule of module_name | UnknownPackageDependency of Range.t * module_name + | CannotFindLibraryFile of lib_path * string list + | LocalFileNotFound of { + relative : string; + candidates : string list; + } diff --git a/src/frontend/fontInfo.ml b/src/frontend/fontInfo.ml index 9084a7f15..8d4774e99 100644 --- a/src/frontend/fontInfo.ml +++ b/src/frontend/fontInfo.ml @@ -1,16 +1,17 @@ open MyUtil +open ConfigError open LengthInterface open HorzBox open CharBasis - exception InvalidFontAbbrev of font_abbrev exception InvalidMathFontAbbrev of math_font_abbrev exception NotASingleFont of font_abbrev * abs_path exception NotATTCElement of font_abbrev * abs_path * int exception NotASingleMathFont of math_font_abbrev * abs_path exception NotATTCMathFont of math_font_abbrev * abs_path * int +exception CannotFindFontFile of font_abbrev * config_error type tag = string @@ -96,34 +97,46 @@ end = struct dfn | UnusedSingle -> - (* -- if this is the first access to the single font -- *) - let abspath = Config.resolve_lib_file_exn relpath in + (* If this is the first access to the single font: *) begin - match FontFormat.get_decoder_single (abbrev ^ "-Composite") (* temporary *) abspath with - | None -> - (* -- if the font file is a TrueTypeCollection -- *) - raise (NotASingleFont(abbrev, abspath)) - - | Some((dcdr, font)) -> - let tag = generate_tag () in - let dfn = { font_tag = tag; font = font; decoder = dcdr; } in - storeref := Loaded(dfn); - dfn + match Config.resolve_lib_file relpath with + | Error(e) -> + raise (CannotFindFontFile(abbrev, e)) + + | Ok(abspath) -> + begin + match FontFormat.get_decoder_single (abbrev ^ "-Composite") (* temporary *) abspath with + | None -> + (* If the font file is a TrueType collection: *) + raise (NotASingleFont(abbrev, abspath)) + + | Some((dcdr, font)) -> + let tag = generate_tag () in + let dfn = { font_tag = tag; font = font; decoder = dcdr; } in + storeref := Loaded(dfn); + dfn + end end | UnusedTTC(i) -> - (* -- if this is the first access to the TrueTypeCollection -- *) - let srcpath = Config.resolve_lib_file_exn relpath in + (* If this is the first access to the TrueType collection: *) begin - match FontFormat.get_decoder_ttc (abbrev ^ "-Composite") (* temporary *) srcpath i with - | None -> - raise (NotATTCElement(abbrev, srcpath, i)) - - | Some((dcdr, font)) -> - let tag = generate_tag () in - let dfn = { font_tag = tag; font = font; decoder = dcdr; } in - storeref := Loaded(dfn); - dfn + match Config.resolve_lib_file relpath with + | Error(e) -> + raise (CannotFindFontFile(abbrev, e)) + + | Ok(abspath) -> + begin + match FontFormat.get_decoder_ttc (abbrev ^ "-Composite") (* temporary *) abspath i with + | None -> + raise (NotATTCElement(abbrev, abspath, i)) + + | Some((dcdr, font)) -> + let tag = generate_tag () in + let dfn = { font_tag = tag; font = font; decoder = dcdr; } in + storeref := Loaded(dfn); + dfn + end end end @@ -268,8 +281,8 @@ module MathFontAbbrevHashTable let fold f init = Ht.fold (fun mfabbrev (_, storeref) acc -> match !storeref with - | UnusedMathSingle -> acc (* -- ignores unused math fonts -- *) - | UnusedMathTTC(_) -> acc (* -- ignores unused math fonts -- *) + | UnusedMathSingle -> acc (* Ignores unused math fonts *) + | UnusedMathTTC(_) -> acc (* Ignores unused math fonts *) | LoadedMath(mfdfn) -> f mfabbrev mfdfn acc ) abbrev_to_definition_hash_table init @@ -283,35 +296,47 @@ module MathFontAbbrevHashTable begin match !storeref with | UnusedMathSingle -> - (* -- if this is the first access to the single math font -- *) - let srcpath = Config.resolve_lib_file_exn relpath in + (* If this is the first access to the single math font: *) begin - match FontFormat.get_math_decoder_single (mfabbrev ^ "-Composite-Math") (* temporary *) srcpath with - | None -> - (* -- if the font file does not have a MATH table or is a TrueType Collection -- *) - raise (NotASingleMathFont(mfabbrev, srcpath)) - - | Some((md, font)) -> - let tag = generate_tag () in - let mfdfn = { math_font_tag = tag; math_font = font; math_decoder = md; } in - storeref := LoadedMath(mfdfn); - mfdfn + match Config.resolve_lib_file relpath with + | Error(e) -> + raise (CannotFindFontFile(mfabbrev, e)) + + | Ok(abspath) -> + begin + match FontFormat.get_math_decoder_single (mfabbrev ^ "-Composite-Math") (* temporary *) abspath with + | None -> + (* If the font file does not have a MATH table or is a TrueType collection: *) + raise (NotASingleMathFont(mfabbrev, abspath)) + + | Some((md, font)) -> + let tag = generate_tag () in + let mfdfn = { math_font_tag = tag; math_font = font; math_decoder = md; } in + storeref := LoadedMath(mfdfn); + mfdfn + end end | UnusedMathTTC(i) -> (* -- if this is the first access to the collection math font -- *) - let srcpath = Config.resolve_lib_file_exn relpath in begin - match FontFormat.get_math_decoder_ttc (mfabbrev ^ "-Composite-Math") (* temporary *) srcpath i with - | None -> - (* -- if the font does not have a MATH table or is a single font file -- *) - raise (NotATTCMathFont(mfabbrev, srcpath, i)) - - | Some((md, font)) -> - let tag = generate_tag () in - let mfdfn = { math_font_tag = tag; math_font = font; math_decoder = md; } in - storeref := LoadedMath(mfdfn); - mfdfn + match Config.resolve_lib_file relpath with + | Error(e) -> + raise (CannotFindFontFile(mfabbrev, e)) + + | Ok(abspath) -> + begin + match FontFormat.get_math_decoder_ttc (mfabbrev ^ "-Composite-Math") (* temporary *) abspath i with + | None -> + (* If the font does not have a MATH table or is a single font file: *) + raise (NotATTCMathFont(mfabbrev, abspath, i)) + + | Some((md, font)) -> + let tag = generate_tag () in + let mfdfn = { math_font_tag = tag; math_font = font; math_decoder = md; } in + storeref := LoadedMath(mfdfn); + mfdfn + end end | LoadedMath(mfdfn) -> @@ -415,18 +440,21 @@ let get_font_dictionary (pdf : Pdf.t) : Pdf.pdfobject = let initialize () = + let open ResultMonad in FontAbbrevHashTable.initialize (); MathFontAbbrevHashTable.initialize (); - let abspath_S = Config.resolve_lib_file_exn (make_lib_path "dist/unidata/Scripts.txt") in - let abspath_EAW = Config.resolve_lib_file_exn (make_lib_path "dist/unidata/EastAsianWidth.txt") in + let* abspath_S = Config.resolve_lib_file (make_lib_path "dist/unidata/Scripts.txt") in + let* abspath_EAW = Config.resolve_lib_file (make_lib_path "dist/unidata/EastAsianWidth.txt") in ScriptDataMap.set_from_file abspath_S abspath_EAW; - LineBreakDataMap.set_from_file (Config.resolve_lib_file_exn (make_lib_path "dist/unidata/LineBreak.txt")); + let* abspath_LB = Config.resolve_lib_file (make_lib_path "dist/unidata/LineBreak.txt") in + LineBreakDataMap.set_from_file abspath_LB; let font_hash_local = - match Config.resolve_lib_file_opt (make_lib_path "local/hash/fonts.satysfi-hash") with - | None -> [] - | Some(abspath) -> LoadFont.main abspath + match Config.resolve_lib_file (make_lib_path "local/hash/fonts.satysfi-hash") with + | Error(_) -> [] + | Ok(abspath) -> LoadFont.main abspath in - let font_hash_dist = LoadFont.main (Config.resolve_lib_file_exn (make_lib_path "dist/hash/fonts.satysfi-hash")) in + let* abspath_fonts = Config.resolve_lib_file (make_lib_path "dist/hash/fonts.satysfi-hash") in + let font_hash_dist = LoadFont.main abspath_fonts in let font_hash = List.append font_hash_local font_hash_dist in if OptionState.does_show_fonts () then Logging.show_fonts font_hash; font_hash |> List.iter (fun (abbrev, data) -> @@ -435,11 +463,12 @@ let initialize () = | FontAccess.Collection(relpath, i) -> FontAbbrevHashTable.add_ttc abbrev relpath i ); let math_font_hash_local = - match Config.resolve_lib_file_opt (make_lib_path "local/hash/mathfonts.satysfi-hash") with - | None -> [] - | Some(abspath) -> LoadFont.main abspath + match Config.resolve_lib_file (make_lib_path "local/hash/mathfonts.satysfi-hash") with + | Error(_) -> [] + | Ok(abspath) -> LoadFont.main abspath in - let math_font_hash_dist = LoadFont.main (Config.resolve_lib_file_exn (make_lib_path "dist/hash/mathfonts.satysfi-hash")) in + let* abspath_mathfonts = Config.resolve_lib_file (make_lib_path "dist/hash/mathfonts.satysfi-hash") in + let math_font_hash_dist = LoadFont.main abspath_mathfonts in let math_font_hash = List.append math_font_hash_local math_font_hash_dist in if OptionState.does_show_fonts () then Logging.show_math_fonts math_font_hash; math_font_hash |> List.iter (fun (mfabbrev, data) -> @@ -447,3 +476,4 @@ let initialize () = | FontAccess.Single(srcpath) -> MathFontAbbrevHashTable.add_single mfabbrev srcpath | FontAccess.Collection(srcpath, i) -> MathFontAbbrevHashTable.add_ttc mfabbrev srcpath i ); + return () diff --git a/src/frontend/fontInfo.mli b/src/frontend/fontInfo.mli index dc4e9e568..96ff918ed 100644 --- a/src/frontend/fontInfo.mli +++ b/src/frontend/fontInfo.mli @@ -1,5 +1,6 @@ open MyUtil +open ConfigError open LengthInterface open HorzBox open CharBasis @@ -10,10 +11,11 @@ exception NotASingleFont of font_abbrev * abs_path exception NotATTCElement of font_abbrev * abs_path * int exception NotASingleMathFont of math_font_abbrev * abs_path exception NotATTCMathFont of math_font_abbrev * abs_path * int +exception CannotFindFontFile of font_abbrev * config_error type tag = string -val initialize : unit -> unit +val initialize : unit -> (unit, config_error) result val get_metrics_of_word : horz_string_info -> uchar_segment list -> OutputText.t * length * length * length diff --git a/src/frontend/main.ml b/src/frontend/main.ml index d7da5e905..41b781e5a 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -13,12 +13,14 @@ exception ConfigError of config_error (* Initialization that should be performed before every cross-reference-solving loop *) let reset () = + let open ResultMonad in if OptionState.is_text_mode () then - () + return () else begin - FontInfo.initialize (); + let* () = FontInfo.initialize () in ImageInfo.initialize (); NamedDest.initialize (); + return () end @@ -29,12 +31,17 @@ let initialize (abspath_dump : abs_path) : Typeenv.t * environment * bool = EvalVarID.initialize (); StoreID.initialize (); let dump_file_exists = CrossRef.initialize abspath_dump in - let (tyenv, env) = + let res = if OptionState.is_text_mode () then Primitives.make_text_mode_environments () else Primitives.make_pdf_mode_environments () in + let (tyenv, env) = + match res with + | Ok(pair) -> pair + | Error(e) -> raise (ConfigError(e)) + in begin if OptionState.is_bytecomp_mode () then Bytecomp.compile_environment env @@ -92,7 +99,12 @@ let eval_library_file (env : environment) (abspath : abs_path) (binds : binding let eval_main (i : int) (env_freezed : frozen_environment) (ast : abstract_tree) : syntactic_value = Logging.start_evaluation i; - reset (); + let res = reset () in + begin + match res with + | Ok(()) -> () + | Error(e) -> raise (ConfigError(e)) + end; let env = unfreeze_environment env_freezed in let value = if OptionState.is_bytecomp_mode () then @@ -774,35 +786,6 @@ let error_log_environment suspended = NormalLine("or specify configuration search paths with -C option."); ] - | Config.PackageNotFound(package, pathcands) -> - report_error Interface (List.append [ - NormalLine("package file not found:"); - DisplayLine(package); - NormalLine("candidate paths:"); - ] (pathcands |> List.map (fun abspath -> DisplayLine(get_abs_path_string abspath)))) - - | Config.LibraryFileNotFound(relpath, pathcands) -> - report_error Interface (List.append [ - NormalLine("library file not found:"); - DisplayLine(get_lib_path_string relpath); - NormalLine("candidate paths:"); - ] (pathcands |> List.map (fun abspath -> DisplayLine(get_abs_path_string abspath)))) - - | Config.LibraryFilesNotFound(relpaths, pathcands) -> - report_error Interface (List.concat [ - [ NormalLine("any of the following library file(s) not found:"); ]; - relpaths |> List.map (fun relpath -> DisplayLine(get_lib_path_string relpath)); - [ NormalLine("candidate paths:"); ]; - pathcands |> List.map (fun abspath -> DisplayLine(get_abs_path_string abspath)); - ]) - - | Config.ImportedFileNotFound(s, pathcands) -> - report_error Interface (List.append [ - NormalLine("imported file not found:"); - DisplayLine(s); - NormalLine("candidate paths:"); - ] (pathcands |> List.map (fun abspath -> DisplayLine(get_abs_path_string abspath)))) - | ShouldSpecifyOutputFile -> report_error Interface [ NormalLine("should specify output file for text mode."); @@ -876,6 +859,9 @@ let error_log_environment suspended = NormalLine("is not a TrueType collection or does not have a MATH table."); ] + | FontInfo.CannotFindFontFile(abbrev, _e) -> + failwith (Printf.sprintf "TODO: CannotFindFontFile, %s" abbrev) + | ImageHashTable.CannotLoadPdf(msg, abspath, pageno) -> let fname = convert_abs_path_to_show abspath in report_error Interface [ @@ -1072,6 +1058,25 @@ let error_log_environment suspended = in report_error Interface (NormalLine("the following packages are cyclic:") :: lines) + + | CannotFindLibraryFile(libpath, candidate_paths) -> + let lines = + candidate_paths |> List.map (fun path -> + DisplayLine(Printf.sprintf "- %s" path) + ) + in + report_error Interface + (NormalLine(Printf.sprintf "cannot find '%s'. candidates:" (get_lib_path_string libpath)) :: lines) + + | LocalFileNotFound{ relative; candidates } -> + let lines = + candidates |> List.map (fun path -> + DisplayLine(Printf.sprintf "- %s" path) + ) + in + report_error Interface + (NormalLine(Printf.sprintf "cannot find local file '%s'. candidates:" relative) :: lines) + end | Evaluator.EvalError(s) diff --git a/src/frontend/openFileDependencyResolver.ml b/src/frontend/openFileDependencyResolver.ml index fa26ced38..4ec800ae6 100644 --- a/src/frontend/openFileDependencyResolver.ml +++ b/src/frontend/openFileDependencyResolver.ml @@ -38,7 +38,7 @@ let get_header (extensions : string list) (curdir : string) (headerelem : header err @@ CannotUseHeaderUse(rng) | HeaderUseOf(modident, s_relpath) -> - let abspath = Config.resolve_local_exn curdir s_relpath extensions in + let* abspath = Config.resolve_local ~extensions ~origin:curdir ~relative:s_relpath in return @@ Local(modident, abspath) @@ -116,13 +116,8 @@ let register_document_file (extensions : string list) (abspath_in : abs_path) : let register_markdown_file (setting : string) (abspath_in : abs_path) : (PackageNameSet.t * untyped_document_file) ok = let open ResultMonad in Logging.begin_to_parse_file abspath_in; - let (cmdrcd, depends) = - let abspath = - Config.resolve_lib_file_exn (make_lib_path (Filename.concat "dist/md" (setting ^ ".satysfi-md"))) - (* TODO: error handling by `ResultMonad` *) - in - LoadMDSetting.main abspath - in + let* abspath = Config.resolve_lib_file (make_lib_path (Filename.concat "dist/md" (setting ^ ".satysfi-md"))) in + let (cmdrcd, depends) = LoadMDSetting.main abspath in (* TODO: make this monadic *) let* utast = match MyUtil.string_of_file abspath_in with | Ok(data) -> return (DecodeMD.decode cmdrcd data) diff --git a/src/frontend/primitives.cppo.ml b/src/frontend/primitives.cppo.ml index c6100a369..cf9fa4b3b 100644 --- a/src/frontend/primitives.cppo.ml +++ b/src/frontend/primitives.cppo.ml @@ -738,11 +738,15 @@ let make_environments table = let make_pdf_mode_environments () = - default_font_scheme_ref := SetDefaultFont.main (Config.resolve_lib_file_exn (make_lib_path "dist/hash/default-font.satysfi-hash")); - default_hyphen_dictionary := LoadHyph.main (Config.resolve_lib_file_exn (make_lib_path "dist/hyph/english.satysfi-hyph")); - (* temporary; should depend on the current language -- *) - make_environments pdf_mode_table + let open ResultMonad in + let* abspath_default_font = Config.resolve_lib_file (make_lib_path "dist/hash/default-font.satysfi-hash") in + let* abspath_hyphen = Config.resolve_lib_file (make_lib_path "dist/hyph/english.satysfi-hyph") in + default_font_scheme_ref := SetDefaultFont.main abspath_default_font; + default_hyphen_dictionary := LoadHyph.main abspath_hyphen; + (* TODO: should depend on the current language *) + return @@ make_environments pdf_mode_table let make_text_mode_environments () = - make_environments text_mode_table + let open ResultMonad in + return @@ make_environments text_mode_table diff --git a/src/frontend/primitives.mli b/src/frontend/primitives.mli index e817137d2..e49b54c5d 100644 --- a/src/frontend/primitives.mli +++ b/src/frontend/primitives.mli @@ -1,7 +1,8 @@ open Types -open LengthInterface open StaticEnv +open ConfigError +open LengthInterface val option_type : ('a, 'b) typ -> ('a, 'b) typ @@ -9,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 +val make_pdf_mode_environments : unit -> (Typeenv.t * environment, config_error) result -val make_text_mode_environments : unit -> Typeenv.t * environment +val make_text_mode_environments : unit -> (Typeenv.t * environment, config_error) result val default_radical : HorzBox.radical From bf709a4a7bb0ed1f9e71bf49b2fc12b6a2494ede Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 26 Oct 2022 04:49:58 +0900 Subject: [PATCH 039/288] refactor 'FontIfno' into monadic --- src/frontend/configError.ml | 10 + src/frontend/fontInfo.ml | 173 +++++++++--------- src/frontend/fontInfo.mli | 9 +- src/frontend/main.ml | 353 ++++++++++++++++++------------------ 4 files changed, 272 insertions(+), 273 deletions(-) diff --git a/src/frontend/configError.ml b/src/frontend/configError.ml index 9d5f81a5b..d2665437f 100644 --- a/src/frontend/configError.ml +++ b/src/frontend/configError.ml @@ -1,6 +1,7 @@ open MyUtil open Types +open HorzBox type config_error = @@ -30,3 +31,12 @@ type config_error = relative : string; candidates : string list; } + +type font_error = + | InvalidFontAbbrev of font_abbrev + | InvalidMathFontAbbrev of math_font_abbrev + | NotASingleFont of font_abbrev * abs_path + | NotATTCElement of font_abbrev * abs_path * int + | NotASingleMathFont of math_font_abbrev * abs_path + | NotATTCMathFont of math_font_abbrev * abs_path * int + | ConfigErrorAsToFont of config_error diff --git a/src/frontend/fontInfo.ml b/src/frontend/fontInfo.ml index 8d4774e99..0ab109383 100644 --- a/src/frontend/fontInfo.ml +++ b/src/frontend/fontInfo.ml @@ -5,13 +5,10 @@ open LengthInterface open HorzBox open CharBasis -exception InvalidFontAbbrev of font_abbrev -exception InvalidMathFontAbbrev of math_font_abbrev -exception NotASingleFont of font_abbrev * abs_path -exception NotATTCElement of font_abbrev * abs_path * int -exception NotASingleMathFont of math_font_abbrev * abs_path -exception NotATTCMathFont of math_font_abbrev * abs_path * int -exception CannotFindFontFile of font_abbrev * config_error + +exception FontInfoError of font_error + +type 'a ok = ('a, font_error) result type tag = string @@ -22,12 +19,16 @@ type font_definition = { } +let resolve_lib_file (relpath : lib_path) = + Config.resolve_lib_file relpath |> Result.map_error (fun e -> ConfigErrorAsToFont(e)) + + module FontAbbrevHashTable : sig val initialize : unit -> unit val add_single : font_abbrev -> lib_path -> unit val add_ttc : font_abbrev -> lib_path -> int -> unit val fold : (font_abbrev -> font_definition -> 'a -> 'a) -> 'a -> 'a - val find : font_abbrev -> font_definition + val find : font_abbrev -> font_definition ok end = struct type font_store = @@ -85,66 +86,61 @@ end = struct ) abbrev_to_definition_hash_table init - let find (abbrev : font_abbrev) : font_definition = + let find (abbrev : font_abbrev) : font_definition ok = + let open ResultMonad in match Ht.find_opt abbrev_to_definition_hash_table abbrev with | None -> - raise (InvalidFontAbbrev(abbrev)) + err @@ InvalidFontAbbrev(abbrev) | Some((relpath, storeref)) -> begin match !storeref with | Loaded(dfn) -> - dfn + return dfn | UnusedSingle -> (* If this is the first access to the single font: *) + let* abspath = resolve_lib_file relpath in begin - match Config.resolve_lib_file relpath with - | Error(e) -> - raise (CannotFindFontFile(abbrev, e)) - - | Ok(abspath) -> - begin - match FontFormat.get_decoder_single (abbrev ^ "-Composite") (* temporary *) abspath with - | None -> - (* If the font file is a TrueType collection: *) - raise (NotASingleFont(abbrev, abspath)) - - | Some((dcdr, font)) -> - let tag = generate_tag () in - let dfn = { font_tag = tag; font = font; decoder = dcdr; } in - storeref := Loaded(dfn); - dfn - end + match FontFormat.get_decoder_single (abbrev ^ "-Composite") (* temporary *) abspath with + | None -> + (* If the font file is a TrueType collection: *) + err @@ NotASingleFont(abbrev, abspath) + + | Some((dcdr, font)) -> + let tag = generate_tag () in + let dfn = { font_tag = tag; font = font; decoder = dcdr; } in + storeref := Loaded(dfn); + return dfn end | UnusedTTC(i) -> (* If this is the first access to the TrueType collection: *) + let* abspath = resolve_lib_file relpath in begin - match Config.resolve_lib_file relpath with - | Error(e) -> - raise (CannotFindFontFile(abbrev, e)) - - | Ok(abspath) -> - begin - match FontFormat.get_decoder_ttc (abbrev ^ "-Composite") (* temporary *) abspath i with - | None -> - raise (NotATTCElement(abbrev, abspath, i)) - - | Some((dcdr, font)) -> - let tag = generate_tag () in - let dfn = { font_tag = tag; font = font; decoder = dcdr; } in - storeref := Loaded(dfn); - dfn - end + match FontFormat.get_decoder_ttc (abbrev ^ "-Composite") (* temporary *) abspath i with + | None -> + err @@ NotATTCElement(abbrev, abspath, i) + + | Some((dcdr, font)) -> + let tag = generate_tag () in + let dfn = { font_tag = tag; font = font; decoder = dcdr; } in + storeref := Loaded(dfn); + return dfn end end end +let get_font_definition_exn (abbrev : font_abbrev) = + match FontAbbrevHashTable.find abbrev with + | Ok(dfn) -> dfn + | Error(e) -> raise (FontInfoError(e)) + + let get_font_tag (abbrev : font_abbrev) : tag = - let dfn = FontAbbrevHashTable.find abbrev in + let dfn = get_font_definition_exn abbrev in dfn.font_tag @@ -198,7 +194,7 @@ let get_glyph_id font_abbrev dcdr uch = let get_metrics_of_word (hsinfo : horz_string_info) (uchseglst : uchar_segment list) : OutputText.t * length * length * length = let font_abbrev = hsinfo.font_abbrev in let f_skip = raw_length_to_skip_length hsinfo.text_font_size in - let dfn = FontAbbrevHashTable.find font_abbrev in + let dfn = get_font_definition_exn font_abbrev in let dcdr = dfn.decoder in let gseglst = uchseglst |> List.map (fun (ubase, umarks) -> @@ -229,7 +225,7 @@ module MathFontAbbrevHashTable val add_single : math_font_abbrev -> lib_path -> unit val add_ttc : math_font_abbrev -> lib_path -> int -> unit val fold : (math_font_abbrev -> math_font_definition -> 'a -> 'a) -> 'a -> 'a - val find : math_font_abbrev -> math_font_definition + val find : math_font_abbrev -> math_font_definition ok end = struct @@ -287,72 +283,67 @@ module MathFontAbbrevHashTable ) abbrev_to_definition_hash_table init - let find (mfabbrev : math_font_abbrev) : math_font_definition = + let find (mfabbrev : math_font_abbrev) : math_font_definition ok = + let open ResultMonad in match Ht.find_opt abbrev_to_definition_hash_table mfabbrev with | None -> - raise (InvalidMathFontAbbrev(mfabbrev)) + err @@ InvalidMathFontAbbrev(mfabbrev) | Some((relpath, storeref)) -> begin match !storeref with | UnusedMathSingle -> (* If this is the first access to the single math font: *) + let* abspath = resolve_lib_file relpath in begin - match Config.resolve_lib_file relpath with - | Error(e) -> - raise (CannotFindFontFile(mfabbrev, e)) - - | Ok(abspath) -> - begin - match FontFormat.get_math_decoder_single (mfabbrev ^ "-Composite-Math") (* temporary *) abspath with - | None -> - (* If the font file does not have a MATH table or is a TrueType collection: *) - raise (NotASingleMathFont(mfabbrev, abspath)) - - | Some((md, font)) -> - let tag = generate_tag () in - let mfdfn = { math_font_tag = tag; math_font = font; math_decoder = md; } in - storeref := LoadedMath(mfdfn); - mfdfn - end + match FontFormat.get_math_decoder_single (mfabbrev ^ "-Composite-Math") (* temporary *) abspath with + | None -> + (* If the font file does not have a MATH table or is a TrueType collection: *) + err @@ NotASingleMathFont(mfabbrev, abspath) + + | Some((md, font)) -> + let tag = generate_tag () in + let mfdfn = { math_font_tag = tag; math_font = font; math_decoder = md; } in + storeref := LoadedMath(mfdfn); + return mfdfn end | UnusedMathTTC(i) -> - (* -- if this is the first access to the collection math font -- *) + (* If this is the first access to the collection math font: *) + let* abspath = resolve_lib_file relpath in begin - match Config.resolve_lib_file relpath with - | Error(e) -> - raise (CannotFindFontFile(mfabbrev, e)) - - | Ok(abspath) -> - begin - match FontFormat.get_math_decoder_ttc (mfabbrev ^ "-Composite-Math") (* temporary *) abspath i with - | None -> - (* If the font does not have a MATH table or is a single font file: *) - raise (NotATTCMathFont(mfabbrev, abspath, i)) - - | Some((md, font)) -> - let tag = generate_tag () in - let mfdfn = { math_font_tag = tag; math_font = font; math_decoder = md; } in - storeref := LoadedMath(mfdfn); - mfdfn - end + match FontFormat.get_math_decoder_ttc (mfabbrev ^ "-Composite-Math") (* temporary *) abspath i with + | None -> + (* If the font does not have a MATH table or is a single font file: *) + err @@ NotATTCMathFont(mfabbrev, abspath, i) + + | Some((md, font)) -> + let tag = generate_tag () in + let mfdfn = { math_font_tag = tag; math_font = font; math_decoder = md; } in + storeref := LoadedMath(mfdfn); + return mfdfn end | LoadedMath(mfdfn) -> - mfdfn + return mfdfn end end -let find_math_decoder_exn mfabbrev = - let mfdfn = MathFontAbbrevHashTable.find mfabbrev in +let find_math_font_definition_exn (mfabbrev : math_font_abbrev) = + match MathFontAbbrevHashTable.find mfabbrev with + | Ok(mfdfn) -> mfdfn + | Error(e) -> raise (FontInfoError(e)) + + +let find_math_decoder_exn (mfabbrev : math_font_abbrev) = + let mfdfn = find_math_font_definition_exn mfabbrev in mfdfn.math_decoder -let get_math_tag mfabbrev = - let mfdfn = MathFontAbbrevHashTable.find mfabbrev in +let get_math_tag (mfabbrev : math_font_abbrev) = + let mfdfn = find_math_font_definition_exn mfabbrev in mfdfn.math_font_tag @@ -362,13 +353,13 @@ let get_math_constants (mfabbrev : math_font_abbrev) : FontFormat.math_constants let get_math_kern_ratio (mfabbrev : math_font_abbrev) (mkern : FontFormat.math_kern) (r : float) : float = - let mfdfn = MathFontAbbrevHashTable.find mfabbrev in + let mfdfn = find_math_font_definition_exn mfabbrev in let md = mfdfn.math_decoder in FontFormat.find_kern_ratio md mkern r let get_math_char_info (mfabbrev : math_font_abbrev) ~(is_in_base_level : bool) ~(is_in_display : bool) ~(is_big : bool) ~(font_size : length) (uchlst : Uchar.t list) : OutputText.t * length * length * length * length * FontFormat.math_kern_info option = - let mfdfn = MathFontAbbrevHashTable.find mfabbrev in + let mfdfn = find_math_font_definition_exn mfabbrev in let md = mfdfn.math_decoder in let gidlst = uchlst |> List.map (fun uch -> diff --git a/src/frontend/fontInfo.mli b/src/frontend/fontInfo.mli index 96ff918ed..ecbb1e337 100644 --- a/src/frontend/fontInfo.mli +++ b/src/frontend/fontInfo.mli @@ -1,17 +1,10 @@ -open MyUtil open ConfigError open LengthInterface open HorzBox open CharBasis -exception InvalidFontAbbrev of font_abbrev -exception InvalidMathFontAbbrev of math_font_abbrev -exception NotASingleFont of font_abbrev * abs_path -exception NotATTCElement of font_abbrev * abs_path * int -exception NotASingleMathFont of math_font_abbrev * abs_path -exception NotATTCMathFont of math_font_abbrev * abs_path * int -exception CannotFindFontFile of font_abbrev * config_error +exception FontInfoError of font_error type tag = string diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 41b781e5a..12fd3883f 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -769,65 +769,155 @@ let report_type_error = function ] -let error_log_environment suspended = - try - suspended () - with - | RemainsToBeImplemented(msg) -> +let report_config_error = function + | NotADocumentFile(abspath_in, ty) -> + let fname = convert_abs_path_to_show abspath_in in + report_error Typechecker [ + NormalLine(Printf.sprintf "file '%s' is not a document file; it is of type" fname); + DisplayLine(Display.show_mono_type ty); + ] + + | NotAStringFile(abspath_in, ty) -> + let fname = convert_abs_path_to_show abspath_in in + report_error Typechecker [ + NormalLine(Printf.sprintf "file '%s' is not a file for generating text; it is of type" fname); + DisplayLine(Display.show_mono_type ty); + ] + + | FileModuleNotFound(rng, modnm) -> report_error Interface [ - NormalLine("remains to be supported:"); + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "cannot find a source file that defines module '%s'." modnm); + ] + + | NoMainModule(modnm) -> + report_error Interface [ + NormalLine(Printf.sprintf "no main module '%s'." modnm); + ] + + | UnknownPackageDependency(rng, modnm) -> + report_error Interface [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "dependency on unknown package '%s'" modnm); + ] + + | TypeError(tyerr) -> + report_type_error tyerr + + | CyclicFileDependency(cycle) -> + let pairs = + match cycle with + | Loop(pair) -> [ pair ] + | Cycle(pairs) -> pairs |> TupleList.to_list + in + report_error Interface ( + (NormalLine("cyclic dependency detected:")) :: + (pairs |> List.map (fun (abspath, _) -> DisplayLine(get_abs_path_string abspath))) + ) + + | CannotReadFileOwingToSystem(msg) -> + report_error Interface [ + NormalLine("cannot read file:"); DisplayLine(msg); ] - | NoLibraryRootDesignation -> + | LibraryContainsWholeReturnValue(abspath) -> + let fname = get_abs_path_string abspath in report_error Interface [ - NormalLine("cannot determine where the SATySFi library root is;"); - NormalLine("set appropriate environment variables"); - NormalLine("or specify configuration search paths with -C option."); + NormalLine(Printf.sprintf "file '%s' is not a library; it has a return value." fname); ] - | ShouldSpecifyOutputFile -> + | DocumentLacksWholeReturnValue(abspath) -> + let fname = get_abs_path_string abspath in report_error Interface [ - NormalLine("should specify output file for text mode."); + NormalLine(Printf.sprintf "file '%s' is not a document; it lacks a return value." fname); ] - | LoadHyph.InvalidPatternElement(rng) -> - report_error System [ + | CannotUseHeaderUse(rng) -> + report_error Interface [ NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine("invalid string for hyphenation pattern."); + NormalLine("cannot specify 'use ...' here; use 'use ... of ...' instead."); ] - | FontFormat.FailToLoadFontOwingToSystem(abspath, msg) -> - let fname = convert_abs_path_to_show abspath in + | FailedToParse(e) -> + report_parse_error e + + | MainModuleNameMismatch{ expected; got } -> report_error Interface [ - NormalLine(Printf.sprintf "cannot load font file '%s';" fname); - DisplayLine(msg); + NormalLine(Printf.sprintf "main module name mismatch; expected '%s' but got '%s'." expected got); ] - | FontFormat.BrokenFont(abspath, msg) -> - let fname = convert_abs_path_to_show abspath in + | PackageDirectoryNotFound(candidate_paths) -> + let lines = + candidate_paths |> List.map (fun path -> + DisplayLine(Printf.sprintf "- %s" path) + ) + in + report_error Interface + (NormalLine("cannot find package directory. candidates:") :: lines) + + | PackageConfigNotFound(abspath) -> report_error Interface [ - NormalLine(Printf.sprintf "font file '%s' is broken;" fname); - DisplayLine(msg); + NormalLine("cannot find a package config at:"); + DisplayLine(get_abs_path_string abspath); ] - | FontFormat.CannotFindUnicodeCmap(abspath) -> - let fname = convert_abs_path_to_show abspath in + | PackageConfigError(_) -> report_error Interface [ - NormalLine(Printf.sprintf "font file '%s' does not have 'cmap' subtable for Unicode code points." fname); + NormalLine("package config error (TODO: detailed reports)"); ] - | FontInfo.InvalidFontAbbrev(abbrev) -> + | NotALibraryFile(abspath) -> + report_error Interface [ + NormalLine("the following file is expected to be a library file, but is not:"); + DisplayLine(get_abs_path_string abspath); + ] + + | CyclicPackageDependency(cycle) -> + let pairs = + match cycle with + | Loop(pair) -> [ pair ] + | Cycle(pairs) -> pairs |> TupleList.to_list + in + let lines = + pairs |> List.map (fun (modnm, _package) -> + DisplayLine(Printf.sprintf "- '%s'" modnm) + ) + in + report_error Interface + (NormalLine("the following packages are cyclic:") :: lines) + + | CannotFindLibraryFile(libpath, candidate_paths) -> + let lines = + candidate_paths |> List.map (fun path -> + DisplayLine(Printf.sprintf "- %s" path) + ) + in + report_error Interface + (NormalLine(Printf.sprintf "cannot find '%s'. candidates:" (get_lib_path_string libpath)) :: lines) + + | LocalFileNotFound{ relative; candidates } -> + let lines = + candidates |> List.map (fun path -> + DisplayLine(Printf.sprintf "- %s" path) + ) + in + report_error Interface + (NormalLine(Printf.sprintf "cannot find local file '%s'. candidates:" relative) :: lines) + + +let report_font_error = function + | InvalidFontAbbrev(abbrev) -> report_error Interface [ NormalLine (Printf.sprintf "cannot find a font named '%s'." abbrev); ] - | FontInfo.InvalidMathFontAbbrev(mfabbrev) -> + | InvalidMathFontAbbrev(mfabbrev) -> report_error Interface [ NormalLine(Printf.sprintf "cannot find a math font named '%s'." mfabbrev); ] - | FontInfo.NotASingleFont(abbrev, abspath) -> + | NotASingleFont(abbrev, abspath) -> let fname = convert_abs_path_to_show abspath in report_error Interface [ NormalLine(Printf.sprintf "the font file '%s'," fname); @@ -835,7 +925,7 @@ let error_log_environment suspended = NormalLine("is not a single font file."); ] - | FontInfo.NotATTCElement(abbrev, abspath, i) -> + | NotATTCElement(abbrev, abspath, i) -> let fname = convert_abs_path_to_show abspath in report_error Interface [ NormalLine(Printf.sprintf "the font file '%s'," fname); @@ -843,7 +933,7 @@ let error_log_environment suspended = NormalLine("is not a TrueType collection."); ] - | FontInfo.NotASingleMathFont(mfabbrev, abspath) -> + | NotASingleMathFont(mfabbrev, abspath) -> let fname = convert_abs_path_to_show abspath in report_error Interface [ NormalLine(Printf.sprintf "the font file '%s'," fname); @@ -851,7 +941,7 @@ let error_log_environment suspended = NormalLine("is not a single font file or does not have a MATH table."); ] - | FontInfo.NotATTCMathFont(mfabbrev, abspath, i) -> + | NotATTCMathFont(mfabbrev, abspath, i) -> let fname = convert_abs_path_to_show abspath in report_error Interface [ NormalLine(Printf.sprintf "the font file '%s'," fname); @@ -859,8 +949,63 @@ let error_log_environment suspended = NormalLine("is not a TrueType collection or does not have a MATH table."); ] - | FontInfo.CannotFindFontFile(abbrev, _e) -> - failwith (Printf.sprintf "TODO: CannotFindFontFile, %s" abbrev) + | ConfigErrorAsToFont(e) -> + report_config_error e + + +let error_log_environment suspended = + try + suspended () + with + | RemainsToBeImplemented(msg) -> + report_error Interface [ + NormalLine("remains to be supported:"); + DisplayLine(msg); + ] + + | NoLibraryRootDesignation -> + report_error Interface [ + NormalLine("cannot determine where the SATySFi library root is;"); + NormalLine("set appropriate environment variables"); + NormalLine("or specify configuration search paths with -C option."); + ] + + | ShouldSpecifyOutputFile -> + report_error Interface [ + NormalLine("should specify output file for text mode."); + ] + + | LoadHyph.InvalidPatternElement(rng) -> + report_error System [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine("invalid string for hyphenation pattern."); + ] + + | ConfigError(e) -> + report_config_error e + + | FontInfo.FontInfoError(e) -> + report_font_error e + + | FontFormat.FailToLoadFontOwingToSystem(abspath, msg) -> + let fname = convert_abs_path_to_show abspath in + report_error Interface [ + NormalLine(Printf.sprintf "cannot load font file '%s';" fname); + DisplayLine(msg); + ] + + | FontFormat.BrokenFont(abspath, msg) -> + let fname = convert_abs_path_to_show abspath in + report_error Interface [ + NormalLine(Printf.sprintf "font file '%s' is broken;" fname); + DisplayLine(msg); + ] + + | FontFormat.CannotFindUnicodeCmap(abspath) -> + let fname = convert_abs_path_to_show abspath in + report_error Interface [ + NormalLine(Printf.sprintf "font file '%s' does not have 'cmap' subtable for Unicode code points." fname); + ] | ImageHashTable.CannotLoadPdf(msg, abspath, pageno) -> let fname = convert_abs_path_to_show abspath in @@ -939,146 +1084,6 @@ let error_log_environment suspended = NormalLine(Printf.sprintf "missing required key '%s'." key); ] - | ConfigError(e) -> - begin - match e with - | NotADocumentFile(abspath_in, ty) -> - let fname = convert_abs_path_to_show abspath_in in - report_error Typechecker [ - NormalLine(Printf.sprintf "file '%s' is not a document file; it is of type" fname); - DisplayLine(Display.show_mono_type ty); - ] - - | NotAStringFile(abspath_in, ty) -> - let fname = convert_abs_path_to_show abspath_in in - report_error Typechecker [ - NormalLine(Printf.sprintf "file '%s' is not a file for generating text; it is of type" fname); - DisplayLine(Display.show_mono_type ty); - ] - - | FileModuleNotFound(rng, modnm) -> - report_error Interface [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "cannot find a source file that defines module '%s'." modnm); - ] - - | NoMainModule(modnm) -> - report_error Interface [ - NormalLine(Printf.sprintf "no main module '%s'." modnm); - ] - - | UnknownPackageDependency(rng, modnm) -> - report_error Interface [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "dependency on unknown package '%s'" modnm); - ] - - | TypeError(tyerr) -> - report_type_error tyerr - - | CyclicFileDependency(cycle) -> - let pairs = - match cycle with - | Loop(pair) -> [ pair ] - | Cycle(pairs) -> pairs |> TupleList.to_list - in - report_error Interface ( - (NormalLine("cyclic dependency detected:")) :: - (pairs |> List.map (fun (abspath, _) -> DisplayLine(get_abs_path_string abspath))) - ) - - | CannotReadFileOwingToSystem(msg) -> - report_error Interface [ - NormalLine("cannot read file:"); - DisplayLine(msg); - ] - - | LibraryContainsWholeReturnValue(abspath) -> - let fname = get_abs_path_string abspath in - report_error Interface [ - NormalLine(Printf.sprintf "file '%s' is not a library; it has a return value." fname); - ] - - | DocumentLacksWholeReturnValue(abspath) -> - let fname = get_abs_path_string abspath in - report_error Interface [ - NormalLine(Printf.sprintf "file '%s' is not a document; it lacks a return value." fname); - ] - - | CannotUseHeaderUse(rng) -> - report_error Interface [ - NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine("cannot specify 'use ...' here; use 'use ... of ...' instead."); - ] - - | FailedToParse(e) -> - report_parse_error e - - | MainModuleNameMismatch{ expected; got } -> - report_error Interface [ - NormalLine(Printf.sprintf "main module name mismatch; expected '%s' but got '%s'." expected got); - ] - - | PackageDirectoryNotFound(candidate_paths) -> - let lines = - candidate_paths |> List.map (fun path -> - DisplayLine(Printf.sprintf "- %s" path) - ) - in - report_error Interface - (NormalLine("cannot find package directory. candidates:") :: lines) - - | PackageConfigNotFound(abspath) -> - report_error Interface [ - NormalLine("cannot find a package config at:"); - DisplayLine(get_abs_path_string abspath); - ] - - | PackageConfigError(_) -> - report_error Interface [ - NormalLine("package config error (TODO: detailed reports)"); - ] - - | NotALibraryFile(abspath) -> - report_error Interface [ - NormalLine("the following file is expected to be a library file, but is not:"); - DisplayLine(get_abs_path_string abspath); - ] - - | CyclicPackageDependency(cycle) -> - let pairs = - match cycle with - | Loop(pair) -> [ pair ] - | Cycle(pairs) -> pairs |> TupleList.to_list - in - let lines = - pairs |> List.map (fun (modnm, _package) -> - DisplayLine(Printf.sprintf "- '%s'" modnm) - ) - in - report_error Interface - (NormalLine("the following packages are cyclic:") :: lines) - - | CannotFindLibraryFile(libpath, candidate_paths) -> - let lines = - candidate_paths |> List.map (fun path -> - DisplayLine(Printf.sprintf "- %s" path) - ) - in - report_error Interface - (NormalLine(Printf.sprintf "cannot find '%s'. candidates:" (get_lib_path_string libpath)) :: lines) - - | LocalFileNotFound{ relative; candidates } -> - let lines = - candidates |> List.map (fun path -> - DisplayLine(Printf.sprintf "- %s" path) - ) - in - report_error Interface - (NormalLine(Printf.sprintf "cannot find local file '%s'. candidates:" relative) :: lines) - - end - | Evaluator.EvalError(s) | Vm.ExecError(s) -> report_error Evaluator [ NormalLine(s); ] From 74916c5c0a5c15cc9fc3cabd338d6176eaa64241 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 28 Oct 2022 03:24:38 +0900 Subject: [PATCH 040/288] separate 'PackageConfig' from 'PackageReader' --- src/frontend/packageConfig.ml | 52 ++++++++++++++++++++++++++++++++++ src/frontend/packageConfig.mli | 15 ++++++++++ src/frontend/packageReader.ml | 50 ++------------------------------ 3 files changed, 70 insertions(+), 47 deletions(-) create mode 100644 src/frontend/packageConfig.ml create mode 100644 src/frontend/packageConfig.mli diff --git a/src/frontend/packageConfig.ml b/src/frontend/packageConfig.ml new file mode 100644 index 000000000..84a1f05a6 --- /dev/null +++ b/src/frontend/packageConfig.ml @@ -0,0 +1,52 @@ + +open MyUtil +open Types +open ConfigError + + +type 'a ok = ('a, config_error) result + +type relative_path = string + +type t = + | Version_0_1 of { + main_module_name : module_name; + source_directories : relative_path list; + dependencies : module_name list; + } + + +let config_version_0_1_decoder = + let open YamlDecoder in + get "main_module" string >>= fun main_module_name -> + get "source_directories" (list string) >>= fun source_directories -> + get_or_else "dependencies" (list string) [] >>= fun dependencies -> + succeed @@ Version_0_1 { + main_module_name; + source_directories; + dependencies; + } + + +let config_decoder = + let open YamlDecoder in + get "language" string >>= fun language -> + match language with + | "v0.1.0" -> config_version_0_1_decoder + | _ -> failure (Printf.sprintf "unknown language version '%s'" language) + + +let load (absdir_package : abs_path) : t ok = + let open ResultMonad in + let abspath_config = + make_abs_path (Filename.concat (get_abs_path_string absdir_package) "satysfi.yaml") + in + let* inc = + try + return (open_in_abs abspath_config) + with + | Sys_error(_) -> err (PackageConfigNotFound(abspath_config)) + in + let s = Core.In_channel.input_all inc in + close_in inc; + YamlDecoder.run config_decoder s |> Result.map_error (fun e -> PackageConfigError(e)) diff --git a/src/frontend/packageConfig.mli b/src/frontend/packageConfig.mli new file mode 100644 index 000000000..ae123db29 --- /dev/null +++ b/src/frontend/packageConfig.mli @@ -0,0 +1,15 @@ + +open MyUtil +open Types +open ConfigError + +type relative_path = string + +type t = + | Version_0_1 of { + main_module_name : module_name; + source_directories : relative_path list; + dependencies : module_name list; + } + +val load : abs_path -> (t, config_error) result diff --git a/src/frontend/packageReader.ml b/src/frontend/packageReader.ml index 44fe2b72e..5997d1dce 100644 --- a/src/frontend/packageReader.ml +++ b/src/frontend/packageReader.ml @@ -3,52 +3,8 @@ open MyUtil open Types open ConfigError -type 'a ok = ('a, config_error) result - -type relative_path = string - -type config = - | Version_0_1 of { - main_module_name : module_name; - source_directories : relative_path list; - dependencies : module_name list; - } - - -let config_version_0_1_decoder = - let open YamlDecoder in - get "main_module" string >>= fun main_module_name -> - get "source_directories" (list string) >>= fun source_directories -> - get_or_else "dependencies" (list string) [] >>= fun dependencies -> - succeed @@ Version_0_1 { - main_module_name; - source_directories; - dependencies; - } - -let config_decoder = - let open YamlDecoder in - get "language" string >>= fun language -> - match language with - | "v0.1.0" -> config_version_0_1_decoder - | _ -> failure (Printf.sprintf "unknown language version '%s'" language) - - -let load_config (absdir_package : abs_path) : config ok = - let open ResultMonad in - let abspath_config = - make_abs_path (Filename.concat (get_abs_path_string absdir_package) "satysfi.yaml") - in - let* inc = - try - return (open_in_abs abspath_config) - with - | Sys_error(_) -> err (PackageConfigNotFound(abspath_config)) - in - let s = Core.In_channel.input_all inc in - close_in inc; - YamlDecoder.run config_decoder s |> Result.map_error (fun e -> PackageConfigError(e)) +type 'a ok = ('a, config_error) result let listup_sources_in_directory (extensions : string list) (absdir_src : abs_path) : abs_path list = @@ -63,10 +19,10 @@ let listup_sources_in_directory (extensions : string list) (absdir_src : abs_pat let main ~(extensions : string list) (absdir_package : abs_path) : package_info ok = let open ResultMonad in - let* config = load_config absdir_package in + let* config = PackageConfig.load absdir_package in let* package = match config with - | Version_0_1 { + | PackageConfig.Version_0_1 { main_module_name; source_directories; dependencies; From f353f0d431557732a25151bdc839288a6cb875e2 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 30 Oct 2022 01:32:40 +0900 Subject: [PATCH 041/288] begin to develop lock files --- src/frontend/closedLockDependencyResolver.ml | 11 +++ src/frontend/configError.ml | 2 +- src/frontend/lockConfig.ml | 16 ++++ src/frontend/logging.ml | 4 + src/frontend/main.ml | 20 +++-- src/frontend/openPackageDependencyResolver.ml | 3 +- .../openPackageDependencyResolver.mli | 3 +- src/frontend/packageChecker.ml | 2 +- src/frontend/packageChecker.mli | 2 +- src/frontend/packageConfig.ml | 77 +++++++++++++++---- src/frontend/packageConfig.mli | 21 ++++- src/frontend/packageReader.ml | 12 +-- src/frontend/packageReader.mli | 2 +- src/frontend/types.cppo.ml | 12 ++- 14 files changed, 153 insertions(+), 34 deletions(-) create mode 100644 src/frontend/closedLockDependencyResolver.ml create mode 100644 src/frontend/lockConfig.ml diff --git a/src/frontend/closedLockDependencyResolver.ml b/src/frontend/closedLockDependencyResolver.ml new file mode 100644 index 000000000..e47d0ae43 --- /dev/null +++ b/src/frontend/closedLockDependencyResolver.ml @@ -0,0 +1,11 @@ + +open MyUtil +open Types +open ConfigError + + +type 'a ok = ('a, config_error) result + +let main ~extensions:(_ : string list) (_lock_config : LockConfig.t) : (untyped_package list) ok = + let open ResultMonad in + return [] (* TODO: implement this *) diff --git a/src/frontend/configError.ml b/src/frontend/configError.ml index d2665437f..18f5b23a8 100644 --- a/src/frontend/configError.ml +++ b/src/frontend/configError.ml @@ -19,7 +19,7 @@ type config_error = | PackageConfigNotFound of abs_path | PackageConfigError of YamlDecoder.error | NotALibraryFile of abs_path - | CyclicPackageDependency of (module_name * package_info) cycle + | CyclicLockDependency of (module_name * lock_info) cycle | TypeError of TypeError.type_error | FileModuleNotFound of Range.t * module_name | NotADocumentFile of abs_path * mono_type diff --git a/src/frontend/lockConfig.ml b/src/frontend/lockConfig.ml new file mode 100644 index 000000000..56ce2d2c2 --- /dev/null +++ b/src/frontend/lockConfig.ml @@ -0,0 +1,16 @@ + +open MyUtil +open Types +open ConfigError + + +type 'a ok = ('a, config_error) result + +type t = { + required_language_version : string; + locked_packages : lock_info list; +} + + +let load (_abspath_lock_config : abs_path) : t ok = + failwith "TODO: LockConfig" diff --git a/src/frontend/logging.ml b/src/frontend/logging.ml index 3db45340f..afd27006d 100644 --- a/src/frontend/logging.ml +++ b/src/frontend/logging.ml @@ -100,6 +100,10 @@ let dump_file dump_file_exists dump_file = print_endline (" dump file: '" ^ (show_path dump_file) ^ "' (will be created)") +let lock_config_file (abspath_lock_config : abs_path) = + Printf.printf " lock file: '%s'\n" (show_path abspath_lock_config) + + let begin_to_embed_fonts () = print_endline (" ---- ---- ---- ----"); print_endline (" embedding fonts ...") diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 12fd3883f..ce07dc1f4 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -873,14 +873,14 @@ let report_config_error = function DisplayLine(get_abs_path_string abspath); ] - | CyclicPackageDependency(cycle) -> + | CyclicLockDependency(cycle) -> let pairs = match cycle with | Loop(pair) -> [ pair ] | Cycle(pairs) -> pairs |> TupleList.to_list in let lines = - pairs |> List.map (fun (modnm, _package) -> + pairs |> List.map (fun (modnm, _lock) -> DisplayLine(Printf.sprintf "- '%s'" modnm) ) in @@ -1210,7 +1210,15 @@ let build try Filename.chop_extension abspathstr_in with | Invalid_argument(_) -> abspathstr_in in - let abspath_dump = make_abs_path (Printf.sprintf "%s.satysfi-aux" basename_without_extension) in + + let abspath_lock_config = make_abs_path (Printf.sprintf "%s.satysfi-lock" basename_without_extension) in + Logging.lock_config_file abspath_lock_config; + let lock_config = + match LockConfig.load abspath_lock_config with + | Ok(lock_config) -> lock_config + | Error(e) -> raise (ConfigError(e)) + in + let abspath_out = match (output_mode, output_file) with | (_, Some(abspath_out)) -> abspath_out @@ -1218,13 +1226,15 @@ let build | (PdfMode, None) -> make_abs_path (Printf.sprintf "%s.pdf" basename_without_extension) in Logging.target_file abspath_out; + + let abspath_dump = make_abs_path (Printf.sprintf "%s.satysfi-aux" basename_without_extension) in let (tyenv_prim, env, dump_file_exists) = initialize abspath_dump in Logging.dump_file dump_file_exists abspath_dump; let extensions = get_candidate_file_extensions () in (* Resolve dependency of the document and the local source files: *) - let (package_names, sorted_locals, utdoc_opt) = + let (_dep_main_module_names, sorted_locals, utdoc_opt) = match OpenFileDependencyResolver.main ~extensions abspath_in with | Ok(triple) -> triple | Error(e) -> raise (ConfigError(e)) @@ -1232,7 +1242,7 @@ let build (* Resolve dependency among packages that the document depends on: *) let sorted_packages = - match OpenPackageDependencyResolver.main ~extensions package_names with + match ClosedLockDependencyResolver.main ~extensions lock_config with | Ok(sorted_packages) -> sorted_packages | Error(e) -> raise (ConfigError(e)) in diff --git a/src/frontend/openPackageDependencyResolver.ml b/src/frontend/openPackageDependencyResolver.ml index d50eb7b56..58b9d75c8 100644 --- a/src/frontend/openPackageDependencyResolver.ml +++ b/src/frontend/openPackageDependencyResolver.ml @@ -1,4 +1,4 @@ - +(* open MyUtil open Types open ConfigError @@ -68,3 +68,4 @@ let main ~(extensions : string list) (package_name_set_init : PackageNameSet.t) |> Result.map_error (fun cycle -> CyclicPackageDependency(cycle)) in return (pairs |> List.map (fun (_, package) -> package)) +*) diff --git a/src/frontend/openPackageDependencyResolver.mli b/src/frontend/openPackageDependencyResolver.mli index 2fd704bbd..1323eca09 100644 --- a/src/frontend/openPackageDependencyResolver.mli +++ b/src/frontend/openPackageDependencyResolver.mli @@ -1,5 +1,6 @@ - +(* open Types open ConfigError val main : extensions:(string list) -> PackageNameSet.t -> (package_info list, config_error) result +*) diff --git a/src/frontend/packageChecker.ml b/src/frontend/packageChecker.ml index ea8033bf7..927b76749 100644 --- a/src/frontend/packageChecker.ml +++ b/src/frontend/packageChecker.ml @@ -73,7 +73,7 @@ let typecheck_document_file (tyenv : Typeenv.t) (abspath_in : abs_path) (utast : err (NotADocumentFile(abspath_in, ty)) -let main (tyenv_prim : Typeenv.t) (genv : global_type_environment) (package : package_info) : (StructSig.t * (abs_path * binding list) list) ok = +let main (tyenv_prim : Typeenv.t) (genv : global_type_environment) (package : untyped_package) : (StructSig.t * (abs_path * binding list) list) ok = let open ResultMonad in let main_module_name = package.main_module_name in let utlibs = package.modules in diff --git a/src/frontend/packageChecker.mli b/src/frontend/packageChecker.mli index fbcb15de4..f9d966cef 100644 --- a/src/frontend/packageChecker.mli +++ b/src/frontend/packageChecker.mli @@ -4,6 +4,6 @@ open Types open StaticEnv open ConfigError -val main : type_environment -> global_type_environment -> package_info -> (struct_signature * (abs_path * binding list) list, config_error) result +val main : type_environment -> global_type_environment -> untyped_package -> (struct_signature * (abs_path * binding list) list, config_error) result val main_document : type_environment -> global_type_environment -> (abs_path * untyped_library_file) list -> abs_path * untyped_document_file -> ((abs_path * binding list) list * abstract_tree, config_error) result diff --git a/src/frontend/packageConfig.ml b/src/frontend/packageConfig.ml index 84a1f05a6..e7fc7efdd 100644 --- a/src/frontend/packageConfig.ml +++ b/src/frontend/packageConfig.ml @@ -8,23 +8,74 @@ type 'a ok = ('a, config_error) result type relative_path = string -type t = - | Version_0_1 of { +type dependency_spec = { + depended_package_name : string; + version_constraints : unit; (* TODO: define this *) +} + +type package_contents = + | Library of { main_module_name : module_name; source_directories : relative_path list; - dependencies : module_name list; + dependencies : dependency_spec list; + } + | Document of { + document_file : relative_path; + dependencies : dependency_spec list; } +type t = { + package_name : string; + package_version : string; + package_contents : package_contents; +} + + +let dependency_decoder : dependency_spec YamlDecoder.t = + let open YamlDecoder in + get "package_name" string >>= fun depended_package_name -> + succeed { + depended_package_name; + version_constraints = (); + } + + +let contents_decoder : package_contents YamlDecoder.t = + let open YamlDecoder in + branch "type" [ + "library" ==> begin + get "main_module" string >>= fun main_module_name -> + get "source_directories" (list string) >>= fun source_directories -> + get_or_else "dependencies" (list dependency_decoder) [] >>= fun dependencies -> + succeed @@ Library { + main_module_name; + source_directories; + dependencies; + } + end; + "document" ==> begin + get "file" string >>= fun document_file -> + get_or_else "dependencies" (list dependency_decoder) [] >>= fun dependencies -> + succeed @@ Document { + document_file; + dependencies; + } + end; + ] + ~on_error:(fun other -> + Printf.sprintf "unsupported type '%s' for specifying package contents" other + ) + -let config_version_0_1_decoder = +let config_decoder : t YamlDecoder.t = let open YamlDecoder in - get "main_module" string >>= fun main_module_name -> - get "source_directories" (list string) >>= fun source_directories -> - get_or_else "dependencies" (list string) [] >>= fun dependencies -> - succeed @@ Version_0_1 { - main_module_name; - source_directories; - dependencies; + get "package_name" string >>= fun package_name -> + get "version" string >>= fun package_version -> + get "contents" contents_decoder >>= fun package_contents -> + succeed @@ { + package_name; + package_version; + package_contents; } @@ -32,8 +83,8 @@ let config_decoder = let open YamlDecoder in get "language" string >>= fun language -> match language with - | "v0.1.0" -> config_version_0_1_decoder - | _ -> failure (Printf.sprintf "unknown language version '%s'" language) + | "0.1.0" -> config_decoder + | _ -> failure (Printf.sprintf "unknown language version '%s'" language) let load (absdir_package : abs_path) : t ok = diff --git a/src/frontend/packageConfig.mli b/src/frontend/packageConfig.mli index ae123db29..d23289521 100644 --- a/src/frontend/packageConfig.mli +++ b/src/frontend/packageConfig.mli @@ -5,11 +5,26 @@ open ConfigError type relative_path = string -type t = - | Version_0_1 of { +type dependency_spec = { + depended_package_name : string; + version_constraints : unit; (* TODO: define this *) +} + +type package_contents = + | Library of { main_module_name : module_name; source_directories : relative_path list; - dependencies : module_name list; + dependencies : dependency_spec list; + } + | Document of { + document_file : relative_path; + dependencies : dependency_spec list; } +type t = { + package_name : string; + package_version : string; + package_contents : package_contents; +} + val load : abs_path -> (t, config_error) result diff --git a/src/frontend/packageReader.ml b/src/frontend/packageReader.ml index 5997d1dce..f93a4b4a5 100644 --- a/src/frontend/packageReader.ml +++ b/src/frontend/packageReader.ml @@ -17,15 +17,18 @@ let listup_sources_in_directory (extensions : string list) (absdir_src : abs_pat ) -let main ~(extensions : string list) (absdir_package : abs_path) : package_info ok = +let main ~(extensions : string list) (absdir_package : abs_path) : untyped_package ok = let open ResultMonad in let* config = PackageConfig.load absdir_package in let* package = - match config with - | PackageConfig.Version_0_1 { + match config.package_contents with + | PackageConfig.Document(_) -> + failwith "TODO: PackageConfig.Document" + + | PackageConfig.Library { main_module_name; source_directories; - dependencies; + dependencies = _; } -> let absdirs_src = source_directories |> List.map (fun source_directory -> @@ -52,7 +55,6 @@ let main ~(extensions : string list) (absdir_package : abs_path) : package_info return { main_module_name; modules; - dependencies; } in return package diff --git a/src/frontend/packageReader.mli b/src/frontend/packageReader.mli index 5274186dc..78cdc3be3 100644 --- a/src/frontend/packageReader.mli +++ b/src/frontend/packageReader.mli @@ -3,4 +3,4 @@ open MyUtil open Types open ConfigError -val main : extensions:(string list) -> abs_path -> (package_info, config_error) result +val main : extensions:(string list) -> abs_path -> (untyped_package, config_error) result diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index 7609b748e..61b14eb37 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -40,6 +40,7 @@ type type_variable_name = string [@@deriving show] type row_variable_name = string [@@deriving show] type label = string [@@deriving show] +type lock_name = string [@@deriving show] type input_position = { input_file_name : string; @@ -577,13 +578,20 @@ type untyped_source_file = | UTDocumentFile of untyped_document_file [@@deriving show { with_path = false; }] -type package_info = { - dependencies : module_name list; +type untyped_package = { main_module_name : module_name; modules : (abs_path * untyped_library_file) list; } [@@deriving show { with_path = false }] +type lock_info = { + lock_name : lock_name; + lock_main_module_name : module_name; + lock_dependencies : lock_name list; + lock_directory : abs_path; +} +[@@deriving show { with_path = false }] + type untyped_letrec_pattern_branch = | UTLetRecPatternBranch of untyped_pattern_tree list * untyped_abstract_tree From 40429364cdcc03983daddc4f5ca780d70040cb58 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 30 Oct 2022 02:17:02 +0900 Subject: [PATCH 042/288] develop 'LockConfig' --- src/frontend/configError.ml | 2 ++ src/frontend/lockConfig.ml | 51 ++++++++++++++++++++++++++++++++++--- src/frontend/main.ml | 11 ++++++++ src/frontend/types.cppo.ml | 7 +++-- 4 files changed, 63 insertions(+), 8 deletions(-) diff --git a/src/frontend/configError.ml b/src/frontend/configError.ml index 18f5b23a8..a56c27cbe 100644 --- a/src/frontend/configError.ml +++ b/src/frontend/configError.ml @@ -18,6 +18,8 @@ type config_error = | PackageDirectoryNotFound of string list | PackageConfigNotFound of abs_path | PackageConfigError of YamlDecoder.error + | LockConfigNotFound of abs_path + | LockConfigError of YamlDecoder.error | NotALibraryFile of abs_path | CyclicLockDependency of (module_name * lock_info) cycle | TypeError of TypeError.type_error diff --git a/src/frontend/lockConfig.ml b/src/frontend/lockConfig.ml index 56ce2d2c2..3ba691321 100644 --- a/src/frontend/lockConfig.ml +++ b/src/frontend/lockConfig.ml @@ -7,10 +7,53 @@ open ConfigError type 'a ok = ('a, config_error) result type t = { - required_language_version : string; - locked_packages : lock_info list; + locked_packages : lock_info list; } -let load (_abspath_lock_config : abs_path) : t ok = - failwith "TODO: LockConfig" +let lock_location_decoder : abs_path YamlDecoder.t = + let open YamlDecoder in + branch "type" [ + "global" ==> begin + get "path" string >>= fun s_libpath -> + match Config.resolve_lib_file (make_lib_path s_libpath) with + | Ok(abspath) -> succeed abspath + | Error(_e) -> failwith "TODO (error): not found" + end; + ] + ~on_error:(fun other -> + Printf.sprintf "unknown type '%s' for lock locations" other + ) + + +let lock_decoder : lock_info YamlDecoder.t = + let open YamlDecoder in + get "name" string >>= fun lock_name -> + get "location" lock_location_decoder >>= fun lock_directory -> + get_or_else "dependencies" (list string) [] >>= fun lock_dependencies -> + succeed { + lock_name; + lock_directory; + lock_dependencies; + } + + +let lock_config_decoder : t YamlDecoder.t = + let open YamlDecoder in + get_or_else "locks" (list lock_decoder) [] >>= fun locked_packages -> + succeed { + locked_packages; + } + + +let load (abspath_lock_config : abs_path) : t ok = + let open ResultMonad in + let* inc = + try + return (open_in_abs abspath_lock_config) + with + | Sys_error(_) -> err (LockConfigNotFound(abspath_lock_config)) + in + let s = Core.In_channel.input_all inc in + close_in inc; + YamlDecoder.run lock_config_decoder s |> Result.map_error (fun e -> LockConfigError(e)) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index ce07dc1f4..81e17367f 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -867,6 +867,17 @@ let report_config_error = function NormalLine("package config error (TODO: detailed reports)"); ] + | LockConfigNotFound(abspath) -> + report_error Interface [ + NormalLine("cannot find a lock config at:"); + DisplayLine(get_abs_path_string abspath); + ] + + | LockConfigError(_) -> + report_error Interface [ + NormalLine("lock config error (TODO: detailed reports)"); + ] + | NotALibraryFile(abspath) -> report_error Interface [ NormalLine("the following file is expected to be a library file, but is not:"); diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index 61b14eb37..311a346b8 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -585,10 +585,9 @@ type untyped_package = { [@@deriving show { with_path = false }] type lock_info = { - lock_name : lock_name; - lock_main_module_name : module_name; - lock_dependencies : lock_name list; - lock_directory : abs_path; + lock_name : lock_name; + lock_dependencies : lock_name list; + lock_directory : abs_path; } [@@deriving show { with_path = false }] From 8032ea504a49d3891d3a48c8829fd364ccebc7ed Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 30 Oct 2022 03:05:33 +0900 Subject: [PATCH 043/288] develop 'ClosedLockDependencyResolver' --- src/frontend/closedLockDependencyResolver.ml | 45 +++++++++++++++++++- src/frontend/configError.ml | 11 +++-- src/frontend/lockConfig.ml | 4 +- src/frontend/main.ml | 32 +++++++++----- src/frontend/packageConfig.ml | 2 +- src/frontend/yamlDecoder.ml | 18 ++++---- src/frontend/yamlDecoder.mli | 2 +- 7 files changed, 85 insertions(+), 29 deletions(-) diff --git a/src/frontend/closedLockDependencyResolver.ml b/src/frontend/closedLockDependencyResolver.ml index e47d0ae43..32fef455a 100644 --- a/src/frontend/closedLockDependencyResolver.ml +++ b/src/frontend/closedLockDependencyResolver.ml @@ -6,6 +6,47 @@ open ConfigError type 'a ok = ('a, config_error) result -let main ~extensions:(_ : string list) (_lock_config : LockConfig.t) : (untyped_package list) ok = + +module LockDependencyGraph = DependencyGraph.Make(String) + + +let main ~(extensions : string list) (lock_config : LockConfig.t) : ((lock_name * untyped_package) list) ok = let open ResultMonad in - return [] (* TODO: implement this *) + + let locks = lock_config.LockConfig.locked_packages in + + (* Add vertices: *) + let* (graph, entryacc) = + locks |> foldM (fun (graph, entryacc) lock -> + let lock_name = lock.lock_name in + let absdir_package = lock.lock_directory in + let* package = PackageReader.main ~extensions absdir_package in + let* (graph, vertex) = + graph |> LockDependencyGraph.add_vertex lock_name package + |> Result.map_error (fun _ -> LockNameConflict(lock_name)) + in + return (graph, Alist.extend entryacc (lock, vertex)) + ) (LockDependencyGraph.empty, Alist.empty) + in + + (* Add edges: *) + let* graph = + entryacc |> Alist.to_list |> foldM (fun graph (lock, vertex) -> + lock.lock_dependencies |> foldM (fun graph lock_name_dep -> + begin + match graph |> LockDependencyGraph.get_vertex lock_name_dep with + | None -> + err @@ DependencyOnUnknownLock{ + depending = lock.lock_name; + depended = lock_name_dep; + } + + | Some(vertex_dep) -> + let graph = graph |> LockDependencyGraph.add_edge ~from:vertex ~to_:vertex_dep in + return graph + end + ) graph + ) graph + in + + LockDependencyGraph.topological_sort graph |> Result.map_error (fun cycle -> CyclicLockDependency(cycle)) diff --git a/src/frontend/configError.ml b/src/frontend/configError.ml index a56c27cbe..832580e78 100644 --- a/src/frontend/configError.ml +++ b/src/frontend/configError.ml @@ -17,11 +17,16 @@ type config_error = } | PackageDirectoryNotFound of string list | PackageConfigNotFound of abs_path - | PackageConfigError of YamlDecoder.error + | PackageConfigError of abs_path * YamlDecoder.error | LockConfigNotFound of abs_path - | LockConfigError of YamlDecoder.error + | LockConfigError of abs_path * YamlDecoder.error + | LockNameConflict of lock_name + | DependencyOnUnknownLock of { + depending : lock_name; + depended : lock_name; + } + | CyclicLockDependency of (lock_name * untyped_package) cycle | NotALibraryFile of abs_path - | CyclicLockDependency of (module_name * lock_info) cycle | TypeError of TypeError.type_error | FileModuleNotFound of Range.t * module_name | NotADocumentFile of abs_path * mono_type diff --git a/src/frontend/lockConfig.ml b/src/frontend/lockConfig.ml index 3ba691321..05e338a51 100644 --- a/src/frontend/lockConfig.ml +++ b/src/frontend/lockConfig.ml @@ -18,7 +18,7 @@ let lock_location_decoder : abs_path YamlDecoder.t = get "path" string >>= fun s_libpath -> match Config.resolve_lib_file (make_lib_path s_libpath) with | Ok(abspath) -> succeed abspath - | Error(_e) -> failwith "TODO (error): not found" + | Error(_e) -> failure (Printf.sprintf "locked package not found at '%s'" s_libpath) end; ] ~on_error:(fun other -> @@ -56,4 +56,4 @@ let load (abspath_lock_config : abs_path) : t ok = in let s = Core.In_channel.input_all inc in close_in inc; - YamlDecoder.run lock_config_decoder s |> Result.map_error (fun e -> LockConfigError(e)) + YamlDecoder.run lock_config_decoder s |> Result.map_error (fun e -> LockConfigError(abspath_lock_config, e)) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 81e17367f..5cdd287ac 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -862,9 +862,10 @@ let report_config_error = function DisplayLine(get_abs_path_string abspath); ] - | PackageConfigError(_) -> + | PackageConfigError(abspath, e) -> report_error Interface [ - NormalLine("package config error (TODO: detailed reports)"); + NormalLine(Printf.sprintf "at %s:" (get_abs_path_string abspath)); + NormalLine(Printf.sprintf "package config error; %s" (YamlDecoder.show_error e)); ] | LockConfigNotFound(abspath) -> @@ -873,15 +874,20 @@ let report_config_error = function DisplayLine(get_abs_path_string abspath); ] - | LockConfigError(_) -> + | LockConfigError(abspath, e) -> report_error Interface [ - NormalLine("lock config error (TODO: detailed reports)"); + NormalLine(Printf.sprintf "at %s:" (get_abs_path_string abspath)); + NormalLine(Printf.sprintf "lock config error; %s" (YamlDecoder.show_error e)); ] - | NotALibraryFile(abspath) -> + | LockNameConflict(lock_name) -> report_error Interface [ - NormalLine("the following file is expected to be a library file, but is not:"); - DisplayLine(get_abs_path_string abspath); + NormalLine(Printf.sprintf "lock name conflict: '%s'" lock_name); + ] + + | DependencyOnUnknownLock{ depending; depended } -> + report_error Interface [ + NormalLine(Printf.sprintf "unknown depended lock '%s' of '%s'." depended depending); ] | CyclicLockDependency(cycle) -> @@ -898,6 +904,12 @@ let report_config_error = function report_error Interface (NormalLine("the following packages are cyclic:") :: lines) + | NotALibraryFile(abspath) -> + report_error Interface [ + NormalLine("the following file is expected to be a library file, but is not:"); + DisplayLine(get_abs_path_string abspath); + ] + | CannotFindLibraryFile(libpath, candidate_paths) -> let lines = candidate_paths |> List.map (fun path -> @@ -1251,16 +1263,16 @@ let build | Error(e) -> raise (ConfigError(e)) in - (* Resolve dependency among packages that the document depends on: *) + (* Resolve dependency among locked packages: *) let sorted_packages = match ClosedLockDependencyResolver.main ~extensions lock_config with | Ok(sorted_packages) -> sorted_packages | Error(e) -> raise (ConfigError(e)) in - (* Typecheck every package: *) + (* Typecheck every locked package: *) let (genv, libacc) = - sorted_packages |> List.fold_left (fun (genv, libacc) package -> + sorted_packages |> List.fold_left (fun (genv, libacc) (_lock_name, package) -> let main_module_name = package.main_module_name in let (ssig, libs) = match PackageChecker.main tyenv_prim genv package with diff --git a/src/frontend/packageConfig.ml b/src/frontend/packageConfig.ml index e7fc7efdd..be12c76e5 100644 --- a/src/frontend/packageConfig.ml +++ b/src/frontend/packageConfig.ml @@ -100,4 +100,4 @@ let load (absdir_package : abs_path) : t ok = in let s = Core.In_channel.input_all inc in close_in inc; - YamlDecoder.run config_decoder s |> Result.map_error (fun e -> PackageConfigError(e)) + YamlDecoder.run config_decoder s |> Result.map_error (fun e -> PackageConfigError(abspath_config, e)) diff --git a/src/frontend/yamlDecoder.ml b/src/frontend/yamlDecoder.ml index 0a12dbb4c..60566ee63 100644 --- a/src/frontend/yamlDecoder.ml +++ b/src/frontend/yamlDecoder.ml @@ -12,16 +12,14 @@ type error = | OtherMessage of string -let pp_error (ppf : Format.formatter) = - let p = Format.fprintf in - function - | FieldNotFound(field) -> p ppf "field '%s' not found" field - | NotAFloat -> p ppf "not a float value" - | NotAString -> p ppf "not a string value" - | NotABool -> p ppf "not a Boolean value" - | NotAnArray -> p ppf "not an array" - | NotAnObject -> p ppf "not an object" - | OtherMessage(msg) -> p ppf "%s" msg +let show_error = function + | FieldNotFound(field) -> Printf.sprintf "field '%s' not found" field + | NotAFloat -> Printf.sprintf "not a float value" + | NotAString -> Printf.sprintf "not a string value" + | NotABool -> Printf.sprintf "not a Boolean value" + | NotAnArray -> Printf.sprintf "not an array" + | NotAnObject -> Printf.sprintf "not an object" + | OtherMessage(msg) -> Printf.sprintf "%s" msg type 'a t = Yaml.value -> ('a, error) result diff --git a/src/frontend/yamlDecoder.mli b/src/frontend/yamlDecoder.mli index 2f7b18a68..aacc9c618 100644 --- a/src/frontend/yamlDecoder.mli +++ b/src/frontend/yamlDecoder.mli @@ -1,7 +1,7 @@ type error -val pp_error : Format.formatter -> error -> unit +val show_error : error -> string type 'a t From 1b57b8774ad30107b6cffaa66969049e2d9bf913 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 30 Oct 2022 03:05:56 +0900 Subject: [PATCH 044/288] make 'demo.saty' compile --- demo/demo.satysfi-lock | 65 +++++++++++++++++++ lib-satysfi/dist/packages/Annot/satysfi.yaml | 16 +++-- lib-satysfi/dist/packages/Code/satysfi.yaml | 16 +++-- .../dist/packages/FootnoteScheme/satysfi.yaml | 16 +++-- .../dist/packages/Itemize/satysfi.yaml | 16 +++-- lib-satysfi/dist/packages/Math/satysfi.yaml | 16 +++-- lib-satysfi/dist/packages/Proof/satysfi.yaml | 16 +++-- .../dist/packages/StdJaBook/satysfi.yaml | 24 ++++--- lib-satysfi/dist/packages/Stdlib/satysfi.yaml | 12 ++-- .../dist/packages/Tabular/satysfi.yaml | 16 +++-- 10 files changed, 157 insertions(+), 56 deletions(-) create mode 100644 demo/demo.satysfi-lock diff --git a/demo/demo.satysfi-lock b/demo/demo.satysfi-lock new file mode 100644 index 000000000..daf820580 --- /dev/null +++ b/demo/demo.satysfi-lock @@ -0,0 +1,65 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/Stdlib/" + + - name: "math.0.0.1" + location: + type: "global" + path: "./dist/packages/Math/" + dependencies: + - "stdlib.0.0.1" + + - name: "std-ja-book.0.0.1" + dependencies: + - "stdlib.0.0.1" + - "math.0.0.1" + - "annot.0.0.1" + - "code.0.0.1" + - "footnote-scheme.0.0.1" + location: + type: "global" + path: "./dist/packages/StdJaBook/" + + - name: "annot.0.0.1" + location: + type: "global" + path: "./dist/packages/Annot/" + dependencies: + - "stdlib.0.0.1" + + - name: "code.0.0.1" + location: + type: "global" + path: "./dist/packages/Code/" + dependencies: + - "stdlib.0.0.1" + + - name: "footnote-scheme.0.0.1" + location: + type: "global" + path: "./dist/packages/FootnoteScheme/" + dependencies: + - "stdlib.0.0.1" + + - name: "itemize.0.0.1" + location: + type: "global" + path: "./dist/packages/Itemize" + dependencies: + - "stdlib.0.0.1" + + - name: "proof.0.0.1" + location: + type: "global" + path: "./dist/packages/Proof" + dependencies: + - "stdlib.0.0.1" + + - name: "tabular.0.0.1" + location: + type: "global" + path: "./dist/packages/Tabular" + dependencies: + - "stdlib.0.0.1" diff --git a/lib-satysfi/dist/packages/Annot/satysfi.yaml b/lib-satysfi/dist/packages/Annot/satysfi.yaml index 8af472476..578e1ff25 100644 --- a/lib-satysfi/dist/packages/Annot/satysfi.yaml +++ b/lib-satysfi/dist/packages/Annot/satysfi.yaml @@ -1,6 +1,10 @@ -language: "v0.1.0" -main_module: "Annot" -source_directories: - - "./src" -dependencies: - - "Stdlib" +language: "0.1.0" +package_name: "annot" +version: "0.0.1" +contents: + type: "library" + main_module: "Annot" + source_directories: + - "./src" + dependencies: + - package_name: "stdlib" diff --git a/lib-satysfi/dist/packages/Code/satysfi.yaml b/lib-satysfi/dist/packages/Code/satysfi.yaml index ddeb72478..436b834dc 100644 --- a/lib-satysfi/dist/packages/Code/satysfi.yaml +++ b/lib-satysfi/dist/packages/Code/satysfi.yaml @@ -1,6 +1,10 @@ -language: "v0.1.0" -main_module: "Code" -source_directories: - - "./src" -dependencies: - - "Stdlib" +language: "0.1.0" +package_name: "code" +version: "0.0.1" +contents: + type: "library" + main_module: "Code" + source_directories: + - "./src" + dependencies: + - package_name: "stdlib" diff --git a/lib-satysfi/dist/packages/FootnoteScheme/satysfi.yaml b/lib-satysfi/dist/packages/FootnoteScheme/satysfi.yaml index 7cb36375b..823c25804 100644 --- a/lib-satysfi/dist/packages/FootnoteScheme/satysfi.yaml +++ b/lib-satysfi/dist/packages/FootnoteScheme/satysfi.yaml @@ -1,6 +1,10 @@ -language: "v0.1.0" -main_module: "FootnoteScheme" -source_directories: - - "./src" -dependencies: - - "Stdlib" +language: "0.1.0" +package_name: "footnote-scheme" +version: "0.0.1" +contents: + type: "library" + main_module: "FootnoteScheme" + source_directories: + - "./src" + dependencies: + - package_name: "stdlib" diff --git a/lib-satysfi/dist/packages/Itemize/satysfi.yaml b/lib-satysfi/dist/packages/Itemize/satysfi.yaml index 4c5976e25..fb8bc9775 100644 --- a/lib-satysfi/dist/packages/Itemize/satysfi.yaml +++ b/lib-satysfi/dist/packages/Itemize/satysfi.yaml @@ -1,6 +1,10 @@ -language: "v0.1.0" -main_module: "Itemize" -source_directories: - - "./src" -dependencies: - - "Stdlib" +language: "0.1.0" +package_name: "itemize" +version: "0.0.1" +contents: + type: "library" + main_module: "Itemize" + source_directories: + - "./src" + dependencies: + - package_name: "stdlib" diff --git a/lib-satysfi/dist/packages/Math/satysfi.yaml b/lib-satysfi/dist/packages/Math/satysfi.yaml index d06098c9e..a1bab440f 100644 --- a/lib-satysfi/dist/packages/Math/satysfi.yaml +++ b/lib-satysfi/dist/packages/Math/satysfi.yaml @@ -1,6 +1,10 @@ -language: "v0.1.0" -main_module: "Math" -source_directories: - - "./src" -dependencies: - - "Stdlib" +language: "0.1.0" +package_name: "math" +version: "0.0.1" +contents: + type: "library" + main_module: "Math" + source_directories: + - "./src" + dependencies: + - package_name: "stdlib" diff --git a/lib-satysfi/dist/packages/Proof/satysfi.yaml b/lib-satysfi/dist/packages/Proof/satysfi.yaml index 115edb7a3..fccb64edc 100644 --- a/lib-satysfi/dist/packages/Proof/satysfi.yaml +++ b/lib-satysfi/dist/packages/Proof/satysfi.yaml @@ -1,6 +1,10 @@ -language: "v0.1.0" -main_module: "Proof" -source_directories: - - "./src" -dependencies: - - "Stdlib" +language: "0.1.0" +package_name: "proof" +version: "0.0.1" +contents: + type: "library" + main_module: "Proof" + source_directories: + - "./src" + dependencies: + - package_name: "stdlib" diff --git a/lib-satysfi/dist/packages/StdJaBook/satysfi.yaml b/lib-satysfi/dist/packages/StdJaBook/satysfi.yaml index 275b120a8..1166d3e38 100644 --- a/lib-satysfi/dist/packages/StdJaBook/satysfi.yaml +++ b/lib-satysfi/dist/packages/StdJaBook/satysfi.yaml @@ -1,10 +1,14 @@ -language: "v0.1.0" -main_module: "StdJaBook" -source_directories: - - "./src" -dependencies: - - "Stdlib" - - "Math" - - "Annot" - - "Code" - - "FootnoteScheme" +language: "0.1.0" +package_name: "std-ja-book" +version: "0.0.1" +contents: + type: "library" + main_module: "StdJaBook" + source_directories: + - "./src" + dependencies: + - package_name: "stdlib" + - package_name: "math" + - package_name: "annot" + - package_name: "code" + - package_name: "footnote-scheme" diff --git a/lib-satysfi/dist/packages/Stdlib/satysfi.yaml b/lib-satysfi/dist/packages/Stdlib/satysfi.yaml index a6cb4c843..638ea0852 100644 --- a/lib-satysfi/dist/packages/Stdlib/satysfi.yaml +++ b/lib-satysfi/dist/packages/Stdlib/satysfi.yaml @@ -1,4 +1,8 @@ -language: "v0.1.0" -main_module: "Stdlib" -source_directories: - - "./src" +language: "0.1.0" +package_name: "stdlib" +version: "0.0.1" +contents: + type: "library" + main_module: "Stdlib" + source_directories: + - "./src" diff --git a/lib-satysfi/dist/packages/Tabular/satysfi.yaml b/lib-satysfi/dist/packages/Tabular/satysfi.yaml index b5a76adcb..28133f8c9 100644 --- a/lib-satysfi/dist/packages/Tabular/satysfi.yaml +++ b/lib-satysfi/dist/packages/Tabular/satysfi.yaml @@ -1,6 +1,10 @@ -language: "v0.1.0" -main_module: "Tabular" -source_directories: - - "./src" -dependencies: - - "Stdlib" +language: "0.1.0" +package_name: "tabular" +version: "0.0.1" +contents: + type: "library" + main_module: "Tabular" + source_directories: + - "./src" + dependencies: + - package_name: "stdlib" From cf87e3d9683f21db485466d63d7254bb16c53c75 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 30 Oct 2022 03:21:00 +0900 Subject: [PATCH 045/288] make 'doc-primitives.saty' compile --- doc/doc-primitives.satysfi-lock | 51 +++++++++++++++++++++++++++++++++ 1 file changed, 51 insertions(+) create mode 100644 doc/doc-primitives.satysfi-lock diff --git a/doc/doc-primitives.satysfi-lock b/doc/doc-primitives.satysfi-lock new file mode 100644 index 000000000..53d5f1b1d --- /dev/null +++ b/doc/doc-primitives.satysfi-lock @@ -0,0 +1,51 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/Stdlib/" + + - name: "math.0.0.1" + location: + type: "global" + path: "./dist/packages/Math/" + dependencies: + - "stdlib.0.0.1" + + - name: "std-ja-book.0.0.1" + dependencies: + - "stdlib.0.0.1" + - "math.0.0.1" + - "annot.0.0.1" + - "code.0.0.1" + - "footnote-scheme.0.0.1" + location: + type: "global" + path: "./dist/packages/StdJaBook/" + + - name: "annot.0.0.1" + location: + type: "global" + path: "./dist/packages/Annot/" + dependencies: + - "stdlib.0.0.1" + + - name: "code.0.0.1" + location: + type: "global" + path: "./dist/packages/Code/" + dependencies: + - "stdlib.0.0.1" + + - name: "footnote-scheme.0.0.1" + location: + type: "global" + path: "./dist/packages/FootnoteScheme/" + dependencies: + - "stdlib.0.0.1" + + - name: "itemize.0.0.1" + location: + type: "global" + path: "./dist/packages/Itemize" + dependencies: + - "stdlib.0.0.1" From 7ed051d6ec062ab7468d57c73a22c86d90d29a71 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 30 Oct 2022 03:24:35 +0900 Subject: [PATCH 046/288] make 'doc-lang.saty' compile --- doc/doc-lang.satysfi-lock | 36 ++++++++++++++++++++ lib-satysfi/dist/packages/StdJa/satysfi.yaml | 22 +++++++----- 2 files changed, 49 insertions(+), 9 deletions(-) create mode 100644 doc/doc-lang.satysfi-lock diff --git a/doc/doc-lang.satysfi-lock b/doc/doc-lang.satysfi-lock new file mode 100644 index 000000000..49b977284 --- /dev/null +++ b/doc/doc-lang.satysfi-lock @@ -0,0 +1,36 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/Stdlib/" + + - name: "math.0.0.1" + location: + type: "global" + path: "./dist/packages/Math/" + dependencies: + - "stdlib.0.0.1" + + - name: "std-ja.0.0.1" + dependencies: + - "stdlib.0.0.1" + - "math.0.0.1" + - "annot.0.0.1" + - "code.0.0.1" + location: + type: "global" + path: "./dist/packages/StdJa/" + + - name: "annot.0.0.1" + location: + type: "global" + path: "./dist/packages/Annot/" + dependencies: + - "stdlib.0.0.1" + + - name: "code.0.0.1" + location: + type: "global" + path: "./dist/packages/Code/" + dependencies: + - "stdlib.0.0.1" diff --git a/lib-satysfi/dist/packages/StdJa/satysfi.yaml b/lib-satysfi/dist/packages/StdJa/satysfi.yaml index 73582dfdb..d2bf70338 100644 --- a/lib-satysfi/dist/packages/StdJa/satysfi.yaml +++ b/lib-satysfi/dist/packages/StdJa/satysfi.yaml @@ -1,9 +1,13 @@ -language: "v0.1.0" -main_module: "StdJa" -source_directories: - - "./src" -dependencies: - - "Stdlib" - - "Math" - - "Code" - - "Annot" +language: "0.1.0" +package_name: "std-ja" +version: "0.0.1" +contents: + type: "library" + main_module: "StdJa" + source_directories: + - "./src" + dependencies: + - package_name: "stdlib" + - package_name: "math" + - package_name: "annot" + - package_name: "code" From 4628b613acf061477f395baa22cf3d409e824f89 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 30 Oct 2022 03:33:34 +0900 Subject: [PATCH 047/288] make 'math1.saty' compile --- doc/math1.satysfi-lock | 50 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) create mode 100644 doc/math1.satysfi-lock diff --git a/doc/math1.satysfi-lock b/doc/math1.satysfi-lock new file mode 100644 index 000000000..3b016e3cd --- /dev/null +++ b/doc/math1.satysfi-lock @@ -0,0 +1,50 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/Stdlib/" + + - name: "math.0.0.1" + location: + type: "global" + path: "./dist/packages/Math/" + dependencies: + - "stdlib.0.0.1" + + - name: "proof.0.0.1" + location: + type: "global" + path: "./dist/packages/Proof" + dependencies: + - "stdlib.0.0.1" + + - name: "tabular.0.0.1" + location: + type: "global" + path: "./dist/packages/Tabular" + dependencies: + - "stdlib.0.0.1" + + - name: "std-ja.0.0.1" + dependencies: + - "stdlib.0.0.1" + - "math.0.0.1" + - "annot.0.0.1" + - "code.0.0.1" + location: + type: "global" + path: "./dist/packages/StdJa/" + + - name: "annot.0.0.1" + location: + type: "global" + path: "./dist/packages/Annot/" + dependencies: + - "stdlib.0.0.1" + + - name: "code.0.0.1" + location: + type: "global" + path: "./dist/packages/Code/" + dependencies: + - "stdlib.0.0.1" From 5be494df1744454da89302cfbcdd1fb8f266f302 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 30 Oct 2022 04:32:00 +0900 Subject: [PATCH 048/288] make 'tests/**/*.saty' compile --- lib-satysfi/dist/packages/MDJa/satysfi.yaml | 26 ++++++---- .../dist/packages/StdJaReport/satysfi.yaml | 24 +++++---- tests/clip.satysfi-lock | 12 +++++ tests/glue1.satysfi-lock | 12 +++++ tests/head.satyh | 1 - tests/images/test.satysfi-lock | 43 +++++++++++++++ tests/macro1.satysfi-lock | 44 ++++++++++++++++ tests/math-typefaces.satysfi-lock | 51 ++++++++++++++++++ tests/math2.satysfi-lock | 12 +++++ tests/md/test.satysfi-lock | 52 +++++++++++++++++++ tests/refactor1.satysfi-lock | 12 +++++ tests/refactor2.satysfi-lock | 12 +++++ tests/refactor3.satysfi-lock | 12 +++++ tests/refactor5.satysfi-lock | 12 +++++ tests/staged1.satysfi-lock | 36 +++++++++++++ tests/text_mode/test.satysfi-lock | 1 + 16 files changed, 340 insertions(+), 22 deletions(-) create mode 100644 tests/clip.satysfi-lock create mode 100644 tests/glue1.satysfi-lock create mode 100644 tests/images/test.satysfi-lock create mode 100644 tests/macro1.satysfi-lock create mode 100644 tests/math-typefaces.satysfi-lock create mode 100644 tests/math2.satysfi-lock create mode 100644 tests/md/test.satysfi-lock create mode 100644 tests/refactor1.satysfi-lock create mode 100644 tests/refactor2.satysfi-lock create mode 100644 tests/refactor3.satysfi-lock create mode 100644 tests/refactor5.satysfi-lock create mode 100644 tests/staged1.satysfi-lock create mode 100644 tests/text_mode/test.satysfi-lock diff --git a/lib-satysfi/dist/packages/MDJa/satysfi.yaml b/lib-satysfi/dist/packages/MDJa/satysfi.yaml index f6f90312e..c895c0f02 100644 --- a/lib-satysfi/dist/packages/MDJa/satysfi.yaml +++ b/lib-satysfi/dist/packages/MDJa/satysfi.yaml @@ -1,11 +1,15 @@ -language: "v0.1.0" -main_module: "MDJa" -source_directories: - - "./src" -dependencies: - - "Stdlib" - - "Math" - - "Code" - - "Itemize" - - "Annot" - - "FootnoteScheme" +language: "0.1.0" +package_name: "md-ja" +version: "0.0.1" +contents: + type: "library" + main_module: "MDJa" + source_directories: + - "./src" + dependencies: + - package_name: "stdlib" + - package_name: "math" + - package_name: "code" + - package_name: "itemize" + - package_name: "annot" + - package_name: "footnote-scheme" diff --git a/lib-satysfi/dist/packages/StdJaReport/satysfi.yaml b/lib-satysfi/dist/packages/StdJaReport/satysfi.yaml index 4d5231e8f..a572c1b67 100644 --- a/lib-satysfi/dist/packages/StdJaReport/satysfi.yaml +++ b/lib-satysfi/dist/packages/StdJaReport/satysfi.yaml @@ -1,10 +1,14 @@ -language: "v0.1.0" -main_module: "StdJaReport" -source_directories: - - "./src" -dependencies: - - "Stdlib" - - "Math" - - "Code" - - "Annot" - - "FootnoteScheme" +language: "0.1.0" +package_name: "std-ja-report" +version: "0.0.1" +contents: + type: "library" + main_module: "StdJaReport" + source_directories: + - "./src" + dependencies: + - package_name: "stdlib" + - package_name: "math" + - package_name: "code" + - package_name: "annot" + - package_name: "footnote-scheme" diff --git a/tests/clip.satysfi-lock b/tests/clip.satysfi-lock new file mode 100644 index 000000000..830e8a1b7 --- /dev/null +++ b/tests/clip.satysfi-lock @@ -0,0 +1,12 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/Stdlib/" + + - name: "math.0.0.1" + location: + type: "global" + path: "./dist/packages/Math/" + dependencies: + - "stdlib.0.0.1" diff --git a/tests/glue1.satysfi-lock b/tests/glue1.satysfi-lock new file mode 100644 index 000000000..830e8a1b7 --- /dev/null +++ b/tests/glue1.satysfi-lock @@ -0,0 +1,12 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/Stdlib/" + + - name: "math.0.0.1" + location: + type: "global" + path: "./dist/packages/Math/" + dependencies: + - "stdlib.0.0.1" diff --git a/tests/head.satyh b/tests/head.satyh index 02c5b4372..ef6a28675 100644 --- a/tests/head.satyh +++ b/tests/head.satyh @@ -1,6 +1,5 @@ use package Stdlib use package Math -use package Proof module Head = struct diff --git a/tests/images/test.satysfi-lock b/tests/images/test.satysfi-lock new file mode 100644 index 000000000..eacffbebe --- /dev/null +++ b/tests/images/test.satysfi-lock @@ -0,0 +1,43 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/Stdlib/" + + - name: "math.0.0.1" + location: + type: "global" + path: "./dist/packages/Math/" + dependencies: + - "stdlib.0.0.1" + + - name: "std-ja.0.0.1" + dependencies: + - "stdlib.0.0.1" + - "math.0.0.1" + - "annot.0.0.1" + - "code.0.0.1" + location: + type: "global" + path: "./dist/packages/StdJa/" + + - name: "annot.0.0.1" + location: + type: "global" + path: "./dist/packages/Annot/" + dependencies: + - "stdlib.0.0.1" + + - name: "code.0.0.1" + location: + type: "global" + path: "./dist/packages/Code/" + dependencies: + - "stdlib.0.0.1" + + - name: "itemize.0.0.1" + location: + type: "global" + path: "./dist/packages/Itemize" + dependencies: + - "stdlib.0.0.1" diff --git a/tests/macro1.satysfi-lock b/tests/macro1.satysfi-lock new file mode 100644 index 000000000..15107b5f8 --- /dev/null +++ b/tests/macro1.satysfi-lock @@ -0,0 +1,44 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/Stdlib/" + + - name: "math.0.0.1" + location: + type: "global" + path: "./dist/packages/Math/" + dependencies: + - "stdlib.0.0.1" + + - name: "std-ja-report.0.0.1" + location: + type: "global" + path: "./dist/packages/StdJaReport" + dependencies: + - "stdlib.0.0.1" + - "math.0.0.1" + - "code.0.0.1" + - "annot.0.0.1" + - "footnote-scheme.0.0.1" + + - name: "annot.0.0.1" + location: + type: "global" + path: "./dist/packages/Annot/" + dependencies: + - "stdlib.0.0.1" + + - name: "code.0.0.1" + location: + type: "global" + path: "./dist/packages/Code/" + dependencies: + - "stdlib.0.0.1" + + - name: "footnote-scheme.0.0.1" + location: + type: "global" + path: "./dist/packages/FootnoteScheme/" + dependencies: + - "stdlib.0.0.1" diff --git a/tests/math-typefaces.satysfi-lock b/tests/math-typefaces.satysfi-lock new file mode 100644 index 000000000..9e737f9b8 --- /dev/null +++ b/tests/math-typefaces.satysfi-lock @@ -0,0 +1,51 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/Stdlib/" + + - name: "math.0.0.1" + location: + type: "global" + path: "./dist/packages/Math/" + dependencies: + - "stdlib.0.0.1" + + - name: "itemize.0.0.1" + location: + type: "global" + path: "./dist/packages/Itemize" + dependencies: + - "stdlib.0.0.1" + + - name: "std-ja-report.0.0.1" + location: + type: "global" + path: "./dist/packages/StdJaReport" + dependencies: + - "stdlib.0.0.1" + - "math.0.0.1" + - "code.0.0.1" + - "annot.0.0.1" + - "footnote-scheme.0.0.1" + + - name: "annot.0.0.1" + location: + type: "global" + path: "./dist/packages/Annot/" + dependencies: + - "stdlib.0.0.1" + + - name: "code.0.0.1" + location: + type: "global" + path: "./dist/packages/Code/" + dependencies: + - "stdlib.0.0.1" + + - name: "footnote-scheme.0.0.1" + location: + type: "global" + path: "./dist/packages/FootnoteScheme/" + dependencies: + - "stdlib.0.0.1" diff --git a/tests/math2.satysfi-lock b/tests/math2.satysfi-lock new file mode 100644 index 000000000..830e8a1b7 --- /dev/null +++ b/tests/math2.satysfi-lock @@ -0,0 +1,12 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/Stdlib/" + + - name: "math.0.0.1" + location: + type: "global" + path: "./dist/packages/Math/" + dependencies: + - "stdlib.0.0.1" diff --git a/tests/md/test.satysfi-lock b/tests/md/test.satysfi-lock new file mode 100644 index 000000000..9a79789f7 --- /dev/null +++ b/tests/md/test.satysfi-lock @@ -0,0 +1,52 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/Stdlib/" + + - name: "math.0.0.1" + location: + type: "global" + path: "./dist/packages/Math/" + dependencies: + - "stdlib.0.0.1" + + - name: "md-ja.0.0.1" + location: + type: "global" + path: "./dist/packages/MDJa/" + dependencies: + - "stdlib.0.0.1" + - "math.0.0.1" + - "code.0.0.1" + - "itemize.0.0.1" + - "annot.0.0.1" + - "footnote-scheme.0.0.1" + + - name: "annot.0.0.1" + location: + type: "global" + path: "./dist/packages/Annot/" + dependencies: + - "stdlib.0.0.1" + + - name: "code.0.0.1" + location: + type: "global" + path: "./dist/packages/Code/" + dependencies: + - "stdlib.0.0.1" + + - name: "footnote-scheme.0.0.1" + location: + type: "global" + path: "./dist/packages/FootnoteScheme/" + dependencies: + - "stdlib.0.0.1" + + - name: "itemize.0.0.1" + location: + type: "global" + path: "./dist/packages/Itemize" + dependencies: + - "stdlib.0.0.1" diff --git a/tests/refactor1.satysfi-lock b/tests/refactor1.satysfi-lock new file mode 100644 index 000000000..830e8a1b7 --- /dev/null +++ b/tests/refactor1.satysfi-lock @@ -0,0 +1,12 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/Stdlib/" + + - name: "math.0.0.1" + location: + type: "global" + path: "./dist/packages/Math/" + dependencies: + - "stdlib.0.0.1" diff --git a/tests/refactor2.satysfi-lock b/tests/refactor2.satysfi-lock new file mode 100644 index 000000000..830e8a1b7 --- /dev/null +++ b/tests/refactor2.satysfi-lock @@ -0,0 +1,12 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/Stdlib/" + + - name: "math.0.0.1" + location: + type: "global" + path: "./dist/packages/Math/" + dependencies: + - "stdlib.0.0.1" diff --git a/tests/refactor3.satysfi-lock b/tests/refactor3.satysfi-lock new file mode 100644 index 000000000..830e8a1b7 --- /dev/null +++ b/tests/refactor3.satysfi-lock @@ -0,0 +1,12 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/Stdlib/" + + - name: "math.0.0.1" + location: + type: "global" + path: "./dist/packages/Math/" + dependencies: + - "stdlib.0.0.1" diff --git a/tests/refactor5.satysfi-lock b/tests/refactor5.satysfi-lock new file mode 100644 index 000000000..830e8a1b7 --- /dev/null +++ b/tests/refactor5.satysfi-lock @@ -0,0 +1,12 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/Stdlib/" + + - name: "math.0.0.1" + location: + type: "global" + path: "./dist/packages/Math/" + dependencies: + - "stdlib.0.0.1" diff --git a/tests/staged1.satysfi-lock b/tests/staged1.satysfi-lock new file mode 100644 index 000000000..49b977284 --- /dev/null +++ b/tests/staged1.satysfi-lock @@ -0,0 +1,36 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/Stdlib/" + + - name: "math.0.0.1" + location: + type: "global" + path: "./dist/packages/Math/" + dependencies: + - "stdlib.0.0.1" + + - name: "std-ja.0.0.1" + dependencies: + - "stdlib.0.0.1" + - "math.0.0.1" + - "annot.0.0.1" + - "code.0.0.1" + location: + type: "global" + path: "./dist/packages/StdJa/" + + - name: "annot.0.0.1" + location: + type: "global" + path: "./dist/packages/Annot/" + dependencies: + - "stdlib.0.0.1" + + - name: "code.0.0.1" + location: + type: "global" + path: "./dist/packages/Code/" + dependencies: + - "stdlib.0.0.1" diff --git a/tests/text_mode/test.satysfi-lock b/tests/text_mode/test.satysfi-lock new file mode 100644 index 000000000..a2e98fa3c --- /dev/null +++ b/tests/text_mode/test.satysfi-lock @@ -0,0 +1 @@ +locks: [] From 50c6e2e1ef33ea1c26011d70a6ee1e8cafd36ff3 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 30 Oct 2022 06:21:13 +0900 Subject: [PATCH 049/288] slight refactoring of 'YamlDecoder' --- src/frontend/yamlDecoder.ml | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/frontend/yamlDecoder.ml b/src/frontend/yamlDecoder.ml index 60566ee63..c0c7d4d91 100644 --- a/src/frontend/yamlDecoder.ml +++ b/src/frontend/yamlDecoder.ml @@ -50,15 +50,17 @@ fun yval -> let ( >>= ) = bind -let get_scheme (field : string) (d : 'a t) (k : unit -> ('a, error) result) : 'a t = +let get_scheme (field : string) (d : 'a t) (k_absent : unit -> ('a, error) result) : 'a t = let open ResultMonad in function | `O(keyvals) -> begin match - List.find_map (fun (k, v) -> if String.equal k field then Some(v) else None) keyvals + keyvals |> List.find_map (fun (k, v) -> + if String.equal k field then Some(v) else None + ) with - | None -> k () + | None -> k_absent () | Some(v) -> d v end From c7a98d1515e64b294232d6334d95a61cf0305bfc Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 30 Oct 2022 06:44:43 +0900 Subject: [PATCH 050/288] add contexts to 'YamlDecoder.error' --- src/frontend/yamlDecoder.ml | 148 +++++++++++++++++++++--------------- 1 file changed, 88 insertions(+), 60 deletions(-) diff --git a/src/frontend/yamlDecoder.ml b/src/frontend/yamlDecoder.ml index c0c7d4d91..1c1f9f945 100644 --- a/src/frontend/yamlDecoder.ml +++ b/src/frontend/yamlDecoder.ml @@ -2,7 +2,14 @@ open MyUtil -type error = +type context_element = + | Field of string + | Index of int + +type context = + context_element list + +type error_main = | FieldNotFound of string | NotAFloat | NotAString @@ -11,25 +18,43 @@ type error = | NotAnObject | OtherMessage of string +type error = + context * error_main + + +let show_error ((context, errmain) : error) = + let s_main = + match errmain with + | FieldNotFound(field) -> Printf.sprintf "field '%s' not found" field + | NotAFloat -> Printf.sprintf "not a float value" + | NotAString -> Printf.sprintf "not a string value" + | NotABool -> Printf.sprintf "not a Boolean value" + | NotAnArray -> Printf.sprintf "not an array" + | NotAnObject -> Printf.sprintf "not an object" + | OtherMessage(msg) -> Printf.sprintf "%s" msg + in + match context with + | [] -> + s_main -let show_error = function - | FieldNotFound(field) -> Printf.sprintf "field '%s' not found" field - | NotAFloat -> Printf.sprintf "not a float value" - | NotAString -> Printf.sprintf "not a string value" - | NotABool -> Printf.sprintf "not a Boolean value" - | NotAnArray -> Printf.sprintf "not an array" - | NotAnObject -> Printf.sprintf "not an object" - | OtherMessage(msg) -> Printf.sprintf "%s" msg + | _ :: _ -> + let s_context = + context |> List.map (function + | Field(field) -> Printf.sprintf ".%s" field + | Index(index) -> Printf.sprintf ".[%d]" index + ) |> String.concat "" + in + Printf.sprintf "%s (context: %s)" s_main s_context -type 'a t = Yaml.value -> ('a, error) result +type 'a t = context_element Alist.t * Yaml.value -> ('a, error) result let run (d : 'a t) (s : string) : ('a, error) result = let open ResultMonad in match Yaml.of_string s with - | Ok(yval) -> d yval - | Error(`Msg(s)) -> err (OtherMessage(s)) + | Ok(yval) -> d (Alist.empty, yval) + | Error(`Msg(s)) -> err ([], OtherMessage(s)) let succeed (a : 'a) : 'a t = @@ -37,40 +62,40 @@ let succeed (a : 'a) : 'a t = let failure (msg : string) : 'a t = - fun _ -> Error(OtherMessage(msg)) + fun (context, _) -> Error(Alist.to_list context, OtherMessage(msg)) let bind (d : 'a t) (df : 'a -> 'b t) : 'b t = -fun yval -> - match d yval with - | Ok(a) -> df a yval - | Error(_) as e -> e + fun s -> + match d s with + | Ok(a) -> df a s + | Error(_) as e -> e let ( >>= ) = bind -let get_scheme (field : string) (d : 'a t) (k_absent : unit -> ('a, error) result) : 'a t = - let open ResultMonad in - function - | `O(keyvals) -> - begin - match - keyvals |> List.find_map (fun (k, v) -> - if String.equal k field then Some(v) else None - ) - with - | None -> k_absent () - | Some(v) -> d v - end - - | _ -> - err NotAnObject +let get_scheme (field : string) (d : 'a t) (k_absent : context_element Alist.t -> ('a, error) result) : 'a t = + fun (context, yval) -> + let open ResultMonad in + match yval with + | `O(keyvals) -> + begin + match + keyvals |> List.find_opt (fun (k, _v) -> String.equal k field) + (* According to the specification of YAML, every key can occur at most once here. *) + with + | None -> k_absent context + | Some((k, v)) -> d (Alist.extend context (Field(k)), v) + end + + | _ -> + err (Alist.to_list context, NotAnObject) let get (field : string) (d : 'a t) : 'a t = let open ResultMonad in - get_scheme field d (fun () -> err (FieldNotFound(field))) + get_scheme field d (fun context -> err (Alist.to_list context, FieldNotFound(field))) let get_opt (field : string) (d : 'a t) : ('a option) t = @@ -78,48 +103,51 @@ let get_opt (field : string) (d : 'a t) : ('a option) t = d >>= fun v -> succeed (Some(v)) in let open ResultMonad in - get_scheme field d_some (fun () -> return None) + get_scheme field d_some (fun _ -> return None) let get_or_else (field : string) (d : 'a t) (default : 'a) : 'a t = let open ResultMonad in - get_scheme field d (fun () -> return default) + get_scheme field d (fun _ -> return default) let number : float t = - let open ResultMonad in - function - | `Float(x) -> return x - | _ -> err NotAFloat + fun (context, yval) -> + let open ResultMonad in + match yval with + | `Float(x) -> return x + | _ -> err (Alist.to_list context, NotAFloat) let string : string t = - let open ResultMonad in - function - | `String(x) -> return x - | _ -> err NotAString + fun (context, yval) -> + let open ResultMonad in + match yval with + | `String(x) -> return x + | _ -> err (Alist.to_list context, NotAString) let bool : bool t = - let open ResultMonad in - function - | `Bool(x) -> return x - | _ -> err NotABool + fun (context, yval) -> + let open ResultMonad in + match yval with + | `Bool(x) -> return x + | _ -> err (Alist.to_list context, NotABool) let list (d : 'a t) : ('a list) t = - let open ResultMonad in - function - | `A(yvals) -> - yvals |> List.fold_left (fun res yval -> - res >>= fun acc -> - d yval >>= fun a -> - return (Alist.extend acc a) - ) (return Alist.empty) >>= fun acc -> - return (Alist.to_list acc) - - | _ -> - err NotAnArray + fun (context, yval) -> + let open ResultMonad in + match yval with + | `A(yvals) -> + yvals |> foldM (fun (index, acc) yval -> + d (Alist.extend context (Index(index)), yval) >>= fun a -> + return (index + 1, Alist.extend acc a) + ) (0, Alist.empty) >>= fun (_, acc) -> + return (Alist.to_list acc) + + | _ -> + err (Alist.to_list context, NotAnArray) type 'a branch = string * 'a t From 2b5a855076ef1f1f42220eb2b9e7c4d19437ea5d Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 1 Nov 2022 23:50:25 +0900 Subject: [PATCH 051/288] remove 'OpenPackageDependencyResolver' --- src/frontend/openPackageDependencyResolver.ml | 71 ------------------- .../openPackageDependencyResolver.mli | 6 -- 2 files changed, 77 deletions(-) delete mode 100644 src/frontend/openPackageDependencyResolver.ml delete mode 100644 src/frontend/openPackageDependencyResolver.mli diff --git a/src/frontend/openPackageDependencyResolver.ml b/src/frontend/openPackageDependencyResolver.ml deleted file mode 100644 index 58b9d75c8..000000000 --- a/src/frontend/openPackageDependencyResolver.ml +++ /dev/null @@ -1,71 +0,0 @@ -(* -open MyUtil -open Types -open ConfigError - - -type 'a ok = ('a, config_error) result - -module PackageDependencyGraph = DependencyGraph.Make(String) - -type graph = package_info PackageDependencyGraph.t - -type vertex = PackageDependencyGraph.Vertex.t - - -let rec add_package (extensions : string list) (graph : graph) ~prev:(vertex_prev_opt : vertex option) (main_module_name : module_name) : graph ok = - let open ResultMonad in - match graph |> PackageDependencyGraph.get_vertex main_module_name with - | Some(vertex) -> - (* If `main_module_name` has already been read: *) - let graph = - match vertex_prev_opt with - | None -> - graph - - | Some(vertex_prev) -> - graph |> PackageDependencyGraph.add_edge ~from:vertex_prev ~to_:vertex - in - return graph - - | None -> - let* absdir = - Config.resolve_package_directory main_module_name - |> Result.map_error (fun cands -> PackageDirectoryNotFound(cands)) - in - let* package = PackageReader.main ~extensions absdir in - if String.equal package.main_module_name main_module_name then - let (graph, vertex) = - match graph |> PackageDependencyGraph.add_vertex main_module_name package with - | Error(_) -> assert false - | Ok(pair) -> pair - in - let graph = - match vertex_prev_opt with - | None -> graph - | Some(vertex_prev) -> graph |> PackageDependencyGraph.add_edge ~from:vertex_prev ~to_:vertex - in - package.dependencies |> foldM (fun graph main_module_name_dep -> - add_package extensions graph ~prev:(Some(vertex)) main_module_name_dep - ) graph - else - err @@ MainModuleNameMismatch{ - expected = main_module_name; - got = package.main_module_name; - } - - -let main ~(extensions : string list) (package_name_set_init : PackageNameSet.t) : (package_info list) ok = - let open ResultMonad in - let main_module_names_init = package_name_set_init |> PackageNameSet.elements in - let* graph = - main_module_names_init |> foldM (fun graph main_module_name -> - add_package extensions graph ~prev:None main_module_name - ) PackageDependencyGraph.empty - in - let* pairs = - PackageDependencyGraph.topological_sort graph - |> Result.map_error (fun cycle -> CyclicPackageDependency(cycle)) - in - return (pairs |> List.map (fun (_, package) -> package)) -*) diff --git a/src/frontend/openPackageDependencyResolver.mli b/src/frontend/openPackageDependencyResolver.mli deleted file mode 100644 index 1323eca09..000000000 --- a/src/frontend/openPackageDependencyResolver.mli +++ /dev/null @@ -1,6 +0,0 @@ -(* -open Types -open ConfigError - -val main : extensions:(string list) -> PackageNameSet.t -> (package_info list, config_error) result -*) From fc0b29f1086f160483aa9a99d19fd1c22590011d Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 2 Nov 2022 00:18:17 +0900 Subject: [PATCH 052/288] refactor 'ClosedFileDependencyResolver' --- src/frontend/closedFileDependencyResolver.ml | 45 +++++++++++--------- src/frontend/configError.ml | 1 + src/frontend/main.ml | 6 +++ src/frontend/types.cppo.ml | 6 +++ 4 files changed, 37 insertions(+), 21 deletions(-) diff --git a/src/frontend/closedFileDependencyResolver.ml b/src/frontend/closedFileDependencyResolver.ml index 7c5d453dd..2180b1f57 100644 --- a/src/frontend/closedFileDependencyResolver.ml +++ b/src/frontend/closedFileDependencyResolver.ml @@ -6,21 +6,23 @@ open ConfigError type 'a ok = ('a, config_error) result +module SourceModuleDependencyGraph = DependencyGraph.Make(String) + + let main (utlibs : (abs_path * untyped_library_file) list) : ((abs_path * untyped_library_file) list) ok = let open ResultMonad in (* Add vertices: *) - let (graph, modnm_to_path, entryacc) = - utlibs |> List.fold_left (fun (graph, modnm_to_path, entryacc) (abspath, utlib) -> + let* (graph, entryacc) = + utlibs |> foldM (fun (graph, entryacc) (abspath, utlib) -> let (_, ((_, modnm), _, _)) = utlib in - let (graph, vertex) = - match graph |> FileDependencyGraph.add_vertex abspath utlib with - | Error(_) -> assert false - | Ok(pair) -> pair + let* (graph, vertex) = + match graph |> SourceModuleDependencyGraph.add_vertex modnm (abspath, utlib) with + | Error(_) -> err @@ FileModuleNameConflict(modnm, abspath) + | Ok(pair) -> return pair in - let entry = (utlib, vertex) in - (graph, modnm_to_path |> ModuleNameMap.add modnm abspath, Alist.extend entryacc entry) - ) (FileDependencyGraph.empty, ModuleNameMap.empty, Alist.empty) + return (graph, Alist.extend entryacc (utlib, vertex)) + ) (SourceModuleDependencyGraph.empty, Alist.empty) in (* Add edges: *) @@ -31,20 +33,13 @@ let main (utlibs : (abs_path * untyped_library_file) list) : ((abs_path * untype match headerelem with | HeaderUse((rng, modnm_sub)) -> begin - match modnm_to_path |> ModuleNameMap.find_opt modnm_sub with + match graph |> SourceModuleDependencyGraph.get_vertex modnm_sub with | None -> err @@ FileModuleNotFound(rng, modnm_sub) - | Some(abspath_sub) -> - begin - match graph |> FileDependencyGraph.get_vertex abspath_sub with - | None -> - assert false - - | Some(vertex_sub) -> - let graph = graph |> FileDependencyGraph.add_edge ~from:vertex ~to_:vertex_sub in - return graph - end + | Some(vertex_sub) -> + let graph = graph |> SourceModuleDependencyGraph.add_edge ~from:vertex ~to_:vertex_sub in + return graph end | HeaderUsePackage(_) -> @@ -57,4 +52,12 @@ let main (utlibs : (abs_path * untyped_library_file) list) : ((abs_path * untype ) graph in - FileDependencyGraph.topological_sort graph |> Result.map_error (fun cycle -> CyclicFileDependency(cycle)) + (* Solve dependency: *) + let* sorted = + SourceModuleDependencyGraph.topological_sort graph + |> Result.map_error (fun cycle -> + let cycle = cycle |> map_cycle (fun (_modnm, pair) -> pair) in + CyclicFileDependency(cycle) + ) + in + return (sorted |> List.map (fun (_modnm, pair) -> pair)) diff --git a/src/frontend/configError.ml b/src/frontend/configError.ml index 832580e78..d6fc13374 100644 --- a/src/frontend/configError.ml +++ b/src/frontend/configError.ml @@ -29,6 +29,7 @@ type config_error = | NotALibraryFile of abs_path | TypeError of TypeError.type_error | FileModuleNotFound of Range.t * module_name + | FileModuleNameConflict of module_name * abs_path | NotADocumentFile of abs_path * mono_type | NotAStringFile of abs_path * mono_type | NoMainModule of module_name diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 5cdd287ac..838305f9e 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -790,6 +790,12 @@ let report_config_error = function NormalLine(Printf.sprintf "cannot find a source file that defines module '%s'." modnm); ] + | FileModuleNameConflict(modnm, abspath) -> + report_error Interface [ + NormalLine(Printf.sprintf "more than one file defines module '%s';" modnm); + NormalLine(Printf.sprintf "one is '%s'." (get_abs_path_string abspath)); + ] + | NoMainModule(modnm) -> report_error Interface [ NormalLine(Printf.sprintf "no main module '%s'." modnm); diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index 311a346b8..52dd55800 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -1215,6 +1215,12 @@ type 'a cycle = | Cycle of 'a TupleList.t [@@deriving show { with_path = false; }] + +let map_cycle f = function + | Loop(v) -> Loop(f v) + | Cycle(vs) -> Cycle(TupleList.map f vs) + + module GlobalTypeenv = Map.Make(String) module PackageNameSet = Set.Make(String) From 00685b82aff53b472b0f8fee9619976cbd6d3ed2 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 2 Nov 2022 00:57:55 +0900 Subject: [PATCH 053/288] add 'CannotUseHeaderUseOf' --- src/frontend/closedFileDependencyResolver.ml | 4 ++-- src/frontend/configError.ml | 3 ++- src/frontend/main.ml | 10 ++++++++-- src/frontend/openFileDependencyResolver.ml | 4 ++-- src/frontend/packageChecker.ml | 2 +- src/frontend/types.cppo.ml | 1 + 6 files changed, 16 insertions(+), 8 deletions(-) diff --git a/src/frontend/closedFileDependencyResolver.ml b/src/frontend/closedFileDependencyResolver.ml index 2180b1f57..36d64ddeb 100644 --- a/src/frontend/closedFileDependencyResolver.ml +++ b/src/frontend/closedFileDependencyResolver.ml @@ -45,8 +45,8 @@ let main (utlibs : (abs_path * untyped_library_file) list) : ((abs_path * untype | HeaderUsePackage(_) -> return graph - | HeaderUseOf(_, _) -> - assert false + | HeaderUseOf(modident, _) -> + err @@ CannotUseHeaderUseOf(modident) ) graph ) graph diff --git a/src/frontend/configError.ml b/src/frontend/configError.ml index d6fc13374..bce751a12 100644 --- a/src/frontend/configError.ml +++ b/src/frontend/configError.ml @@ -9,7 +9,8 @@ type config_error = | CannotReadFileOwingToSystem of string | LibraryContainsWholeReturnValue of abs_path | DocumentLacksWholeReturnValue of abs_path - | CannotUseHeaderUse of Range.t + | CannotUseHeaderUse of module_name ranged + | CannotUseHeaderUseOf of module_name ranged | FailedToParse of parse_error | MainModuleNameMismatch of { expected : module_name; diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 838305f9e..7fa317467 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -839,10 +839,16 @@ let report_config_error = function NormalLine(Printf.sprintf "file '%s' is not a document; it lacks a return value." fname); ] - | CannotUseHeaderUse(rng) -> + | CannotUseHeaderUse((rng, modnm)) -> report_error Interface [ NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine("cannot specify 'use ...' here; use 'use ... of ...' instead."); + NormalLine(Printf.sprintf "cannot specify 'use %s' here; use 'use %s of ...' instead." modnm modnm); + ] + + | CannotUseHeaderUseOf((rng, modnm)) -> + report_error Interface [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "cannot specify 'use %s of ...' here; use 'use %s' instead." modnm modnm); ] | FailedToParse(e) -> diff --git a/src/frontend/openFileDependencyResolver.ml b/src/frontend/openFileDependencyResolver.ml index 4ec800ae6..19b6140ed 100644 --- a/src/frontend/openFileDependencyResolver.ml +++ b/src/frontend/openFileDependencyResolver.ml @@ -34,8 +34,8 @@ let get_header (extensions : string list) (curdir : string) (headerelem : header | HeaderUsePackage(modident) -> return @@ Package(modident) - | HeaderUse((rng, _)) -> - err @@ CannotUseHeaderUse(rng) + | HeaderUse(modident) -> + err @@ CannotUseHeaderUse(modident) | HeaderUseOf(modident, s_relpath) -> let* abspath = Config.resolve_local ~extensions ~origin:curdir ~relative:s_relpath in diff --git a/src/frontend/packageChecker.ml b/src/frontend/packageChecker.ml index 927b76749..168b55f07 100644 --- a/src/frontend/packageChecker.ml +++ b/src/frontend/packageChecker.ml @@ -32,7 +32,7 @@ let add_dependency_to_type_environment ~(package_only : bool) (header : header_e begin match (kind, genv |> GlobalTypeenv.find_opt modnm) with | (LocalDependency, None) -> - assert false + assert false (* Local dependency must be resolved beforehand. *) | (PackageDependency, None) -> err @@ UnknownPackageDependency(rng, modnm) diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index 52dd55800..1dbe724f4 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -4,6 +4,7 @@ open GraphicBase open SyntaxBase open MyUtil + type parse_error = | CannotProgressParsing of Range.t | IllegalItemDepth of { From bcf9776c3559b6a62f71e88ab7437ec64db58be2 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 2 Nov 2022 01:16:27 +0900 Subject: [PATCH 054/288] remove 'fileDependencyGraph.{ml,mli}' --- src/frontend/fileDependencyGraph.ml | 29 ---------------------- src/frontend/fileDependencyGraph.mli | 17 ------------- src/frontend/openFileDependencyResolver.ml | 11 ++++++-- 3 files changed, 9 insertions(+), 48 deletions(-) delete mode 100644 src/frontend/fileDependencyGraph.ml delete mode 100644 src/frontend/fileDependencyGraph.mli diff --git a/src/frontend/fileDependencyGraph.ml b/src/frontend/fileDependencyGraph.ml deleted file mode 100644 index b8c4bba8f..000000000 --- a/src/frontend/fileDependencyGraph.ml +++ /dev/null @@ -1,29 +0,0 @@ - -open MyUtil -open Types - - -module Impl = DependencyGraph.Make(AbsPath) - -type vertex = Impl.Vertex.t - -type t = untyped_library_file Impl.t - - -let empty = Impl.empty - - -let add_vertex (abspath : abs_path) (data : untyped_library_file) (graph : t) : (t * vertex, untyped_library_file * vertex) result = - Impl.add_vertex abspath data graph - - -let get_vertex (abspath : abs_path) (graph : t) : vertex option = - Impl.get_vertex abspath graph - - -let add_edge ~(from : vertex) ~(to_ : vertex) (graph : t) : t = - Impl.add_edge ~from ~to_ graph - - -let topological_sort (graph : t) : ((abs_path * untyped_library_file) list, (abs_path * untyped_library_file) cycle) result = - Impl.topological_sort graph diff --git a/src/frontend/fileDependencyGraph.mli b/src/frontend/fileDependencyGraph.mli deleted file mode 100644 index c21359c28..000000000 --- a/src/frontend/fileDependencyGraph.mli +++ /dev/null @@ -1,17 +0,0 @@ - -open MyUtil -open Types - -type vertex - -type t - -val empty : t - -val add_vertex : abs_path -> untyped_library_file -> t -> (t * vertex, untyped_library_file * vertex) result - -val get_vertex : abs_path -> t -> vertex option - -val add_edge : from:vertex -> to_:vertex -> t -> t - -val topological_sort : t -> ((abs_path * untyped_library_file) list, (abs_path * untyped_library_file) cycle) result diff --git a/src/frontend/openFileDependencyResolver.ml b/src/frontend/openFileDependencyResolver.ml index 19b6140ed..ec6aa0fef 100644 --- a/src/frontend/openFileDependencyResolver.ml +++ b/src/frontend/openFileDependencyResolver.ml @@ -7,6 +7,13 @@ open ConfigError type 'a ok = ('a, config_error) result +module FileDependencyGraph = DependencyGraph.Make(AbsPath) + +type graph = untyped_library_file FileDependencyGraph.t + +type vertex = FileDependencyGraph.Vertex.t + + let has_library_extension (abspath : abs_path) : bool = let ext = get_abs_path_extension abspath in match ext with @@ -42,7 +49,7 @@ let get_header (extensions : string list) (curdir : string) (headerelem : header return @@ Local(modident, abspath) -let rec register_library_file (extensions : string list) (graph : FileDependencyGraph.t) (package_names : PackageNameSet.t) ~prev:(vertex_prev_opt : FileDependencyGraph.vertex option) (abspath : abs_path) : (PackageNameSet.t * FileDependencyGraph.t) ok = +let rec register_library_file (extensions : string list) (graph : graph) (package_names : PackageNameSet.t) ~prev:(vertex_prev_opt : vertex option) (abspath : abs_path) : (PackageNameSet.t * graph) ok = let open ResultMonad in match graph |> FileDependencyGraph.get_vertex abspath with | Some(vertex) -> @@ -85,7 +92,7 @@ let rec register_library_file (extensions : string list) (graph : FileDependency ) (package_names, graph) -let register_document_file (extensions : string list) (abspath_in : abs_path) : (PackageNameSet.t * FileDependencyGraph.t * untyped_document_file) ok = +let register_document_file (extensions : string list) (abspath_in : abs_path) : (PackageNameSet.t * graph * untyped_document_file) ok = let open ResultMonad in Logging.begin_to_parse_file abspath_in; let curdir = Filename.dirname (get_abs_path_string abspath_in) in From 15d25a9db05c0d24ea13e8f110abfc2581ed0a75 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 2 Nov 2022 01:27:52 +0900 Subject: [PATCH 055/288] slight improvement on 'FileModuleNameConflict' --- src/frontend/closedFileDependencyResolver.ml | 7 +++++-- src/frontend/configError.ml | 2 +- src/frontend/main.ml | 7 ++++--- 3 files changed, 10 insertions(+), 6 deletions(-) diff --git a/src/frontend/closedFileDependencyResolver.ml b/src/frontend/closedFileDependencyResolver.ml index 36d64ddeb..75eaee28e 100644 --- a/src/frontend/closedFileDependencyResolver.ml +++ b/src/frontend/closedFileDependencyResolver.ml @@ -18,8 +18,11 @@ let main (utlibs : (abs_path * untyped_library_file) list) : ((abs_path * untype let (_, ((_, modnm), _, _)) = utlib in let* (graph, vertex) = match graph |> SourceModuleDependencyGraph.add_vertex modnm (abspath, utlib) with - | Error(_) -> err @@ FileModuleNameConflict(modnm, abspath) - | Ok(pair) -> return pair + | Error(((abspath_prev, _utlib_prev), _vertex_prev)) -> + err @@ FileModuleNameConflict(modnm, abspath_prev, abspath) + + | Ok(pair) -> + return pair in return (graph, Alist.extend entryacc (utlib, vertex)) ) (SourceModuleDependencyGraph.empty, Alist.empty) diff --git a/src/frontend/configError.ml b/src/frontend/configError.ml index bce751a12..39322d403 100644 --- a/src/frontend/configError.ml +++ b/src/frontend/configError.ml @@ -30,7 +30,7 @@ type config_error = | NotALibraryFile of abs_path | TypeError of TypeError.type_error | FileModuleNotFound of Range.t * module_name - | FileModuleNameConflict of module_name * abs_path + | FileModuleNameConflict of module_name * abs_path * abs_path | NotADocumentFile of abs_path * mono_type | NotAStringFile of abs_path * mono_type | NoMainModule of module_name diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 7fa317467..45186a2fc 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -790,10 +790,11 @@ let report_config_error = function NormalLine(Printf.sprintf "cannot find a source file that defines module '%s'." modnm); ] - | FileModuleNameConflict(modnm, abspath) -> + | FileModuleNameConflict(modnm, abspath1, abspath2) -> report_error Interface [ - NormalLine(Printf.sprintf "more than one file defines module '%s';" modnm); - NormalLine(Printf.sprintf "one is '%s'." (get_abs_path_string abspath)); + NormalLine(Printf.sprintf "more than one file defines module '%s':" modnm); + DisplayLine(Printf.sprintf "- %s" (get_abs_path_string abspath1)); + DisplayLine(Printf.sprintf "- %s" (get_abs_path_string abspath2)); ] | NoMainModule(modnm) -> From ae8f50fec669d3f1b5c83e1859bc9262b6c43545 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 2 Nov 2022 02:55:54 +0900 Subject: [PATCH 056/288] improve error propagation around 'YamlDecoder' and 'Config' --- src/config.ml | 39 +--- src/config.mli | 7 +- src/frontend/configError.ml | 45 +++- src/frontend/fontInfo.ml | 80 ++++--- src/frontend/fontInfo.mli | 2 +- src/frontend/lockConfig.ml | 29 ++- src/frontend/main.ml | 89 ++++++-- src/frontend/openFileDependencyResolver.ml | 11 +- src/frontend/packageConfig.ml | 26 ++- src/frontend/primitives.cppo.ml | 11 +- src/frontend/yamlDecoder.ml | 249 ++++++++++----------- src/frontend/yamlDecoder.mli | 65 ++++-- 12 files changed, 372 insertions(+), 281 deletions(-) diff --git a/src/config.ml b/src/config.ml index a61adcc26..301307008 100644 --- a/src/config.ml +++ b/src/config.ml @@ -1,6 +1,5 @@ open MyUtil -open ConfigError let satysfi_root_dirs : (string list) ref = ref [] @@ -14,42 +13,16 @@ let resolve fn = if Sys.file_exists fn then Some(fn) else None -let resolve_directory fn = - try - if Sys.is_directory fn then Some(make_abs_path fn) else None - with - | Sys_error(_) -> None - - (* Receives a file path relative to `LIBROOT` and returns its corresponding absolute path. *) -let resolve_lib_file (relpath : lib_path) : (abs_path, config_error) result = +let resolve_lib_file (relpath : lib_path) : (abs_path, abs_path list) result = + let open ResultMonad in let dirs = !satysfi_root_dirs in let relpathstr = get_lib_path_string relpath in - let pathcands = - dirs |> List.map (fun dir -> Filename.concat dir relpathstr) - in + let pathcands = dirs |> List.map (fun dir -> Filename.concat dir relpathstr) in match first_some resolve pathcands with - | Some(abspathstr) -> Ok(make_abs_path abspathstr) - | None -> Error(CannotFindLibraryFile(relpath, pathcands)) - - -let resolve_package_directory (main_module_name : string) = - let open ResultMonad in - let dirs = !satysfi_root_dirs in - let pathcands_local = - dirs |> List.map (fun dir -> - Filename.concat (Filename.concat dir "local/packages") main_module_name - ) - in - let pathcands_dist = - dirs |> List.map (fun dir -> - Filename.concat (Filename.concat dir "dist/packages") main_module_name - ) - in - match MyUtil.first_some resolve_directory (List.append pathcands_local pathcands_dist) with - | None -> err (List.append pathcands_local pathcands_dist) - | Some(p) -> return p + | None -> err (pathcands |> List.map make_abs_path) + | Some(pathstr) -> return @@ make_abs_path pathstr let resolve_local ~(extensions : string list) ~origin:(dir : string) ~relative:(s : string) = @@ -57,5 +30,5 @@ let resolve_local ~(extensions : string list) ~origin:(dir : string) ~relative:( let path_without_ext = Filename.concat dir s in let pathcands = extensions |> List.map (fun ext -> path_without_ext ^ ext) in match first_some resolve pathcands with - | None -> err @@ LocalFileNotFound{ relative = s; candidates = pathcands } + | None -> err (pathcands |> List.map make_abs_path) | Some(pathstr) -> return @@ make_abs_path pathstr diff --git a/src/config.mli b/src/config.mli index 7faef2d84..f3be5f2f6 100644 --- a/src/config.mli +++ b/src/config.mli @@ -1,11 +1,8 @@ open MyUtil -open ConfigError val initialize : string list -> unit -val resolve_lib_file : lib_path -> (abs_path, config_error) result +val resolve_lib_file : lib_path -> (abs_path, abs_path list) result -val resolve_package_directory : string -> (abs_path, string list) result - -val resolve_local : extensions:(string list) -> origin:string -> relative:string -> (abs_path, config_error) result +val resolve_local : extensions:(string list) -> origin:string -> relative:string -> (abs_path, abs_path list) result diff --git a/src/frontend/configError.ml b/src/frontend/configError.ml index 39322d403..01e2515ef 100644 --- a/src/frontend/configError.ml +++ b/src/frontend/configError.ml @@ -4,6 +4,29 @@ open Types open HorzBox +type yaml_error = + | ParseError of string + | FieldNotFound of YamlDecoder.context * string + | NotAFloat of YamlDecoder.context + | NotAString of YamlDecoder.context + | NotABool of YamlDecoder.context + | NotAnArray of YamlDecoder.context + | NotAnObject of YamlDecoder.context + | UnexpectedTag of YamlDecoder.context * string + | PackageNotFound of lib_path * abs_path list + | UnexpectedLanguage of string + +module YamlError = struct + type t = yaml_error + let parse_error s = ParseError(s) + let field_not_found context s = FieldNotFound(context, s) + let not_a_float context = NotAFloat(context) + let not_a_string context = NotAString(context) + let not_a_bool context = NotABool(context) + let not_an_array context = NotAnArray(context) + let not_an_object context = NotAnObject(context) +end + type config_error = | CyclicFileDependency of (abs_path * untyped_library_file) cycle | CannotReadFileOwingToSystem of string @@ -18,9 +41,9 @@ type config_error = } | PackageDirectoryNotFound of string list | PackageConfigNotFound of abs_path - | PackageConfigError of abs_path * YamlDecoder.error + | PackageConfigError of abs_path * yaml_error | LockConfigNotFound of abs_path - | LockConfigError of abs_path * YamlDecoder.error + | LockConfigError of abs_path * yaml_error | LockNameConflict of lock_name | DependencyOnUnknownLock of { depending : lock_name; @@ -35,17 +58,17 @@ type config_error = | NotAStringFile of abs_path * mono_type | NoMainModule of module_name | UnknownPackageDependency of Range.t * module_name - | CannotFindLibraryFile of lib_path * string list + | CannotFindLibraryFile of lib_path * abs_path list | LocalFileNotFound of { relative : string; - candidates : string list; + candidates : abs_path list; } type font_error = - | InvalidFontAbbrev of font_abbrev - | InvalidMathFontAbbrev of math_font_abbrev - | NotASingleFont of font_abbrev * abs_path - | NotATTCElement of font_abbrev * abs_path * int - | NotASingleMathFont of math_font_abbrev * abs_path - | NotATTCMathFont of math_font_abbrev * abs_path * int - | ConfigErrorAsToFont of config_error + | InvalidFontAbbrev of font_abbrev + | InvalidMathFontAbbrev of math_font_abbrev + | NotASingleFont of font_abbrev * abs_path + | NotATTCElement of font_abbrev * abs_path * int + | NotASingleMathFont of math_font_abbrev * abs_path + | NotATTCMathFont of math_font_abbrev * abs_path * int + | CannotFindLibraryFileAsToFont of lib_path * abs_path list diff --git a/src/frontend/fontInfo.ml b/src/frontend/fontInfo.ml index 0ab109383..3c9dd5a99 100644 --- a/src/frontend/fontInfo.ml +++ b/src/frontend/fontInfo.ml @@ -20,7 +20,8 @@ type font_definition = { let resolve_lib_file (relpath : lib_path) = - Config.resolve_lib_file relpath |> Result.map_error (fun e -> ConfigErrorAsToFont(e)) + Config.resolve_lib_file relpath + |> Result.map_error (fun candidates -> CannotFindLibraryFileAsToFont(relpath, candidates)) module FontAbbrevHashTable : sig @@ -431,40 +432,45 @@ let get_font_dictionary (pdf : Pdf.t) : Pdf.pdfobject = let initialize () = - let open ResultMonad in - FontAbbrevHashTable.initialize (); - MathFontAbbrevHashTable.initialize (); - let* abspath_S = Config.resolve_lib_file (make_lib_path "dist/unidata/Scripts.txt") in - let* abspath_EAW = Config.resolve_lib_file (make_lib_path "dist/unidata/EastAsianWidth.txt") in - ScriptDataMap.set_from_file abspath_S abspath_EAW; - let* abspath_LB = Config.resolve_lib_file (make_lib_path "dist/unidata/LineBreak.txt") in - LineBreakDataMap.set_from_file abspath_LB; - let font_hash_local = - match Config.resolve_lib_file (make_lib_path "local/hash/fonts.satysfi-hash") with - | Error(_) -> [] - | Ok(abspath) -> LoadFont.main abspath + let res = + let open ResultMonad in + FontAbbrevHashTable.initialize (); + MathFontAbbrevHashTable.initialize (); + let* abspath_S = resolve_lib_file (make_lib_path "dist/unidata/Scripts.txt") in + let* abspath_EAW = resolve_lib_file (make_lib_path "dist/unidata/EastAsianWidth.txt") in + ScriptDataMap.set_from_file abspath_S abspath_EAW; + let* abspath_LB = resolve_lib_file (make_lib_path "dist/unidata/LineBreak.txt") in + LineBreakDataMap.set_from_file abspath_LB; + let font_hash_local = + match Config.resolve_lib_file (make_lib_path "local/hash/fonts.satysfi-hash") with + | Error(_) -> [] + | Ok(abspath) -> LoadFont.main abspath + in + let* abspath_fonts = resolve_lib_file (make_lib_path "dist/hash/fonts.satysfi-hash") in + let font_hash_dist = LoadFont.main abspath_fonts in + let font_hash = List.append font_hash_local font_hash_dist in + if OptionState.does_show_fonts () then Logging.show_fonts font_hash; + font_hash |> List.iter (fun (abbrev, data) -> + match data with + | FontAccess.Single(relpath) -> FontAbbrevHashTable.add_single abbrev relpath + | FontAccess.Collection(relpath, i) -> FontAbbrevHashTable.add_ttc abbrev relpath i + ); + let math_font_hash_local = + match Config.resolve_lib_file (make_lib_path "local/hash/mathfonts.satysfi-hash") with + | Error(_) -> [] + | Ok(abspath) -> LoadFont.main abspath + in + let* abspath_mathfonts = resolve_lib_file (make_lib_path "dist/hash/mathfonts.satysfi-hash") in + let math_font_hash_dist = LoadFont.main abspath_mathfonts in + let math_font_hash = List.append math_font_hash_local math_font_hash_dist in + if OptionState.does_show_fonts () then Logging.show_math_fonts math_font_hash; + math_font_hash |> List.iter (fun (mfabbrev, data) -> + match data with + | FontAccess.Single(srcpath) -> MathFontAbbrevHashTable.add_single mfabbrev srcpath + | FontAccess.Collection(srcpath, i) -> MathFontAbbrevHashTable.add_ttc mfabbrev srcpath i + ); + return () in - let* abspath_fonts = Config.resolve_lib_file (make_lib_path "dist/hash/fonts.satysfi-hash") in - let font_hash_dist = LoadFont.main abspath_fonts in - let font_hash = List.append font_hash_local font_hash_dist in - if OptionState.does_show_fonts () then Logging.show_fonts font_hash; - font_hash |> List.iter (fun (abbrev, data) -> - match data with - | FontAccess.Single(relpath) -> FontAbbrevHashTable.add_single abbrev relpath - | FontAccess.Collection(relpath, i) -> FontAbbrevHashTable.add_ttc abbrev relpath i - ); - let math_font_hash_local = - match Config.resolve_lib_file (make_lib_path "local/hash/mathfonts.satysfi-hash") with - | Error(_) -> [] - | Ok(abspath) -> LoadFont.main abspath - in - let* abspath_mathfonts = Config.resolve_lib_file (make_lib_path "dist/hash/mathfonts.satysfi-hash") in - let math_font_hash_dist = LoadFont.main abspath_mathfonts in - let math_font_hash = List.append math_font_hash_local math_font_hash_dist in - if OptionState.does_show_fonts () then Logging.show_math_fonts math_font_hash; - math_font_hash |> List.iter (fun (mfabbrev, data) -> - match data with - | FontAccess.Single(srcpath) -> MathFontAbbrevHashTable.add_single mfabbrev srcpath - | FontAccess.Collection(srcpath, i) -> MathFontAbbrevHashTable.add_ttc mfabbrev srcpath i - ); - return () + match res with + | Ok(()) -> () + | Error(e) -> raise (FontInfoError(e)) diff --git a/src/frontend/fontInfo.mli b/src/frontend/fontInfo.mli index ecbb1e337..97e8bf4ee 100644 --- a/src/frontend/fontInfo.mli +++ b/src/frontend/fontInfo.mli @@ -8,7 +8,7 @@ exception FontInfoError of font_error type tag = string -val initialize : unit -> (unit, config_error) result +val initialize : unit -> unit val get_metrics_of_word : horz_string_info -> uchar_segment list -> OutputText.t * length * length * length diff --git a/src/frontend/lockConfig.ml b/src/frontend/lockConfig.ml index 05e338a51..aca69f347 100644 --- a/src/frontend/lockConfig.ml +++ b/src/frontend/lockConfig.ml @@ -11,23 +11,27 @@ type t = { } -let lock_location_decoder : abs_path YamlDecoder.t = - let open YamlDecoder in +module LockConfigDecoder = YamlDecoder.Make(YamlError) + + +let lock_location_decoder : abs_path LockConfigDecoder.t = + let open LockConfigDecoder in branch "type" [ "global" ==> begin get "path" string >>= fun s_libpath -> - match Config.resolve_lib_file (make_lib_path s_libpath) with - | Ok(abspath) -> succeed abspath - | Error(_e) -> failure (Printf.sprintf "locked package not found at '%s'" s_libpath) + let libpath = make_lib_path s_libpath in + match Config.resolve_lib_file libpath with + | Ok(abspath) -> succeed abspath + | Error(candidates) -> failure (fun _context -> PackageNotFound(libpath, candidates)) end; ] - ~on_error:(fun other -> - Printf.sprintf "unknown type '%s' for lock locations" other + ~other:(fun tag -> + failure (fun context -> UnexpectedTag(context, tag)) ) -let lock_decoder : lock_info YamlDecoder.t = - let open YamlDecoder in +let lock_decoder : lock_info LockConfigDecoder.t = + let open LockConfigDecoder in get "name" string >>= fun lock_name -> get "location" lock_location_decoder >>= fun lock_directory -> get_or_else "dependencies" (list string) [] >>= fun lock_dependencies -> @@ -38,8 +42,8 @@ let lock_decoder : lock_info YamlDecoder.t = } -let lock_config_decoder : t YamlDecoder.t = - let open YamlDecoder in +let lock_config_decoder : t LockConfigDecoder.t = + let open LockConfigDecoder in get_or_else "locks" (list lock_decoder) [] >>= fun locked_packages -> succeed { locked_packages; @@ -56,4 +60,5 @@ let load (abspath_lock_config : abs_path) : t ok = in let s = Core.In_channel.input_all inc in close_in inc; - YamlDecoder.run lock_config_decoder s |> Result.map_error (fun e -> LockConfigError(abspath_lock_config, e)) + LockConfigDecoder.run lock_config_decoder s + |> Result.map_error (fun e -> LockConfigError(abspath_lock_config, e)) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 45186a2fc..eb3412811 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -17,7 +17,7 @@ let reset () = if OptionState.is_text_mode () then return () else begin - let* () = FontInfo.initialize () in + FontInfo.initialize (); ImageInfo.initialize (); NamedDest.initialize (); return () @@ -769,6 +769,59 @@ let report_type_error = function ] +let show_yaml_context (context : YamlDecoder.context) = + match context with + | [] -> + "" + + | _ :: _ -> + let s_context = + let open YamlDecoder in + context |> List.map (function + | Field(field) -> Printf.sprintf ".%s" field + | Index(index) -> Printf.sprintf ".[%d]" index + ) |> String.concat "" + in + Printf.sprintf " (context: %s)" s_context + + +let make_yaml_error_lines = function + | ParseError(s) -> + [ NormalLine(Printf.sprintf "parse error: %s" s) ] + + | FieldNotFound(yctx, field) -> + [ NormalLine(Printf.sprintf "field '%s' not found%s" field (show_yaml_context yctx)) ] + + | NotAFloat(yctx) -> + [ NormalLine(Printf.sprintf "not a float value%s" (show_yaml_context yctx)) ] + + | NotAString(yctx) -> + [ NormalLine(Printf.sprintf "not a string value%s" (show_yaml_context yctx)) ] + + | NotABool(yctx) -> + [ NormalLine(Printf.sprintf "not a Boolean value%s" (show_yaml_context yctx)) ] + + | NotAnArray(yctx) -> + [ NormalLine(Printf.sprintf "not an array%s" (show_yaml_context yctx)) ] + + | NotAnObject(yctx) -> + [ NormalLine(Printf.sprintf "not an object%s" (show_yaml_context yctx)) ] + + | UnexpectedTag(yctx, tag) -> + [ NormalLine(Printf.sprintf "unexpected type tag '%s'%s" tag (show_yaml_context yctx)) ] + + | PackageNotFound(libpath, candidates) -> + let lines = + candidates |> List.map (fun abspath -> + DisplayLine(Printf.sprintf "- %s" (get_abs_path_string abspath)) + ) + in + (NormalLine(Printf.sprintf "package '%s' not found. candidates:" (get_lib_path_string libpath)) :: lines) + + | UnexpectedLanguage(s_language_version) -> + [ NormalLine(Printf.sprintf "unexpected language version '%s'" s_language_version) ] + + let report_config_error = function | NotADocumentFile(abspath_in, ty) -> let fname = convert_abs_path_to_show abspath_in in @@ -876,10 +929,10 @@ let report_config_error = function ] | PackageConfigError(abspath, e) -> - report_error Interface [ - NormalLine(Printf.sprintf "at %s:" (get_abs_path_string abspath)); - NormalLine(Printf.sprintf "package config error; %s" (YamlDecoder.show_error e)); - ] + report_error Interface (List.concat [ + [ NormalLine(Printf.sprintf "in %s: package config error;" (get_abs_path_string abspath)) ]; + make_yaml_error_lines e; + ]) | LockConfigNotFound(abspath) -> report_error Interface [ @@ -888,10 +941,10 @@ let report_config_error = function ] | LockConfigError(abspath, e) -> - report_error Interface [ - NormalLine(Printf.sprintf "at %s:" (get_abs_path_string abspath)); - NormalLine(Printf.sprintf "lock config error; %s" (YamlDecoder.show_error e)); - ] + report_error Interface (List.concat [ + [ NormalLine(Printf.sprintf "in %s: lock config error;" (get_abs_path_string abspath)) ]; + make_yaml_error_lines e; + ]) | LockNameConflict(lock_name) -> report_error Interface [ @@ -925,8 +978,8 @@ let report_config_error = function | CannotFindLibraryFile(libpath, candidate_paths) -> let lines = - candidate_paths |> List.map (fun path -> - DisplayLine(Printf.sprintf "- %s" path) + candidate_paths |> List.map (fun abspath -> + DisplayLine(Printf.sprintf "- %s" (get_abs_path_string abspath)) ) in report_error Interface @@ -934,8 +987,8 @@ let report_config_error = function | LocalFileNotFound{ relative; candidates } -> let lines = - candidates |> List.map (fun path -> - DisplayLine(Printf.sprintf "- %s" path) + candidates |> List.map (fun abspath -> + DisplayLine(Printf.sprintf "- %s" (get_abs_path_string abspath)) ) in report_error Interface @@ -985,8 +1038,14 @@ let report_font_error = function NormalLine("is not a TrueType collection or does not have a MATH table."); ] - | ConfigErrorAsToFont(e) -> - report_config_error e + | CannotFindLibraryFileAsToFont(libpath, candidates) -> + let lines = + candidates |> List.map (fun abspath -> + DisplayLine(Printf.sprintf "- %s" (get_abs_path_string abspath)) + ) + in + report_error Interface + (NormalLine(Printf.sprintf "cannot find '%s'. candidates:" (get_lib_path_string libpath)) :: lines) let error_log_environment suspended = diff --git a/src/frontend/openFileDependencyResolver.ml b/src/frontend/openFileDependencyResolver.ml index ec6aa0fef..87eeb2590 100644 --- a/src/frontend/openFileDependencyResolver.ml +++ b/src/frontend/openFileDependencyResolver.ml @@ -45,7 +45,10 @@ let get_header (extensions : string list) (curdir : string) (headerelem : header err @@ CannotUseHeaderUse(modident) | HeaderUseOf(modident, s_relpath) -> - let* abspath = Config.resolve_local ~extensions ~origin:curdir ~relative:s_relpath in + let* abspath = + Config.resolve_local ~extensions ~origin:curdir ~relative:s_relpath + |> Result.map_error (fun candidates -> LocalFileNotFound{ relative = s_relpath; candidates }) + in return @@ Local(modident, abspath) @@ -123,7 +126,11 @@ let register_document_file (extensions : string list) (abspath_in : abs_path) : let register_markdown_file (setting : string) (abspath_in : abs_path) : (PackageNameSet.t * untyped_document_file) ok = let open ResultMonad in Logging.begin_to_parse_file abspath_in; - let* abspath = Config.resolve_lib_file (make_lib_path (Filename.concat "dist/md" (setting ^ ".satysfi-md"))) in + let* abspath = + let libpath = make_lib_path (Filename.concat "dist/md" (setting ^ ".satysfi-md")) in + Config.resolve_lib_file libpath + |> Result.map_error (fun candidates -> CannotFindLibraryFile(libpath, candidates)) + in let (cmdrcd, depends) = LoadMDSetting.main abspath in (* TODO: make this monadic *) let* utast = match MyUtil.string_of_file abspath_in with diff --git a/src/frontend/packageConfig.ml b/src/frontend/packageConfig.ml index be12c76e5..4d0e4f327 100644 --- a/src/frontend/packageConfig.ml +++ b/src/frontend/packageConfig.ml @@ -31,8 +31,11 @@ type t = { } -let dependency_decoder : dependency_spec YamlDecoder.t = - let open YamlDecoder in +module PackageConfigDecoder = YamlDecoder.Make(YamlError) + + +let dependency_decoder : dependency_spec PackageConfigDecoder.t = + let open PackageConfigDecoder in get "package_name" string >>= fun depended_package_name -> succeed { depended_package_name; @@ -40,8 +43,8 @@ let dependency_decoder : dependency_spec YamlDecoder.t = } -let contents_decoder : package_contents YamlDecoder.t = - let open YamlDecoder in +let contents_decoder : package_contents PackageConfigDecoder.t = + let open PackageConfigDecoder in branch "type" [ "library" ==> begin get "main_module" string >>= fun main_module_name -> @@ -62,13 +65,13 @@ let contents_decoder : package_contents YamlDecoder.t = } end; ] - ~on_error:(fun other -> - Printf.sprintf "unsupported type '%s' for specifying package contents" other + ~other:(fun tag -> + failure (fun context -> UnexpectedTag(context, tag)) ) -let config_decoder : t YamlDecoder.t = - let open YamlDecoder in +let config_decoder : t PackageConfigDecoder.t = + let open PackageConfigDecoder in get "package_name" string >>= fun package_name -> get "version" string >>= fun package_version -> get "contents" contents_decoder >>= fun package_contents -> @@ -80,11 +83,11 @@ let config_decoder : t YamlDecoder.t = let config_decoder = - let open YamlDecoder in + let open PackageConfigDecoder in get "language" string >>= fun language -> match language with | "0.1.0" -> config_decoder - | _ -> failure (Printf.sprintf "unknown language version '%s'" language) + | _ -> failure (fun _context -> UnexpectedLanguage(language)) let load (absdir_package : abs_path) : t ok = @@ -100,4 +103,5 @@ let load (absdir_package : abs_path) : t ok = in let s = Core.In_channel.input_all inc in close_in inc; - YamlDecoder.run config_decoder s |> Result.map_error (fun e -> PackageConfigError(abspath_config, e)) + PackageConfigDecoder.run config_decoder s + |> Result.map_error (fun e -> PackageConfigError(abspath_config, e)) diff --git a/src/frontend/primitives.cppo.ml b/src/frontend/primitives.cppo.ml index cf9fa4b3b..b4a005836 100644 --- a/src/frontend/primitives.cppo.ml +++ b/src/frontend/primitives.cppo.ml @@ -7,6 +7,8 @@ open GraphicBase open SyntaxBase open Types open StaticEnv +open ConfigError + (* -- type IDs for predefined data types -- *) let vid_option = TypeID.fresh "option" @@ -737,10 +739,15 @@ let make_environments table = (tyenv, env) +let resolve_lib_file (libpath : lib_path) = + Config.resolve_lib_file libpath + |> Result.map_error (fun candidates -> CannotFindLibraryFile(libpath, candidates)) + + let make_pdf_mode_environments () = let open ResultMonad in - let* abspath_default_font = Config.resolve_lib_file (make_lib_path "dist/hash/default-font.satysfi-hash") in - let* abspath_hyphen = Config.resolve_lib_file (make_lib_path "dist/hyph/english.satysfi-hyph") in + let* abspath_default_font = resolve_lib_file (make_lib_path "dist/hash/default-font.satysfi-hash") in + let* abspath_hyphen = resolve_lib_file (make_lib_path "dist/hyph/english.satysfi-hyph") in default_font_scheme_ref := SetDefaultFont.main abspath_default_font; default_hyphen_dictionary := LoadHyph.main abspath_hyphen; (* TODO: should depend on the current language *) diff --git a/src/frontend/yamlDecoder.ml b/src/frontend/yamlDecoder.ml index 1c1f9f945..a93d2d82f 100644 --- a/src/frontend/yamlDecoder.ml +++ b/src/frontend/yamlDecoder.ml @@ -9,183 +9,170 @@ type context_element = type context = context_element list -type error_main = - | FieldNotFound of string - | NotAFloat - | NotAString - | NotABool - | NotAnArray - | NotAnObject - | OtherMessage of string -type error = - context * error_main +module type ErrorType = sig + type t + val parse_error : string -> t -let show_error ((context, errmain) : error) = - let s_main = - match errmain with - | FieldNotFound(field) -> Printf.sprintf "field '%s' not found" field - | NotAFloat -> Printf.sprintf "not a float value" - | NotAString -> Printf.sprintf "not a string value" - | NotABool -> Printf.sprintf "not a Boolean value" - | NotAnArray -> Printf.sprintf "not an array" - | NotAnObject -> Printf.sprintf "not an object" - | OtherMessage(msg) -> Printf.sprintf "%s" msg - in - match context with - | [] -> - s_main + val field_not_found : context -> string -> t - | _ :: _ -> - let s_context = - context |> List.map (function - | Field(field) -> Printf.sprintf ".%s" field - | Index(index) -> Printf.sprintf ".[%d]" index - ) |> String.concat "" - in - Printf.sprintf "%s (context: %s)" s_main s_context + val not_a_float : context -> t + val not_a_string : context -> t -type 'a t = context_element Alist.t * Yaml.value -> ('a, error) result + val not_a_bool : context -> t + val not_an_array : context -> t -let run (d : 'a t) (s : string) : ('a, error) result = - let open ResultMonad in - match Yaml.of_string s with - | Ok(yval) -> d (Alist.empty, yval) - | Error(`Msg(s)) -> err ([], OtherMessage(s)) + val not_an_object : context -> t +end -let succeed (a : 'a) : 'a t = - fun _ -> Ok(a) +module Make (Err : ErrorType) = struct -let failure (msg : string) : 'a t = - fun (context, _) -> Error(Alist.to_list context, OtherMessage(msg)) + type 'a t = context_element Alist.t * Yaml.value -> ('a, Err.t) result -let bind (d : 'a t) (df : 'a -> 'b t) : 'b t = - fun s -> - match d s with - | Ok(a) -> df a s - | Error(_) as e -> e + let run (d : 'a t) (s : string) : ('a, Err.t) result = + let open ResultMonad in + match Yaml.of_string s with + | Ok(yval) -> d (Alist.empty, yval) + | Error(`Msg(s)) -> err (Err.parse_error s) -let ( >>= ) = bind + let succeed (a : 'a) : 'a t = + fun _ -> Ok(a) -let get_scheme (field : string) (d : 'a t) (k_absent : context_element Alist.t -> ('a, error) result) : 'a t = - fun (context, yval) -> - let open ResultMonad in - match yval with - | `O(keyvals) -> - begin - match - keyvals |> List.find_opt (fun (k, _v) -> String.equal k field) - (* According to the specification of YAML, every key can occur at most once here. *) - with - | None -> k_absent context - | Some((k, v)) -> d (Alist.extend context (Field(k)), v) - end + let failure (errf : context -> Err.t) : 'a t = + fun (context, _) -> Error(errf (Alist.to_list context)) - | _ -> - err (Alist.to_list context, NotAnObject) + let bind (d : 'a t) (df : 'a -> 'b t) : 'b t = + fun s -> + match d s with + | Ok(a) -> df a s + | Error(_) as e -> e -let get (field : string) (d : 'a t) : 'a t = - let open ResultMonad in - get_scheme field d (fun context -> err (Alist.to_list context, FieldNotFound(field))) + let ( >>= ) = bind -let get_opt (field : string) (d : 'a t) : ('a option) t = - let d_some = - d >>= fun v -> succeed (Some(v)) - in - let open ResultMonad in - get_scheme field d_some (fun _ -> return None) + let get_scheme (field : string) (d : 'a t) (k_absent : context_element Alist.t -> ('a, Err.t) result) : 'a t = + fun (context, yval) -> + let open ResultMonad in + match yval with + | `O(keyvals) -> + begin + match + keyvals |> List.find_opt (fun (k, _v) -> String.equal k field) + (* According to the specification of YAML, every key can occur at most once here. *) + with + | None -> k_absent context + | Some((k, v)) -> d (Alist.extend context (Field(k)), v) + end -let get_or_else (field : string) (d : 'a t) (default : 'a) : 'a t = - let open ResultMonad in - get_scheme field d (fun _ -> return default) + | _ -> + err @@ Err.not_an_object (Alist.to_list context) -let number : float t = - fun (context, yval) -> + let get (field : string) (d : 'a t) : 'a t = let open ResultMonad in - match yval with - | `Float(x) -> return x - | _ -> err (Alist.to_list context, NotAFloat) + get_scheme field d (fun context -> err @@ Err.field_not_found (Alist.to_list context) field) -let string : string t = - fun (context, yval) -> + let get_opt (field : string) (d : 'a t) : ('a option) t = + let d_some = + d >>= fun v -> succeed (Some(v)) + in let open ResultMonad in - match yval with - | `String(x) -> return x - | _ -> err (Alist.to_list context, NotAString) + get_scheme field d_some (fun _ -> return None) -let bool : bool t = - fun (context, yval) -> + let get_or_else (field : string) (d : 'a t) (default : 'a) : 'a t = let open ResultMonad in - match yval with - | `Bool(x) -> return x - | _ -> err (Alist.to_list context, NotABool) + get_scheme field d (fun _ -> return default) -let list (d : 'a t) : ('a list) t = - fun (context, yval) -> - let open ResultMonad in - match yval with - | `A(yvals) -> - yvals |> foldM (fun (index, acc) yval -> - d (Alist.extend context (Index(index)), yval) >>= fun a -> - return (index + 1, Alist.extend acc a) - ) (0, Alist.empty) >>= fun (_, acc) -> - return (Alist.to_list acc) + let number : float t = + fun (context, yval) -> + let open ResultMonad in + match yval with + | `Float(x) -> return x + | _ -> err @@ Err.not_a_float (Alist.to_list context) + - | _ -> - err (Alist.to_list context, NotAnArray) + let string : string t = + fun (context, yval) -> + let open ResultMonad in + match yval with + | `String(x) -> return x + | _ -> err @@ Err.not_a_string (Alist.to_list context) -type 'a branch = string * 'a t + let bool : bool t = + fun (context, yval) -> + let open ResultMonad in + match yval with + | `Bool(x) -> return x + | _ -> err @@ Err.not_a_bool (Alist.to_list context) -let branch (field : string) (branches : ('a branch) list) ~on_error:(errorf : string -> string) : 'a t = - get field string >>= fun tag_gotten -> - match - branches |> List.find_map (fun (tag_candidate, d) -> - if String.equal tag_gotten tag_candidate then Some(d) else None - ) - with - | None -> failure (errorf tag_gotten) - | Some(d) -> d + let list (d : 'a t) : ('a list) t = + fun (context, yval) -> + let open ResultMonad in + match yval with + | `A(yvals) -> + yvals |> foldM (fun (index, acc) yval -> + d (Alist.extend context (Index(index)), yval) >>= fun a -> + return (index + 1, Alist.extend acc a) + ) (0, Alist.empty) >>= fun (_, acc) -> + return (Alist.to_list acc) + | _ -> + err @@ Err.not_an_object (Alist.to_list context) -let ( ==> ) (label : string) (d : 'a t) : 'a branch = (label, d) + type 'a branch = string * 'a t -let map (f : 'a -> 'b) (d : 'a t) : 'b t = - let open ResultMonad in - fun yval -> - d yval >>= fun a -> - return (f a) + let branch (field : string) (branches : ('a branch) list) ~(other : string -> 'a t) : 'a t = + get field string >>= fun tag_gotten -> + match + branches |> List.find_map (fun (tag_candidate, d) -> + if String.equal tag_gotten tag_candidate then Some(d) else None + ) + with + | None -> other tag_gotten + | Some(d) -> d -let map2 (f : 'a1 -> 'a2 -> 'b) (d1 : 'a1 t) (d2 : 'a2 t) : 'b t = - let open ResultMonad in - fun yval -> - d1 yval >>= fun a1 -> - d2 yval >>= fun a2 -> - return (f a1 a2) + let ( ==> ) (label : string) (d : 'a t) : 'a branch = (label, d) + + + let map (f : 'a -> 'b) (d : 'a t) : 'b t = + let open ResultMonad in + fun yval -> + d yval >>= fun a -> + return (f a) + + + let map2 (f : 'a1 -> 'a2 -> 'b) (d1 : 'a1 t) (d2 : 'a2 t) : 'b t = + let open ResultMonad in + fun yval -> + d1 yval >>= fun a1 -> + d2 yval >>= fun a2 -> + return (f a1 a2) + + + let map3 (f : 'a1 -> 'a2 -> 'a3 -> 'b) (d1 : 'a1 t) (d2 : 'a2 t) (d3 : 'a3 t) : 'b t = + let open ResultMonad in + fun yval -> + d1 yval >>= fun a1 -> + d2 yval >>= fun a2 -> + d3 yval >>= fun a3 -> + return (f a1 a2 a3) -let map3 (f : 'a1 -> 'a2 -> 'a3 -> 'b) (d1 : 'a1 t) (d2 : 'a2 t) (d3 : 'a3 t) : 'b t = - let open ResultMonad in - fun yval -> - d1 yval >>= fun a1 -> - d2 yval >>= fun a2 -> - d3 yval >>= fun a3 -> - return (f a1 a2 a3) +end diff --git a/src/frontend/yamlDecoder.mli b/src/frontend/yamlDecoder.mli index aacc9c618..89deb6550 100644 --- a/src/frontend/yamlDecoder.mli +++ b/src/frontend/yamlDecoder.mli @@ -1,42 +1,65 @@ -type error +type context_element = + | Field of string + | Index of int -val show_error : error -> string +type context = + context_element list -type 'a t +module type ErrorType = sig + type t -val run : 'a t -> string -> ('a, error) result + val parse_error : string -> t -val succeed : 'a -> 'a t + val field_not_found : context -> string -> t -val failure : string -> 'a t + val not_a_float : context -> t -val bind : 'a t -> ('a -> 'b t) -> 'b t + val not_a_string : context -> t -val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t + val not_a_bool : context -> t -val get : string -> 'a t -> 'a t + val not_an_array : context -> t -val get_opt : string -> 'a t -> ('a option) t + val not_an_object : context -> t +end -val get_or_else : string -> 'a t -> 'a -> 'a t +module Make (Err : ErrorType) : sig + type 'a t -val number : float t + val run : 'a t -> string -> ('a, Err.t) result -val string : string t + val succeed : 'a -> 'a t -val bool : bool t + val failure : (context -> Err.t) -> 'a t -val list : 'a t -> ('a list) t + val bind : 'a t -> ('a -> 'b t) -> 'b t -type 'a branch + val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t -val branch : string -> ('a branch) list -> on_error:(string -> string) -> 'a t + val get : string -> 'a t -> 'a t -val ( ==> ) : string -> 'a t -> 'a branch + val get_opt : string -> 'a t -> ('a option) t -val map : ('a -> 'b) -> 'a t -> 'b t + val get_or_else : string -> 'a t -> 'a -> 'a t -val map2 : ('a1 -> 'a2 -> 'b) -> 'a1 t -> 'a2 t -> 'b t + val number : float t -val map3 : ('a1 -> 'a2 -> 'a3 -> 'b) -> 'a1 t -> 'a2 t -> 'a3 t -> 'b t + val string : string t + + val bool : bool t + + val list : 'a t -> ('a list) t + + type 'a branch + + val branch : string -> ('a branch) list -> other:(string -> 'a t) -> 'a t + + val ( ==> ) : string -> 'a t -> 'a branch + + val map : ('a -> 'b) -> 'a t -> 'b t + + val map2 : ('a1 -> 'a2 -> 'b) -> 'a1 t -> 'a2 t -> 'b t + + val map3 : ('a1 -> 'a2 -> 'a3 -> 'b) -> 'a1 t -> 'a2 t -> 'a3 t -> 'b t +end From 56df5254f5286ff938e52007dea3e8c792384e94 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 2 Nov 2022 19:33:41 +0900 Subject: [PATCH 057/288] move 'stdlib' --- demo/demo.satysfi-lock | 2 +- doc/doc-lang.satysfi-lock | 2 +- doc/doc-primitives.satysfi-lock | 2 +- doc/math1.satysfi-lock | 2 +- .../dist/packages/{Stdlib => stdlib/stdlib.0.0.1}/satysfi.yaml | 0 .../packages/{Stdlib => stdlib/stdlib.0.0.1}/src/color.satyh | 0 .../packages/{Stdlib => stdlib/stdlib.0.0.1}/src/deco.satyh | 0 .../packages/{Stdlib => stdlib/stdlib.0.0.1}/src/geom.satyh | 0 .../dist/packages/{Stdlib => stdlib/stdlib.0.0.1}/src/gr.satyh | 0 .../packages/{Stdlib => stdlib/stdlib.0.0.1}/src/hdecoset.satyh | 0 .../packages/{Stdlib => stdlib/stdlib.0.0.1}/src/list.satyg | 0 .../packages/{Stdlib => stdlib/stdlib.0.0.1}/src/option.satyg | 0 .../{Stdlib => stdlib/stdlib.0.0.1}/src/paper-size.satyh | 0 .../{Stdlib => stdlib/stdlib.0.0.1}/src/pervasives.satyh | 0 .../packages/{Stdlib => stdlib/stdlib.0.0.1}/src/stdlib.satyh | 0 .../packages/{Stdlib => stdlib/stdlib.0.0.1}/src/vdecoset.satyh | 0 tests/clip.satysfi-lock | 2 +- tests/glue1.satysfi-lock | 2 +- tests/images/test.satysfi-lock | 2 +- tests/macro1.satysfi-lock | 2 +- tests/math-typefaces.satysfi-lock | 2 +- tests/math2.satysfi-lock | 2 +- tests/md/test.satysfi-lock | 2 +- tests/refactor1.satysfi-lock | 2 +- tests/refactor2.satysfi-lock | 2 +- tests/refactor3.satysfi-lock | 2 +- tests/refactor5.satysfi-lock | 2 +- tests/staged1.satysfi-lock | 2 +- 28 files changed, 16 insertions(+), 16 deletions(-) rename lib-satysfi/dist/packages/{Stdlib => stdlib/stdlib.0.0.1}/satysfi.yaml (100%) rename lib-satysfi/dist/packages/{Stdlib => stdlib/stdlib.0.0.1}/src/color.satyh (100%) rename lib-satysfi/dist/packages/{Stdlib => stdlib/stdlib.0.0.1}/src/deco.satyh (100%) rename lib-satysfi/dist/packages/{Stdlib => stdlib/stdlib.0.0.1}/src/geom.satyh (100%) rename lib-satysfi/dist/packages/{Stdlib => stdlib/stdlib.0.0.1}/src/gr.satyh (100%) rename lib-satysfi/dist/packages/{Stdlib => stdlib/stdlib.0.0.1}/src/hdecoset.satyh (100%) rename lib-satysfi/dist/packages/{Stdlib => stdlib/stdlib.0.0.1}/src/list.satyg (100%) rename lib-satysfi/dist/packages/{Stdlib => stdlib/stdlib.0.0.1}/src/option.satyg (100%) rename lib-satysfi/dist/packages/{Stdlib => stdlib/stdlib.0.0.1}/src/paper-size.satyh (100%) rename lib-satysfi/dist/packages/{Stdlib => stdlib/stdlib.0.0.1}/src/pervasives.satyh (100%) rename lib-satysfi/dist/packages/{Stdlib => stdlib/stdlib.0.0.1}/src/stdlib.satyh (100%) rename lib-satysfi/dist/packages/{Stdlib => stdlib/stdlib.0.0.1}/src/vdecoset.satyh (100%) diff --git a/demo/demo.satysfi-lock b/demo/demo.satysfi-lock index daf820580..e5205e305 100644 --- a/demo/demo.satysfi-lock +++ b/demo/demo.satysfi-lock @@ -2,7 +2,7 @@ locks: - name: "stdlib.0.0.1" location: type: "global" - path: "./dist/packages/Stdlib/" + path: "./dist/packages/stdlib/stdlib.0.0.1/" - name: "math.0.0.1" location: diff --git a/doc/doc-lang.satysfi-lock b/doc/doc-lang.satysfi-lock index 49b977284..78c69596a 100644 --- a/doc/doc-lang.satysfi-lock +++ b/doc/doc-lang.satysfi-lock @@ -2,7 +2,7 @@ locks: - name: "stdlib.0.0.1" location: type: "global" - path: "./dist/packages/Stdlib/" + path: "./dist/packages/stdlib/stdlib.0.0.1/" - name: "math.0.0.1" location: diff --git a/doc/doc-primitives.satysfi-lock b/doc/doc-primitives.satysfi-lock index 53d5f1b1d..b73f14a93 100644 --- a/doc/doc-primitives.satysfi-lock +++ b/doc/doc-primitives.satysfi-lock @@ -2,7 +2,7 @@ locks: - name: "stdlib.0.0.1" location: type: "global" - path: "./dist/packages/Stdlib/" + path: "./dist/packages/stdlib/stdlib.0.0.1/" - name: "math.0.0.1" location: diff --git a/doc/math1.satysfi-lock b/doc/math1.satysfi-lock index 3b016e3cd..bbd0f7b67 100644 --- a/doc/math1.satysfi-lock +++ b/doc/math1.satysfi-lock @@ -2,7 +2,7 @@ locks: - name: "stdlib.0.0.1" location: type: "global" - path: "./dist/packages/Stdlib/" + path: "./dist/packages/stdlib/stdlib.0.0.1/" - name: "math.0.0.1" location: diff --git a/lib-satysfi/dist/packages/Stdlib/satysfi.yaml b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/Stdlib/satysfi.yaml rename to lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/Stdlib/src/color.satyh b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/color.satyh similarity index 100% rename from lib-satysfi/dist/packages/Stdlib/src/color.satyh rename to lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/color.satyh diff --git a/lib-satysfi/dist/packages/Stdlib/src/deco.satyh b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/deco.satyh similarity index 100% rename from lib-satysfi/dist/packages/Stdlib/src/deco.satyh rename to lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/deco.satyh diff --git a/lib-satysfi/dist/packages/Stdlib/src/geom.satyh b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/geom.satyh similarity index 100% rename from lib-satysfi/dist/packages/Stdlib/src/geom.satyh rename to lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/geom.satyh diff --git a/lib-satysfi/dist/packages/Stdlib/src/gr.satyh b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/gr.satyh similarity index 100% rename from lib-satysfi/dist/packages/Stdlib/src/gr.satyh rename to lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/gr.satyh diff --git a/lib-satysfi/dist/packages/Stdlib/src/hdecoset.satyh b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/hdecoset.satyh similarity index 100% rename from lib-satysfi/dist/packages/Stdlib/src/hdecoset.satyh rename to lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/hdecoset.satyh diff --git a/lib-satysfi/dist/packages/Stdlib/src/list.satyg b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/list.satyg similarity index 100% rename from lib-satysfi/dist/packages/Stdlib/src/list.satyg rename to lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/list.satyg diff --git a/lib-satysfi/dist/packages/Stdlib/src/option.satyg b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/option.satyg similarity index 100% rename from lib-satysfi/dist/packages/Stdlib/src/option.satyg rename to lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/option.satyg diff --git a/lib-satysfi/dist/packages/Stdlib/src/paper-size.satyh b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/paper-size.satyh similarity index 100% rename from lib-satysfi/dist/packages/Stdlib/src/paper-size.satyh rename to lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/paper-size.satyh diff --git a/lib-satysfi/dist/packages/Stdlib/src/pervasives.satyh b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/pervasives.satyh similarity index 100% rename from lib-satysfi/dist/packages/Stdlib/src/pervasives.satyh rename to lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/pervasives.satyh diff --git a/lib-satysfi/dist/packages/Stdlib/src/stdlib.satyh b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/stdlib.satyh similarity index 100% rename from lib-satysfi/dist/packages/Stdlib/src/stdlib.satyh rename to lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/stdlib.satyh diff --git a/lib-satysfi/dist/packages/Stdlib/src/vdecoset.satyh b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/vdecoset.satyh similarity index 100% rename from lib-satysfi/dist/packages/Stdlib/src/vdecoset.satyh rename to lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/vdecoset.satyh diff --git a/tests/clip.satysfi-lock b/tests/clip.satysfi-lock index 830e8a1b7..cad9aaf40 100644 --- a/tests/clip.satysfi-lock +++ b/tests/clip.satysfi-lock @@ -2,7 +2,7 @@ locks: - name: "stdlib.0.0.1" location: type: "global" - path: "./dist/packages/Stdlib/" + path: "./dist/packages/stdlib/stdlib.0.0.1/" - name: "math.0.0.1" location: diff --git a/tests/glue1.satysfi-lock b/tests/glue1.satysfi-lock index 830e8a1b7..cad9aaf40 100644 --- a/tests/glue1.satysfi-lock +++ b/tests/glue1.satysfi-lock @@ -2,7 +2,7 @@ locks: - name: "stdlib.0.0.1" location: type: "global" - path: "./dist/packages/Stdlib/" + path: "./dist/packages/stdlib/stdlib.0.0.1/" - name: "math.0.0.1" location: diff --git a/tests/images/test.satysfi-lock b/tests/images/test.satysfi-lock index eacffbebe..9dec30ecf 100644 --- a/tests/images/test.satysfi-lock +++ b/tests/images/test.satysfi-lock @@ -2,7 +2,7 @@ locks: - name: "stdlib.0.0.1" location: type: "global" - path: "./dist/packages/Stdlib/" + path: "./dist/packages/stdlib/stdlib.0.0.1/" - name: "math.0.0.1" location: diff --git a/tests/macro1.satysfi-lock b/tests/macro1.satysfi-lock index 15107b5f8..037dab314 100644 --- a/tests/macro1.satysfi-lock +++ b/tests/macro1.satysfi-lock @@ -2,7 +2,7 @@ locks: - name: "stdlib.0.0.1" location: type: "global" - path: "./dist/packages/Stdlib/" + path: "./dist/packages/stdlib/stdlib.0.0.1/" - name: "math.0.0.1" location: diff --git a/tests/math-typefaces.satysfi-lock b/tests/math-typefaces.satysfi-lock index 9e737f9b8..240b97dbc 100644 --- a/tests/math-typefaces.satysfi-lock +++ b/tests/math-typefaces.satysfi-lock @@ -2,7 +2,7 @@ locks: - name: "stdlib.0.0.1" location: type: "global" - path: "./dist/packages/Stdlib/" + path: "./dist/packages/stdlib/stdlib.0.0.1/" - name: "math.0.0.1" location: diff --git a/tests/math2.satysfi-lock b/tests/math2.satysfi-lock index 830e8a1b7..cad9aaf40 100644 --- a/tests/math2.satysfi-lock +++ b/tests/math2.satysfi-lock @@ -2,7 +2,7 @@ locks: - name: "stdlib.0.0.1" location: type: "global" - path: "./dist/packages/Stdlib/" + path: "./dist/packages/stdlib/stdlib.0.0.1/" - name: "math.0.0.1" location: diff --git a/tests/md/test.satysfi-lock b/tests/md/test.satysfi-lock index 9a79789f7..e652c21c5 100644 --- a/tests/md/test.satysfi-lock +++ b/tests/md/test.satysfi-lock @@ -2,7 +2,7 @@ locks: - name: "stdlib.0.0.1" location: type: "global" - path: "./dist/packages/Stdlib/" + path: "./dist/packages/stdlib/stdlib.0.0.1/" - name: "math.0.0.1" location: diff --git a/tests/refactor1.satysfi-lock b/tests/refactor1.satysfi-lock index 830e8a1b7..cad9aaf40 100644 --- a/tests/refactor1.satysfi-lock +++ b/tests/refactor1.satysfi-lock @@ -2,7 +2,7 @@ locks: - name: "stdlib.0.0.1" location: type: "global" - path: "./dist/packages/Stdlib/" + path: "./dist/packages/stdlib/stdlib.0.0.1/" - name: "math.0.0.1" location: diff --git a/tests/refactor2.satysfi-lock b/tests/refactor2.satysfi-lock index 830e8a1b7..cad9aaf40 100644 --- a/tests/refactor2.satysfi-lock +++ b/tests/refactor2.satysfi-lock @@ -2,7 +2,7 @@ locks: - name: "stdlib.0.0.1" location: type: "global" - path: "./dist/packages/Stdlib/" + path: "./dist/packages/stdlib/stdlib.0.0.1/" - name: "math.0.0.1" location: diff --git a/tests/refactor3.satysfi-lock b/tests/refactor3.satysfi-lock index 830e8a1b7..cad9aaf40 100644 --- a/tests/refactor3.satysfi-lock +++ b/tests/refactor3.satysfi-lock @@ -2,7 +2,7 @@ locks: - name: "stdlib.0.0.1" location: type: "global" - path: "./dist/packages/Stdlib/" + path: "./dist/packages/stdlib/stdlib.0.0.1/" - name: "math.0.0.1" location: diff --git a/tests/refactor5.satysfi-lock b/tests/refactor5.satysfi-lock index 830e8a1b7..cad9aaf40 100644 --- a/tests/refactor5.satysfi-lock +++ b/tests/refactor5.satysfi-lock @@ -2,7 +2,7 @@ locks: - name: "stdlib.0.0.1" location: type: "global" - path: "./dist/packages/Stdlib/" + path: "./dist/packages/stdlib/stdlib.0.0.1/" - name: "math.0.0.1" location: diff --git a/tests/staged1.satysfi-lock b/tests/staged1.satysfi-lock index 49b977284..78c69596a 100644 --- a/tests/staged1.satysfi-lock +++ b/tests/staged1.satysfi-lock @@ -2,7 +2,7 @@ locks: - name: "stdlib.0.0.1" location: type: "global" - path: "./dist/packages/Stdlib/" + path: "./dist/packages/stdlib/stdlib.0.0.1/" - name: "math.0.0.1" location: From 255c55e42a3acefe0319b5b96dbb6767dde90272 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 2 Nov 2022 19:38:29 +0900 Subject: [PATCH 058/288] move 'math' --- demo/demo.satysfi-lock | 2 +- doc/doc-lang.satysfi-lock | 2 +- doc/doc-primitives.satysfi-lock | 2 +- doc/math1.satysfi-lock | 2 +- .../dist/packages/{Math => math/math.0.0.1}/satysfi.yaml | 0 .../dist/packages/{Math => math/math.0.0.1}/src/math.satyh | 0 tests/clip.satysfi-lock | 2 +- tests/glue1.satysfi-lock | 2 +- tests/images/test.satysfi-lock | 2 +- tests/macro1.satysfi-lock | 2 +- tests/math-typefaces.satysfi-lock | 2 +- tests/math2.satysfi-lock | 2 +- tests/md/test.satysfi-lock | 2 +- tests/refactor1.satysfi-lock | 2 +- tests/refactor2.satysfi-lock | 2 +- tests/refactor3.satysfi-lock | 2 +- tests/refactor5.satysfi-lock | 2 +- tests/staged1.satysfi-lock | 2 +- 18 files changed, 16 insertions(+), 16 deletions(-) rename lib-satysfi/dist/packages/{Math => math/math.0.0.1}/satysfi.yaml (100%) rename lib-satysfi/dist/packages/{Math => math/math.0.0.1}/src/math.satyh (100%) diff --git a/demo/demo.satysfi-lock b/demo/demo.satysfi-lock index e5205e305..3410ae8cc 100644 --- a/demo/demo.satysfi-lock +++ b/demo/demo.satysfi-lock @@ -7,7 +7,7 @@ locks: - name: "math.0.0.1" location: type: "global" - path: "./dist/packages/Math/" + path: "./dist/packages/math/math.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/doc/doc-lang.satysfi-lock b/doc/doc-lang.satysfi-lock index 78c69596a..f8a2a943f 100644 --- a/doc/doc-lang.satysfi-lock +++ b/doc/doc-lang.satysfi-lock @@ -7,7 +7,7 @@ locks: - name: "math.0.0.1" location: type: "global" - path: "./dist/packages/Math/" + path: "./dist/packages/math/math.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/doc/doc-primitives.satysfi-lock b/doc/doc-primitives.satysfi-lock index b73f14a93..2cd66e3f9 100644 --- a/doc/doc-primitives.satysfi-lock +++ b/doc/doc-primitives.satysfi-lock @@ -7,7 +7,7 @@ locks: - name: "math.0.0.1" location: type: "global" - path: "./dist/packages/Math/" + path: "./dist/packages/math/math.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/doc/math1.satysfi-lock b/doc/math1.satysfi-lock index bbd0f7b67..cda5d702c 100644 --- a/doc/math1.satysfi-lock +++ b/doc/math1.satysfi-lock @@ -7,7 +7,7 @@ locks: - name: "math.0.0.1" location: type: "global" - path: "./dist/packages/Math/" + path: "./dist/packages/math/math.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/lib-satysfi/dist/packages/Math/satysfi.yaml b/lib-satysfi/dist/packages/math/math.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/Math/satysfi.yaml rename to lib-satysfi/dist/packages/math/math.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/Math/src/math.satyh b/lib-satysfi/dist/packages/math/math.0.0.1/src/math.satyh similarity index 100% rename from lib-satysfi/dist/packages/Math/src/math.satyh rename to lib-satysfi/dist/packages/math/math.0.0.1/src/math.satyh diff --git a/tests/clip.satysfi-lock b/tests/clip.satysfi-lock index cad9aaf40..002661c22 100644 --- a/tests/clip.satysfi-lock +++ b/tests/clip.satysfi-lock @@ -7,6 +7,6 @@ locks: - name: "math.0.0.1" location: type: "global" - path: "./dist/packages/Math/" + path: "./dist/packages/math/math.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/tests/glue1.satysfi-lock b/tests/glue1.satysfi-lock index cad9aaf40..002661c22 100644 --- a/tests/glue1.satysfi-lock +++ b/tests/glue1.satysfi-lock @@ -7,6 +7,6 @@ locks: - name: "math.0.0.1" location: type: "global" - path: "./dist/packages/Math/" + path: "./dist/packages/math/math.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/tests/images/test.satysfi-lock b/tests/images/test.satysfi-lock index 9dec30ecf..0f9f0e767 100644 --- a/tests/images/test.satysfi-lock +++ b/tests/images/test.satysfi-lock @@ -7,7 +7,7 @@ locks: - name: "math.0.0.1" location: type: "global" - path: "./dist/packages/Math/" + path: "./dist/packages/math/math.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/tests/macro1.satysfi-lock b/tests/macro1.satysfi-lock index 037dab314..148365184 100644 --- a/tests/macro1.satysfi-lock +++ b/tests/macro1.satysfi-lock @@ -7,7 +7,7 @@ locks: - name: "math.0.0.1" location: type: "global" - path: "./dist/packages/Math/" + path: "./dist/packages/math/math.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/tests/math-typefaces.satysfi-lock b/tests/math-typefaces.satysfi-lock index 240b97dbc..cf4a266c9 100644 --- a/tests/math-typefaces.satysfi-lock +++ b/tests/math-typefaces.satysfi-lock @@ -7,7 +7,7 @@ locks: - name: "math.0.0.1" location: type: "global" - path: "./dist/packages/Math/" + path: "./dist/packages/math/math.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/tests/math2.satysfi-lock b/tests/math2.satysfi-lock index cad9aaf40..002661c22 100644 --- a/tests/math2.satysfi-lock +++ b/tests/math2.satysfi-lock @@ -7,6 +7,6 @@ locks: - name: "math.0.0.1" location: type: "global" - path: "./dist/packages/Math/" + path: "./dist/packages/math/math.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/tests/md/test.satysfi-lock b/tests/md/test.satysfi-lock index e652c21c5..46a3c62fb 100644 --- a/tests/md/test.satysfi-lock +++ b/tests/md/test.satysfi-lock @@ -7,7 +7,7 @@ locks: - name: "math.0.0.1" location: type: "global" - path: "./dist/packages/Math/" + path: "./dist/packages/math/math.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/tests/refactor1.satysfi-lock b/tests/refactor1.satysfi-lock index cad9aaf40..002661c22 100644 --- a/tests/refactor1.satysfi-lock +++ b/tests/refactor1.satysfi-lock @@ -7,6 +7,6 @@ locks: - name: "math.0.0.1" location: type: "global" - path: "./dist/packages/Math/" + path: "./dist/packages/math/math.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/tests/refactor2.satysfi-lock b/tests/refactor2.satysfi-lock index cad9aaf40..002661c22 100644 --- a/tests/refactor2.satysfi-lock +++ b/tests/refactor2.satysfi-lock @@ -7,6 +7,6 @@ locks: - name: "math.0.0.1" location: type: "global" - path: "./dist/packages/Math/" + path: "./dist/packages/math/math.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/tests/refactor3.satysfi-lock b/tests/refactor3.satysfi-lock index cad9aaf40..002661c22 100644 --- a/tests/refactor3.satysfi-lock +++ b/tests/refactor3.satysfi-lock @@ -7,6 +7,6 @@ locks: - name: "math.0.0.1" location: type: "global" - path: "./dist/packages/Math/" + path: "./dist/packages/math/math.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/tests/refactor5.satysfi-lock b/tests/refactor5.satysfi-lock index cad9aaf40..002661c22 100644 --- a/tests/refactor5.satysfi-lock +++ b/tests/refactor5.satysfi-lock @@ -7,6 +7,6 @@ locks: - name: "math.0.0.1" location: type: "global" - path: "./dist/packages/Math/" + path: "./dist/packages/math/math.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/tests/staged1.satysfi-lock b/tests/staged1.satysfi-lock index 78c69596a..f8a2a943f 100644 --- a/tests/staged1.satysfi-lock +++ b/tests/staged1.satysfi-lock @@ -7,7 +7,7 @@ locks: - name: "math.0.0.1" location: type: "global" - path: "./dist/packages/Math/" + path: "./dist/packages/math/math.0.0.1/" dependencies: - "stdlib.0.0.1" From 921f91b76b29ae9cf79939477bce901231da9aef Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 2 Nov 2022 19:40:23 +0900 Subject: [PATCH 059/288] move 'code' --- demo/demo.satysfi-lock | 2 +- doc/doc-lang.satysfi-lock | 2 +- doc/doc-primitives.satysfi-lock | 2 +- doc/math1.satysfi-lock | 2 +- .../dist/packages/{Code => code/code.0.0.1}/satysfi.yaml | 0 .../dist/packages/{Code => code/code.0.0.1}/src/code.satyh | 0 tests/images/test.satysfi-lock | 2 +- tests/macro1.satysfi-lock | 2 +- tests/math-typefaces.satysfi-lock | 2 +- tests/md/test.satysfi-lock | 2 +- tests/staged1.satysfi-lock | 2 +- 11 files changed, 9 insertions(+), 9 deletions(-) rename lib-satysfi/dist/packages/{Code => code/code.0.0.1}/satysfi.yaml (100%) rename lib-satysfi/dist/packages/{Code => code/code.0.0.1}/src/code.satyh (100%) diff --git a/demo/demo.satysfi-lock b/demo/demo.satysfi-lock index 3410ae8cc..f60a8b0bd 100644 --- a/demo/demo.satysfi-lock +++ b/demo/demo.satysfi-lock @@ -32,7 +32,7 @@ locks: - name: "code.0.0.1" location: type: "global" - path: "./dist/packages/Code/" + path: "./dist/packages/code/code.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/doc/doc-lang.satysfi-lock b/doc/doc-lang.satysfi-lock index f8a2a943f..bdbe82ccd 100644 --- a/doc/doc-lang.satysfi-lock +++ b/doc/doc-lang.satysfi-lock @@ -31,6 +31,6 @@ locks: - name: "code.0.0.1" location: type: "global" - path: "./dist/packages/Code/" + path: "./dist/packages/code/code.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/doc/doc-primitives.satysfi-lock b/doc/doc-primitives.satysfi-lock index 2cd66e3f9..b0c6dfea4 100644 --- a/doc/doc-primitives.satysfi-lock +++ b/doc/doc-primitives.satysfi-lock @@ -32,7 +32,7 @@ locks: - name: "code.0.0.1" location: type: "global" - path: "./dist/packages/Code/" + path: "./dist/packages/code/code.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/doc/math1.satysfi-lock b/doc/math1.satysfi-lock index cda5d702c..341e940f4 100644 --- a/doc/math1.satysfi-lock +++ b/doc/math1.satysfi-lock @@ -45,6 +45,6 @@ locks: - name: "code.0.0.1" location: type: "global" - path: "./dist/packages/Code/" + path: "./dist/packages/code/code.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/lib-satysfi/dist/packages/Code/satysfi.yaml b/lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/Code/satysfi.yaml rename to lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/Code/src/code.satyh b/lib-satysfi/dist/packages/code/code.0.0.1/src/code.satyh similarity index 100% rename from lib-satysfi/dist/packages/Code/src/code.satyh rename to lib-satysfi/dist/packages/code/code.0.0.1/src/code.satyh diff --git a/tests/images/test.satysfi-lock b/tests/images/test.satysfi-lock index 0f9f0e767..cb436da26 100644 --- a/tests/images/test.satysfi-lock +++ b/tests/images/test.satysfi-lock @@ -31,7 +31,7 @@ locks: - name: "code.0.0.1" location: type: "global" - path: "./dist/packages/Code/" + path: "./dist/packages/code/code.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/tests/macro1.satysfi-lock b/tests/macro1.satysfi-lock index 148365184..c30060444 100644 --- a/tests/macro1.satysfi-lock +++ b/tests/macro1.satysfi-lock @@ -32,7 +32,7 @@ locks: - name: "code.0.0.1" location: type: "global" - path: "./dist/packages/Code/" + path: "./dist/packages/code/code.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/tests/math-typefaces.satysfi-lock b/tests/math-typefaces.satysfi-lock index cf4a266c9..852392df9 100644 --- a/tests/math-typefaces.satysfi-lock +++ b/tests/math-typefaces.satysfi-lock @@ -39,7 +39,7 @@ locks: - name: "code.0.0.1" location: type: "global" - path: "./dist/packages/Code/" + path: "./dist/packages/code/code.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/tests/md/test.satysfi-lock b/tests/md/test.satysfi-lock index 46a3c62fb..24de046e2 100644 --- a/tests/md/test.satysfi-lock +++ b/tests/md/test.satysfi-lock @@ -33,7 +33,7 @@ locks: - name: "code.0.0.1" location: type: "global" - path: "./dist/packages/Code/" + path: "./dist/packages/code/code.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/tests/staged1.satysfi-lock b/tests/staged1.satysfi-lock index f8a2a943f..bdbe82ccd 100644 --- a/tests/staged1.satysfi-lock +++ b/tests/staged1.satysfi-lock @@ -31,6 +31,6 @@ locks: - name: "code.0.0.1" location: type: "global" - path: "./dist/packages/Code/" + path: "./dist/packages/code/code.0.0.1/" dependencies: - "stdlib.0.0.1" From 892ed445084659ec79781d013d89414662de1a14 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 2 Nov 2022 19:43:38 +0900 Subject: [PATCH 060/288] move 'annot' --- demo/demo.satysfi-lock | 2 +- doc/doc-lang.satysfi-lock | 2 +- doc/doc-primitives.satysfi-lock | 2 +- doc/math1.satysfi-lock | 2 +- .../dist/packages/{Annot => annot/annot.0.0.1}/satysfi.yaml | 0 .../dist/packages/{Annot => annot/annot.0.0.1}/src/annot.satyh | 0 tests/images/test.satysfi-lock | 2 +- tests/macro1.satysfi-lock | 2 +- tests/math-typefaces.satysfi-lock | 2 +- tests/md/test.satysfi-lock | 2 +- tests/staged1.satysfi-lock | 2 +- 11 files changed, 9 insertions(+), 9 deletions(-) rename lib-satysfi/dist/packages/{Annot => annot/annot.0.0.1}/satysfi.yaml (100%) rename lib-satysfi/dist/packages/{Annot => annot/annot.0.0.1}/src/annot.satyh (100%) diff --git a/demo/demo.satysfi-lock b/demo/demo.satysfi-lock index f60a8b0bd..04505235e 100644 --- a/demo/demo.satysfi-lock +++ b/demo/demo.satysfi-lock @@ -25,7 +25,7 @@ locks: - name: "annot.0.0.1" location: type: "global" - path: "./dist/packages/Annot/" + path: "./dist/packages/annot/annot.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/doc/doc-lang.satysfi-lock b/doc/doc-lang.satysfi-lock index bdbe82ccd..eead99103 100644 --- a/doc/doc-lang.satysfi-lock +++ b/doc/doc-lang.satysfi-lock @@ -24,7 +24,7 @@ locks: - name: "annot.0.0.1" location: type: "global" - path: "./dist/packages/Annot/" + path: "./dist/packages/annot/annot.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/doc/doc-primitives.satysfi-lock b/doc/doc-primitives.satysfi-lock index b0c6dfea4..526bef444 100644 --- a/doc/doc-primitives.satysfi-lock +++ b/doc/doc-primitives.satysfi-lock @@ -25,7 +25,7 @@ locks: - name: "annot.0.0.1" location: type: "global" - path: "./dist/packages/Annot/" + path: "./dist/packages/annot/annot.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/doc/math1.satysfi-lock b/doc/math1.satysfi-lock index 341e940f4..1135c17e5 100644 --- a/doc/math1.satysfi-lock +++ b/doc/math1.satysfi-lock @@ -38,7 +38,7 @@ locks: - name: "annot.0.0.1" location: type: "global" - path: "./dist/packages/Annot/" + path: "./dist/packages/annot/annot.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/lib-satysfi/dist/packages/Annot/satysfi.yaml b/lib-satysfi/dist/packages/annot/annot.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/Annot/satysfi.yaml rename to lib-satysfi/dist/packages/annot/annot.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/Annot/src/annot.satyh b/lib-satysfi/dist/packages/annot/annot.0.0.1/src/annot.satyh similarity index 100% rename from lib-satysfi/dist/packages/Annot/src/annot.satyh rename to lib-satysfi/dist/packages/annot/annot.0.0.1/src/annot.satyh diff --git a/tests/images/test.satysfi-lock b/tests/images/test.satysfi-lock index cb436da26..ddbdb11c1 100644 --- a/tests/images/test.satysfi-lock +++ b/tests/images/test.satysfi-lock @@ -24,7 +24,7 @@ locks: - name: "annot.0.0.1" location: type: "global" - path: "./dist/packages/Annot/" + path: "./dist/packages/annot/annot.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/tests/macro1.satysfi-lock b/tests/macro1.satysfi-lock index c30060444..1257f2a29 100644 --- a/tests/macro1.satysfi-lock +++ b/tests/macro1.satysfi-lock @@ -25,7 +25,7 @@ locks: - name: "annot.0.0.1" location: type: "global" - path: "./dist/packages/Annot/" + path: "./dist/packages/annot/annot.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/tests/math-typefaces.satysfi-lock b/tests/math-typefaces.satysfi-lock index 852392df9..4aae2dd6f 100644 --- a/tests/math-typefaces.satysfi-lock +++ b/tests/math-typefaces.satysfi-lock @@ -32,7 +32,7 @@ locks: - name: "annot.0.0.1" location: type: "global" - path: "./dist/packages/Annot/" + path: "./dist/packages/annot/annot.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/tests/md/test.satysfi-lock b/tests/md/test.satysfi-lock index 24de046e2..dd21d3109 100644 --- a/tests/md/test.satysfi-lock +++ b/tests/md/test.satysfi-lock @@ -26,7 +26,7 @@ locks: - name: "annot.0.0.1" location: type: "global" - path: "./dist/packages/Annot/" + path: "./dist/packages/annot/annot.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/tests/staged1.satysfi-lock b/tests/staged1.satysfi-lock index bdbe82ccd..eead99103 100644 --- a/tests/staged1.satysfi-lock +++ b/tests/staged1.satysfi-lock @@ -24,7 +24,7 @@ locks: - name: "annot.0.0.1" location: type: "global" - path: "./dist/packages/Annot/" + path: "./dist/packages/annot/annot.0.0.1/" dependencies: - "stdlib.0.0.1" From cd296e37b3073e865ad8d9991c22124a901687ea Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 2 Nov 2022 19:46:48 +0900 Subject: [PATCH 061/288] move 'itemize' --- demo/demo.satysfi-lock | 2 +- doc/doc-primitives.satysfi-lock | 2 +- .../packages/{Itemize => itemize/itemize.0.0.1}/satysfi.yaml | 0 .../{Itemize => itemize/itemize.0.0.1}/src/itemize.satyh | 0 tests/images/test.satysfi-lock | 2 +- tests/math-typefaces.satysfi-lock | 2 +- tests/md/test.satysfi-lock | 2 +- 7 files changed, 5 insertions(+), 5 deletions(-) rename lib-satysfi/dist/packages/{Itemize => itemize/itemize.0.0.1}/satysfi.yaml (100%) rename lib-satysfi/dist/packages/{Itemize => itemize/itemize.0.0.1}/src/itemize.satyh (100%) diff --git a/demo/demo.satysfi-lock b/demo/demo.satysfi-lock index 04505235e..abf925fdc 100644 --- a/demo/demo.satysfi-lock +++ b/demo/demo.satysfi-lock @@ -46,7 +46,7 @@ locks: - name: "itemize.0.0.1" location: type: "global" - path: "./dist/packages/Itemize" + path: "./dist/packages/itemize/itemize.0.0.1" dependencies: - "stdlib.0.0.1" diff --git a/doc/doc-primitives.satysfi-lock b/doc/doc-primitives.satysfi-lock index 526bef444..b9471ef24 100644 --- a/doc/doc-primitives.satysfi-lock +++ b/doc/doc-primitives.satysfi-lock @@ -46,6 +46,6 @@ locks: - name: "itemize.0.0.1" location: type: "global" - path: "./dist/packages/Itemize" + path: "./dist/packages/itemize/itemize.0.0.1" dependencies: - "stdlib.0.0.1" diff --git a/lib-satysfi/dist/packages/Itemize/satysfi.yaml b/lib-satysfi/dist/packages/itemize/itemize.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/Itemize/satysfi.yaml rename to lib-satysfi/dist/packages/itemize/itemize.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/Itemize/src/itemize.satyh b/lib-satysfi/dist/packages/itemize/itemize.0.0.1/src/itemize.satyh similarity index 100% rename from lib-satysfi/dist/packages/Itemize/src/itemize.satyh rename to lib-satysfi/dist/packages/itemize/itemize.0.0.1/src/itemize.satyh diff --git a/tests/images/test.satysfi-lock b/tests/images/test.satysfi-lock index ddbdb11c1..0be80a1f0 100644 --- a/tests/images/test.satysfi-lock +++ b/tests/images/test.satysfi-lock @@ -38,6 +38,6 @@ locks: - name: "itemize.0.0.1" location: type: "global" - path: "./dist/packages/Itemize" + path: "./dist/packages/itemize/itemize.0.0.1" dependencies: - "stdlib.0.0.1" diff --git a/tests/math-typefaces.satysfi-lock b/tests/math-typefaces.satysfi-lock index 4aae2dd6f..466df47d8 100644 --- a/tests/math-typefaces.satysfi-lock +++ b/tests/math-typefaces.satysfi-lock @@ -14,7 +14,7 @@ locks: - name: "itemize.0.0.1" location: type: "global" - path: "./dist/packages/Itemize" + path: "./dist/packages/itemize/itemize.0.0.1" dependencies: - "stdlib.0.0.1" diff --git a/tests/md/test.satysfi-lock b/tests/md/test.satysfi-lock index dd21d3109..108011753 100644 --- a/tests/md/test.satysfi-lock +++ b/tests/md/test.satysfi-lock @@ -47,6 +47,6 @@ locks: - name: "itemize.0.0.1" location: type: "global" - path: "./dist/packages/Itemize" + path: "./dist/packages/itemize/itemize.0.0.1" dependencies: - "stdlib.0.0.1" From 7ec14c4891449d386c9e56247d2468b6074002c6 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 2 Nov 2022 19:50:39 +0900 Subject: [PATCH 062/288] move 'tabular' --- demo/demo.satysfi-lock | 2 +- doc/math1.satysfi-lock | 2 +- .../packages/{Tabular => tabular/tabular.0.0.1}/satysfi.yaml | 0 .../{Tabular => tabular/tabular.0.0.1}/src/tabular.satyh | 0 4 files changed, 2 insertions(+), 2 deletions(-) rename lib-satysfi/dist/packages/{Tabular => tabular/tabular.0.0.1}/satysfi.yaml (100%) rename lib-satysfi/dist/packages/{Tabular => tabular/tabular.0.0.1}/src/tabular.satyh (100%) diff --git a/demo/demo.satysfi-lock b/demo/demo.satysfi-lock index abf925fdc..40abd7a56 100644 --- a/demo/demo.satysfi-lock +++ b/demo/demo.satysfi-lock @@ -60,6 +60,6 @@ locks: - name: "tabular.0.0.1" location: type: "global" - path: "./dist/packages/Tabular" + path: "./dist/packages/tabular/tabular.0.0.1" dependencies: - "stdlib.0.0.1" diff --git a/doc/math1.satysfi-lock b/doc/math1.satysfi-lock index 1135c17e5..750722948 100644 --- a/doc/math1.satysfi-lock +++ b/doc/math1.satysfi-lock @@ -21,7 +21,7 @@ locks: - name: "tabular.0.0.1" location: type: "global" - path: "./dist/packages/Tabular" + path: "./dist/packages/tabular/tabular.0.0.1" dependencies: - "stdlib.0.0.1" diff --git a/lib-satysfi/dist/packages/Tabular/satysfi.yaml b/lib-satysfi/dist/packages/tabular/tabular.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/Tabular/satysfi.yaml rename to lib-satysfi/dist/packages/tabular/tabular.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/Tabular/src/tabular.satyh b/lib-satysfi/dist/packages/tabular/tabular.0.0.1/src/tabular.satyh similarity index 100% rename from lib-satysfi/dist/packages/Tabular/src/tabular.satyh rename to lib-satysfi/dist/packages/tabular/tabular.0.0.1/src/tabular.satyh From 599801142371650d9cd088c25f0865980a9d2f4d Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 2 Nov 2022 19:52:11 +0900 Subject: [PATCH 063/288] move 'footnote-scheme' --- demo/demo.satysfi-lock | 2 +- doc/doc-primitives.satysfi-lock | 2 +- .../footnote-scheme.0.0.1}/satysfi.yaml | 0 .../footnote-scheme.0.0.1}/src/footnote-scheme.satyh | 0 tests/macro1.satysfi-lock | 2 +- tests/math-typefaces.satysfi-lock | 2 +- tests/md/test.satysfi-lock | 2 +- 7 files changed, 5 insertions(+), 5 deletions(-) rename lib-satysfi/dist/packages/{FootnoteScheme => footnote-scheme/footnote-scheme.0.0.1}/satysfi.yaml (100%) rename lib-satysfi/dist/packages/{FootnoteScheme => footnote-scheme/footnote-scheme.0.0.1}/src/footnote-scheme.satyh (100%) diff --git a/demo/demo.satysfi-lock b/demo/demo.satysfi-lock index 40abd7a56..ade7a748f 100644 --- a/demo/demo.satysfi-lock +++ b/demo/demo.satysfi-lock @@ -39,7 +39,7 @@ locks: - name: "footnote-scheme.0.0.1" location: type: "global" - path: "./dist/packages/FootnoteScheme/" + path: "./dist/packages/footnote-scheme/footnote-scheme.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/doc/doc-primitives.satysfi-lock b/doc/doc-primitives.satysfi-lock index b9471ef24..6ad56e0ef 100644 --- a/doc/doc-primitives.satysfi-lock +++ b/doc/doc-primitives.satysfi-lock @@ -39,7 +39,7 @@ locks: - name: "footnote-scheme.0.0.1" location: type: "global" - path: "./dist/packages/FootnoteScheme/" + path: "./dist/packages/footnote-scheme/footnote-scheme.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/lib-satysfi/dist/packages/FootnoteScheme/satysfi.yaml b/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/FootnoteScheme/satysfi.yaml rename to lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/FootnoteScheme/src/footnote-scheme.satyh b/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/src/footnote-scheme.satyh similarity index 100% rename from lib-satysfi/dist/packages/FootnoteScheme/src/footnote-scheme.satyh rename to lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/src/footnote-scheme.satyh diff --git a/tests/macro1.satysfi-lock b/tests/macro1.satysfi-lock index 1257f2a29..656b975b8 100644 --- a/tests/macro1.satysfi-lock +++ b/tests/macro1.satysfi-lock @@ -39,6 +39,6 @@ locks: - name: "footnote-scheme.0.0.1" location: type: "global" - path: "./dist/packages/FootnoteScheme/" + path: "./dist/packages/footnote-scheme/footnote-scheme.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/tests/math-typefaces.satysfi-lock b/tests/math-typefaces.satysfi-lock index 466df47d8..0953f2cd8 100644 --- a/tests/math-typefaces.satysfi-lock +++ b/tests/math-typefaces.satysfi-lock @@ -46,6 +46,6 @@ locks: - name: "footnote-scheme.0.0.1" location: type: "global" - path: "./dist/packages/FootnoteScheme/" + path: "./dist/packages/footnote-scheme/footnote-scheme.0.0.1/" dependencies: - "stdlib.0.0.1" diff --git a/tests/md/test.satysfi-lock b/tests/md/test.satysfi-lock index 108011753..f0d57d418 100644 --- a/tests/md/test.satysfi-lock +++ b/tests/md/test.satysfi-lock @@ -40,7 +40,7 @@ locks: - name: "footnote-scheme.0.0.1" location: type: "global" - path: "./dist/packages/FootnoteScheme/" + path: "./dist/packages/footnote-scheme/footnote-scheme.0.0.1/" dependencies: - "stdlib.0.0.1" From 9dac22208902c2e67790bb8dcb4ac33e58e8b9ba Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 2 Nov 2022 19:54:30 +0900 Subject: [PATCH 064/288] move 'proof' --- demo/demo.satysfi-lock | 2 +- doc/math1.satysfi-lock | 2 +- .../dist/packages/{Proof => proof/proof.0.0.1}/satysfi.yaml | 0 .../dist/packages/{Proof => proof/proof.0.0.1}/src/proof.satyh | 0 4 files changed, 2 insertions(+), 2 deletions(-) rename lib-satysfi/dist/packages/{Proof => proof/proof.0.0.1}/satysfi.yaml (100%) rename lib-satysfi/dist/packages/{Proof => proof/proof.0.0.1}/src/proof.satyh (100%) diff --git a/demo/demo.satysfi-lock b/demo/demo.satysfi-lock index ade7a748f..1160e3ef0 100644 --- a/demo/demo.satysfi-lock +++ b/demo/demo.satysfi-lock @@ -53,7 +53,7 @@ locks: - name: "proof.0.0.1" location: type: "global" - path: "./dist/packages/Proof" + path: "./dist/packages/proof/proof.0.0.1" dependencies: - "stdlib.0.0.1" diff --git a/doc/math1.satysfi-lock b/doc/math1.satysfi-lock index 750722948..1653ed942 100644 --- a/doc/math1.satysfi-lock +++ b/doc/math1.satysfi-lock @@ -14,7 +14,7 @@ locks: - name: "proof.0.0.1" location: type: "global" - path: "./dist/packages/Proof" + path: "./dist/packages/proof/proof.0.0.1" dependencies: - "stdlib.0.0.1" diff --git a/lib-satysfi/dist/packages/Proof/satysfi.yaml b/lib-satysfi/dist/packages/proof/proof.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/Proof/satysfi.yaml rename to lib-satysfi/dist/packages/proof/proof.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/Proof/src/proof.satyh b/lib-satysfi/dist/packages/proof/proof.0.0.1/src/proof.satyh similarity index 100% rename from lib-satysfi/dist/packages/Proof/src/proof.satyh rename to lib-satysfi/dist/packages/proof/proof.0.0.1/src/proof.satyh From c509f94697e912e0f8770dd360d3568d3512cc31 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 2 Nov 2022 19:56:37 +0900 Subject: [PATCH 065/288] move 'md-ja' --- .../dist/packages/{MDJa => md-ja/md-ja.0.0.1}/satysfi.yaml | 0 .../dist/packages/{MDJa => md-ja/md-ja.0.0.1}/src/mdja.satyh | 0 tests/md/test.satysfi-lock | 2 +- 3 files changed, 1 insertion(+), 1 deletion(-) rename lib-satysfi/dist/packages/{MDJa => md-ja/md-ja.0.0.1}/satysfi.yaml (100%) rename lib-satysfi/dist/packages/{MDJa => md-ja/md-ja.0.0.1}/src/mdja.satyh (100%) diff --git a/lib-satysfi/dist/packages/MDJa/satysfi.yaml b/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/MDJa/satysfi.yaml rename to lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/MDJa/src/mdja.satyh b/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/src/mdja.satyh similarity index 100% rename from lib-satysfi/dist/packages/MDJa/src/mdja.satyh rename to lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/src/mdja.satyh diff --git a/tests/md/test.satysfi-lock b/tests/md/test.satysfi-lock index f0d57d418..5b9d17d6d 100644 --- a/tests/md/test.satysfi-lock +++ b/tests/md/test.satysfi-lock @@ -14,7 +14,7 @@ locks: - name: "md-ja.0.0.1" location: type: "global" - path: "./dist/packages/MDJa/" + path: "./dist/packages/md-ja/md-ja.0.0.1/" dependencies: - "stdlib.0.0.1" - "math.0.0.1" From 86a1a17af456de0dcbf9fa8e30bed86a49bb48e4 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 2 Nov 2022 20:00:44 +0900 Subject: [PATCH 066/288] move 'std-ja{,-report,-book}' --- demo/demo.satysfi-lock | 2 +- doc/doc-lang.satysfi-lock | 2 +- doc/doc-primitives.satysfi-lock | 2 +- doc/math1.satysfi-lock | 2 +- .../{StdJaBook => std-ja-book/std-ja-book.0.0.1}/satysfi.yaml | 0 .../std-ja-book.0.0.1}/src/stdjabook.satyh | 0 .../std-ja-report.0.0.1}/satysfi.yaml | 0 .../std-ja-report.0.0.1}/src/stdjareport.satyh | 0 .../dist/packages/{StdJa => std-ja/std-ja.0.0.1}/satysfi.yaml | 0 .../packages/{StdJa => std-ja/std-ja.0.0.1}/src/stdja.satyh | 0 tests/images/test.satysfi-lock | 2 +- tests/macro1.satysfi-lock | 2 +- tests/math-typefaces.satysfi-lock | 2 +- tests/staged1.satysfi-lock | 2 +- 14 files changed, 8 insertions(+), 8 deletions(-) rename lib-satysfi/dist/packages/{StdJaBook => std-ja-book/std-ja-book.0.0.1}/satysfi.yaml (100%) rename lib-satysfi/dist/packages/{StdJaBook => std-ja-book/std-ja-book.0.0.1}/src/stdjabook.satyh (100%) rename lib-satysfi/dist/packages/{StdJaReport => std-ja-report/std-ja-report.0.0.1}/satysfi.yaml (100%) rename lib-satysfi/dist/packages/{StdJaReport => std-ja-report/std-ja-report.0.0.1}/src/stdjareport.satyh (100%) rename lib-satysfi/dist/packages/{StdJa => std-ja/std-ja.0.0.1}/satysfi.yaml (100%) rename lib-satysfi/dist/packages/{StdJa => std-ja/std-ja.0.0.1}/src/stdja.satyh (100%) diff --git a/demo/demo.satysfi-lock b/demo/demo.satysfi-lock index 1160e3ef0..aaaba0e78 100644 --- a/demo/demo.satysfi-lock +++ b/demo/demo.satysfi-lock @@ -20,7 +20,7 @@ locks: - "footnote-scheme.0.0.1" location: type: "global" - path: "./dist/packages/StdJaBook/" + path: "./dist/packages/std-ja-book/std-ja-book.0.0.1/" - name: "annot.0.0.1" location: diff --git a/doc/doc-lang.satysfi-lock b/doc/doc-lang.satysfi-lock index eead99103..7029ca2b4 100644 --- a/doc/doc-lang.satysfi-lock +++ b/doc/doc-lang.satysfi-lock @@ -19,7 +19,7 @@ locks: - "code.0.0.1" location: type: "global" - path: "./dist/packages/StdJa/" + path: "./dist/packages/std-ja/std-ja.0.0.1/" - name: "annot.0.0.1" location: diff --git a/doc/doc-primitives.satysfi-lock b/doc/doc-primitives.satysfi-lock index 6ad56e0ef..245583812 100644 --- a/doc/doc-primitives.satysfi-lock +++ b/doc/doc-primitives.satysfi-lock @@ -20,7 +20,7 @@ locks: - "footnote-scheme.0.0.1" location: type: "global" - path: "./dist/packages/StdJaBook/" + path: "./dist/packages/std-ja-book/std-ja-book.0.0.1/" - name: "annot.0.0.1" location: diff --git a/doc/math1.satysfi-lock b/doc/math1.satysfi-lock index 1653ed942..fc76567be 100644 --- a/doc/math1.satysfi-lock +++ b/doc/math1.satysfi-lock @@ -33,7 +33,7 @@ locks: - "code.0.0.1" location: type: "global" - path: "./dist/packages/StdJa/" + path: "./dist/packages/std-ja/std-ja.0.0.1/" - name: "annot.0.0.1" location: diff --git a/lib-satysfi/dist/packages/StdJaBook/satysfi.yaml b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/StdJaBook/satysfi.yaml rename to lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/StdJaBook/src/stdjabook.satyh b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/stdjabook.satyh similarity index 100% rename from lib-satysfi/dist/packages/StdJaBook/src/stdjabook.satyh rename to lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/stdjabook.satyh diff --git a/lib-satysfi/dist/packages/StdJaReport/satysfi.yaml b/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/StdJaReport/satysfi.yaml rename to lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/StdJaReport/src/stdjareport.satyh b/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/src/stdjareport.satyh similarity index 100% rename from lib-satysfi/dist/packages/StdJaReport/src/stdjareport.satyh rename to lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/src/stdjareport.satyh diff --git a/lib-satysfi/dist/packages/StdJa/satysfi.yaml b/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/StdJa/satysfi.yaml rename to lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/StdJa/src/stdja.satyh b/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/src/stdja.satyh similarity index 100% rename from lib-satysfi/dist/packages/StdJa/src/stdja.satyh rename to lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/src/stdja.satyh diff --git a/tests/images/test.satysfi-lock b/tests/images/test.satysfi-lock index 0be80a1f0..98920f151 100644 --- a/tests/images/test.satysfi-lock +++ b/tests/images/test.satysfi-lock @@ -19,7 +19,7 @@ locks: - "code.0.0.1" location: type: "global" - path: "./dist/packages/StdJa/" + path: "./dist/packages/std-ja/std-ja.0.0.1/" - name: "annot.0.0.1" location: diff --git a/tests/macro1.satysfi-lock b/tests/macro1.satysfi-lock index 656b975b8..ed8fabc37 100644 --- a/tests/macro1.satysfi-lock +++ b/tests/macro1.satysfi-lock @@ -14,7 +14,7 @@ locks: - name: "std-ja-report.0.0.1" location: type: "global" - path: "./dist/packages/StdJaReport" + path: "./dist/packages/std-ja-report/std-ja-report.0.0.1" dependencies: - "stdlib.0.0.1" - "math.0.0.1" diff --git a/tests/math-typefaces.satysfi-lock b/tests/math-typefaces.satysfi-lock index 0953f2cd8..e188d754e 100644 --- a/tests/math-typefaces.satysfi-lock +++ b/tests/math-typefaces.satysfi-lock @@ -21,7 +21,7 @@ locks: - name: "std-ja-report.0.0.1" location: type: "global" - path: "./dist/packages/StdJaReport" + path: "./dist/packages/std-ja-report/std-ja-report.0.0.1" dependencies: - "stdlib.0.0.1" - "math.0.0.1" diff --git a/tests/staged1.satysfi-lock b/tests/staged1.satysfi-lock index eead99103..7029ca2b4 100644 --- a/tests/staged1.satysfi-lock +++ b/tests/staged1.satysfi-lock @@ -19,7 +19,7 @@ locks: - "code.0.0.1" location: type: "global" - path: "./dist/packages/StdJa/" + path: "./dist/packages/std-ja/std-ja.0.0.1/" - name: "annot.0.0.1" location: From 0b4c7706aab971f917bb053d0d9352b21dd9eb0c Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 2 Nov 2022 20:52:12 +0900 Subject: [PATCH 067/288] lessen contents of package config files --- .../packages/annot/annot.0.0.1/satysfi.yaml | 4 --- .../packages/code/code.0.0.1/satysfi.yaml | 4 --- .../footnote-scheme.0.0.1/satysfi.yaml | 4 --- .../itemize/itemize.0.0.1/satysfi.yaml | 4 --- .../packages/math/math.0.0.1/satysfi.yaml | 4 --- .../packages/md-ja/md-ja.0.0.1/satysfi.yaml | 9 ------ .../src/{mdja.satyh => md-ja.satyh} | 0 .../packages/proof/proof.0.0.1/satysfi.yaml | 4 --- .../std-ja-book.0.0.1/satysfi.yaml | 8 ----- .../{stdjabook.satyh => std-ja-book.satyh} | 0 .../std-ja-report.0.0.1/satysfi.yaml | 8 ----- ...{stdjareport.satyh => std-ja-report.satyh} | 0 .../packages/std-ja/std-ja.0.0.1/satysfi.yaml | 7 ----- .../src/{stdja.satyh => std-ja.satyh} | 0 .../packages/stdlib/stdlib.0.0.1/satysfi.yaml | 2 -- .../tabular/tabular.0.0.1/satysfi.yaml | 4 --- src/frontend/packageConfig.ml | 30 ++----------------- src/frontend/packageConfig.mli | 9 ------ src/frontend/packageReader.ml | 1 - 19 files changed, 2 insertions(+), 100 deletions(-) rename lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/src/{mdja.satyh => md-ja.satyh} (100%) rename lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/{stdjabook.satyh => std-ja-book.satyh} (100%) rename lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/src/{stdjareport.satyh => std-ja-report.satyh} (100%) rename lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/src/{stdja.satyh => std-ja.satyh} (100%) diff --git a/lib-satysfi/dist/packages/annot/annot.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/annot/annot.0.0.1/satysfi.yaml index 578e1ff25..4be0243a4 100644 --- a/lib-satysfi/dist/packages/annot/annot.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/annot/annot.0.0.1/satysfi.yaml @@ -1,10 +1,6 @@ language: "0.1.0" -package_name: "annot" -version: "0.0.1" contents: type: "library" main_module: "Annot" source_directories: - "./src" - dependencies: - - package_name: "stdlib" diff --git a/lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml index 436b834dc..6cccc025f 100644 --- a/lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml @@ -1,10 +1,6 @@ language: "0.1.0" -package_name: "code" -version: "0.0.1" contents: type: "library" main_module: "Code" source_directories: - "./src" - dependencies: - - package_name: "stdlib" diff --git a/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml index 823c25804..6372e0305 100644 --- a/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml @@ -1,10 +1,6 @@ language: "0.1.0" -package_name: "footnote-scheme" -version: "0.0.1" contents: type: "library" main_module: "FootnoteScheme" source_directories: - "./src" - dependencies: - - package_name: "stdlib" diff --git a/lib-satysfi/dist/packages/itemize/itemize.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/itemize/itemize.0.0.1/satysfi.yaml index fb8bc9775..d0a919e4e 100644 --- a/lib-satysfi/dist/packages/itemize/itemize.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/itemize/itemize.0.0.1/satysfi.yaml @@ -1,10 +1,6 @@ language: "0.1.0" -package_name: "itemize" -version: "0.0.1" contents: type: "library" main_module: "Itemize" source_directories: - "./src" - dependencies: - - package_name: "stdlib" diff --git a/lib-satysfi/dist/packages/math/math.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/math/math.0.0.1/satysfi.yaml index a1bab440f..7235d379b 100644 --- a/lib-satysfi/dist/packages/math/math.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/math/math.0.0.1/satysfi.yaml @@ -1,10 +1,6 @@ language: "0.1.0" -package_name: "math" -version: "0.0.1" contents: type: "library" main_module: "Math" source_directories: - "./src" - dependencies: - - package_name: "stdlib" diff --git a/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml index c895c0f02..b1579ccf7 100644 --- a/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml @@ -1,15 +1,6 @@ language: "0.1.0" -package_name: "md-ja" -version: "0.0.1" contents: type: "library" main_module: "MDJa" source_directories: - "./src" - dependencies: - - package_name: "stdlib" - - package_name: "math" - - package_name: "code" - - package_name: "itemize" - - package_name: "annot" - - package_name: "footnote-scheme" diff --git a/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/src/mdja.satyh b/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/src/md-ja.satyh similarity index 100% rename from lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/src/mdja.satyh rename to lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/src/md-ja.satyh diff --git a/lib-satysfi/dist/packages/proof/proof.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/proof/proof.0.0.1/satysfi.yaml index fccb64edc..ea4b4c776 100644 --- a/lib-satysfi/dist/packages/proof/proof.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/proof/proof.0.0.1/satysfi.yaml @@ -1,10 +1,6 @@ language: "0.1.0" -package_name: "proof" -version: "0.0.1" contents: type: "library" main_module: "Proof" source_directories: - "./src" - dependencies: - - package_name: "stdlib" diff --git a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml index 1166d3e38..5729ac46f 100644 --- a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml @@ -1,14 +1,6 @@ language: "0.1.0" -package_name: "std-ja-book" -version: "0.0.1" contents: type: "library" main_module: "StdJaBook" source_directories: - "./src" - dependencies: - - package_name: "stdlib" - - package_name: "math" - - package_name: "annot" - - package_name: "code" - - package_name: "footnote-scheme" diff --git a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/stdjabook.satyh b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh similarity index 100% rename from lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/stdjabook.satyh rename to lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh diff --git a/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml index a572c1b67..a0e56c3ca 100644 --- a/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml @@ -1,14 +1,6 @@ language: "0.1.0" -package_name: "std-ja-report" -version: "0.0.1" contents: type: "library" main_module: "StdJaReport" source_directories: - "./src" - dependencies: - - package_name: "stdlib" - - package_name: "math" - - package_name: "code" - - package_name: "annot" - - package_name: "footnote-scheme" diff --git a/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/src/stdjareport.satyh b/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/src/std-ja-report.satyh similarity index 100% rename from lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/src/stdjareport.satyh rename to lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/src/std-ja-report.satyh diff --git a/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/satysfi.yaml index d2bf70338..d42ef783f 100644 --- a/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/satysfi.yaml @@ -1,13 +1,6 @@ language: "0.1.0" -package_name: "std-ja" -version: "0.0.1" contents: type: "library" main_module: "StdJa" source_directories: - "./src" - dependencies: - - package_name: "stdlib" - - package_name: "math" - - package_name: "annot" - - package_name: "code" diff --git a/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/src/stdja.satyh b/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/src/std-ja.satyh similarity index 100% rename from lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/src/stdja.satyh rename to lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/src/std-ja.satyh diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/satysfi.yaml index 638ea0852..3532c99df 100644 --- a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/satysfi.yaml @@ -1,6 +1,4 @@ language: "0.1.0" -package_name: "stdlib" -version: "0.0.1" contents: type: "library" main_module: "Stdlib" diff --git a/lib-satysfi/dist/packages/tabular/tabular.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/tabular/tabular.0.0.1/satysfi.yaml index 28133f8c9..d2c003af2 100644 --- a/lib-satysfi/dist/packages/tabular/tabular.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/tabular/tabular.0.0.1/satysfi.yaml @@ -1,10 +1,6 @@ language: "0.1.0" -package_name: "tabular" -version: "0.0.1" contents: type: "library" main_module: "Tabular" source_directories: - "./src" - dependencies: - - package_name: "stdlib" diff --git a/src/frontend/packageConfig.ml b/src/frontend/packageConfig.ml index 4d0e4f327..63cefda6a 100644 --- a/src/frontend/packageConfig.ml +++ b/src/frontend/packageConfig.ml @@ -8,25 +8,16 @@ type 'a ok = ('a, config_error) result type relative_path = string -type dependency_spec = { - depended_package_name : string; - version_constraints : unit; (* TODO: define this *) -} - type package_contents = | Library of { main_module_name : module_name; source_directories : relative_path list; - dependencies : dependency_spec list; } | Document of { document_file : relative_path; - dependencies : dependency_spec list; } type t = { - package_name : string; - package_version : string; package_contents : package_contents; } @@ -34,34 +25,21 @@ type t = { module PackageConfigDecoder = YamlDecoder.Make(YamlError) -let dependency_decoder : dependency_spec PackageConfigDecoder.t = - let open PackageConfigDecoder in - get "package_name" string >>= fun depended_package_name -> - succeed { - depended_package_name; - version_constraints = (); - } - - let contents_decoder : package_contents PackageConfigDecoder.t = let open PackageConfigDecoder in branch "type" [ "library" ==> begin get "main_module" string >>= fun main_module_name -> get "source_directories" (list string) >>= fun source_directories -> - get_or_else "dependencies" (list dependency_decoder) [] >>= fun dependencies -> succeed @@ Library { main_module_name; source_directories; - dependencies; } end; "document" ==> begin get "file" string >>= fun document_file -> - get_or_else "dependencies" (list dependency_decoder) [] >>= fun dependencies -> succeed @@ Document { document_file; - dependencies; } end; ] @@ -70,14 +48,10 @@ let contents_decoder : package_contents PackageConfigDecoder.t = ) -let config_decoder : t PackageConfigDecoder.t = +let version_0_1_config_decoder : t PackageConfigDecoder.t = let open PackageConfigDecoder in - get "package_name" string >>= fun package_name -> - get "version" string >>= fun package_version -> get "contents" contents_decoder >>= fun package_contents -> succeed @@ { - package_name; - package_version; package_contents; } @@ -86,7 +60,7 @@ let config_decoder = let open PackageConfigDecoder in get "language" string >>= fun language -> match language with - | "0.1.0" -> config_decoder + | "0.1.0" -> version_0_1_config_decoder | _ -> failure (fun _context -> UnexpectedLanguage(language)) diff --git a/src/frontend/packageConfig.mli b/src/frontend/packageConfig.mli index d23289521..ada371a0c 100644 --- a/src/frontend/packageConfig.mli +++ b/src/frontend/packageConfig.mli @@ -5,25 +5,16 @@ open ConfigError type relative_path = string -type dependency_spec = { - depended_package_name : string; - version_constraints : unit; (* TODO: define this *) -} - type package_contents = | Library of { main_module_name : module_name; source_directories : relative_path list; - dependencies : dependency_spec list; } | Document of { document_file : relative_path; - dependencies : dependency_spec list; } type t = { - package_name : string; - package_version : string; package_contents : package_contents; } diff --git a/src/frontend/packageReader.ml b/src/frontend/packageReader.ml index f93a4b4a5..2efd432ec 100644 --- a/src/frontend/packageReader.ml +++ b/src/frontend/packageReader.ml @@ -28,7 +28,6 @@ let main ~(extensions : string list) (absdir_package : abs_path) : untyped_packa | PackageConfig.Library { main_module_name; source_directories; - dependencies = _; } -> let absdirs_src = source_directories |> List.map (fun source_directory -> From 2f32a2cfbc53c2a01551a94a1a8108793b129bc9 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Thu, 3 Nov 2022 17:41:03 +0900 Subject: [PATCH 068/288] support 'use open' etc. --- src/frontend/closedFileDependencyResolver.ml | 4 ++-- src/frontend/openFileDependencyResolver.ml | 8 ++++---- src/frontend/packageChecker.ml | 19 +++++++++++-------- src/frontend/parser.mly | 16 ++++++++++------ src/frontend/types.cppo.ml | 16 +++++++++++++--- 5 files changed, 40 insertions(+), 23 deletions(-) diff --git a/src/frontend/closedFileDependencyResolver.ml b/src/frontend/closedFileDependencyResolver.ml index 75eaee28e..1d06fef24 100644 --- a/src/frontend/closedFileDependencyResolver.ml +++ b/src/frontend/closedFileDependencyResolver.ml @@ -34,7 +34,7 @@ let main (utlibs : (abs_path * untyped_library_file) list) : ((abs_path * untype let (header, _) = utlib in header |> foldM (fun graph headerelem -> match headerelem with - | HeaderUse((rng, modnm_sub)) -> + | HeaderUse{ module_name = (rng, modnm_sub); _ } -> begin match graph |> SourceModuleDependencyGraph.get_vertex modnm_sub with | None -> @@ -48,7 +48,7 @@ let main (utlibs : (abs_path * untyped_library_file) list) : ((abs_path * untype | HeaderUsePackage(_) -> return graph - | HeaderUseOf(modident, _) -> + | HeaderUseOf{ module_name = modident; _ } -> err @@ CannotUseHeaderUseOf(modident) ) graph diff --git a/src/frontend/openFileDependencyResolver.ml b/src/frontend/openFileDependencyResolver.ml index 87eeb2590..7b2c72369 100644 --- a/src/frontend/openFileDependencyResolver.ml +++ b/src/frontend/openFileDependencyResolver.ml @@ -38,13 +38,13 @@ type local_or_package = let get_header (extensions : string list) (curdir : string) (headerelem : header_element) : local_or_package ok = let open ResultMonad in match headerelem with - | HeaderUsePackage(modident) -> + | HeaderUsePackage{ module_name = modident; _ } -> return @@ Package(modident) - | HeaderUse(modident) -> + | HeaderUse{ module_name = modident; _ } -> err @@ CannotUseHeaderUse(modident) - | HeaderUseOf(modident, s_relpath) -> + | HeaderUseOf{ module_name = modident; path = s_relpath; _ } -> let* abspath = Config.resolve_local ~extensions ~origin:curdir ~relative:s_relpath |> Result.map_error (fun candidates -> LocalFileNotFound{ relative = s_relpath; candidates }) @@ -144,7 +144,7 @@ let register_markdown_file (setting : string) (abspath_in : abs_path) : (Package in let header = depends |> List.map (fun main_module_name -> - HeaderUsePackage((Range.dummy "md-header", main_module_name)) + HeaderUsePackage{ opening = false; module_name = (Range.dummy "md-header", main_module_name) } ) in return (package_names, (header, utast)) diff --git a/src/frontend/packageChecker.ml b/src/frontend/packageChecker.ml index 168b55f07..2be0d05c2 100644 --- a/src/frontend/packageChecker.ml +++ b/src/frontend/packageChecker.ml @@ -14,21 +14,21 @@ let add_dependency_to_type_environment ~(package_only : bool) (header : header_e header |> foldM (fun tyenv headerelem -> let opt = match headerelem with - | HeaderUse(modident) - | HeaderUseOf(modident, _) -> + | HeaderUse{ opening; module_name = modident } + | HeaderUseOf{ opening; module_name = modident; _ } -> if package_only then None else - Some((LocalDependency, modident)) + Some((LocalDependency, opening, modident)) - | HeaderUsePackage(modident) -> - Some((PackageDependency, modident)) + | HeaderUsePackage{ opening; module_name = modident } -> + Some((PackageDependency, opening, modident)) in match opt with | None -> return tyenv - | Some((kind, (rng, modnm))) -> + | Some((kind, opening, (rng, modnm))) -> begin match (kind, genv |> GlobalTypeenv.find_opt modnm) with | (LocalDependency, None) -> @@ -38,8 +38,11 @@ let add_dependency_to_type_environment ~(package_only : bool) (header : header_e err @@ UnknownPackageDependency(rng, modnm) | (_, Some(ssig)) -> - let mentry = { mod_signature = ConcStructure(ssig) } in - return (tyenv |> Typeenv.add_module modnm mentry) + if opening then + return (tyenv |> TypecheckUtil.add_to_type_environment_by_signature ssig) + else + let mentry = { mod_signature = ConcStructure(ssig) } in + return (tyenv |> Typeenv.add_module modnm mentry) end ) tyenv diff --git a/src/frontend/parser.mly b/src/frontend/parser.mly index 96b472e85..0fcd85053 100644 --- a/src/frontend/parser.mly +++ b/src/frontend/parser.mly @@ -371,17 +371,21 @@ main_lib: { (modident, utsig_opt, utbinds) } ; headerelem: - | USE; PACKAGE; modident=UPPER - { HeaderUsePackage(modident) } - | USE; modident=UPPER - { HeaderUse(modident) } - | USE; modident=UPPER; OF; tok=STRING + | USE; PACKAGE; opening=optional_open; modident=UPPER + { HeaderUsePackage{ opening; module_name = modident } } + | USE; opening=optional_open; modident=UPPER + { HeaderUse{ opening; module_name = modident } } + | USE; opening=optional_open; modident=UPPER; OF; tok=STRING { let (_rng, str, pre, post) = tok in let s = omit_spaces pre post str in - HeaderUseOf(modident, s) + HeaderUseOf{ opening; module_name = modident; path = s } } ; +optional_open: + | OPEN { true } + | { false } +; modexpr: | tokL=FUN; L_PAREN; modident=UPPER; COLON; utsig=sigexpr; R_PAREN; ARROW; utmod=modexpr { make_standard (Tok tokL) (Ranged utmod) (UTModFunctor(modident, utsig, utmod)) } diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index 1dbe724f4..d14fa13b6 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -51,9 +51,19 @@ type input_position = { [@@deriving show { with_path = false }] type header_element = - | HeaderUsePackage of module_name ranged - | HeaderUse of module_name ranged - | HeaderUseOf of module_name ranged * string + | HeaderUsePackage of { + opening : bool; + module_name : module_name ranged; + } + | HeaderUse of { + opening : bool; + module_name : module_name ranged; + } + | HeaderUseOf of { + opening : bool; + module_name : module_name ranged; + path : string; + } [@@deriving show { with_path = false }] type quantifiability = Quantifiable | Unquantifiable From 301833f30dbdc4b67996f919763ed844a715c6cd Mon Sep 17 00:00:00 2001 From: gfngfn Date: Thu, 3 Nov 2022 17:41:30 +0900 Subject: [PATCH 069/288] refactor libraries by using 'use package open' --- .../dist/packages/annot/annot.0.0.1/src/annot.satyh | 9 +-------- .../dist/packages/code/code.0.0.1/src/code.satyh | 10 +--------- .../footnote-scheme.0.0.1/src/footnote-scheme.satyh | 8 +------- .../packages/itemize/itemize.0.0.1/src/itemize.satyh | 9 +-------- .../dist/packages/math/math.0.0.1/src/math.satyh | 7 +------ .../dist/packages/md-ja/md-ja.0.0.1/src/md-ja.satyh | 12 +----------- .../dist/packages/proof/proof.0.0.1/src/proof.satyh | 8 +------- .../std-ja-book.0.0.1/src/std-ja-book.satyh | 11 +---------- .../std-ja-report.0.0.1/src/std-ja-report.satyh | 11 +---------- .../packages/std-ja/std-ja.0.0.1/src/std-ja.satyh | 11 +---------- 10 files changed, 10 insertions(+), 86 deletions(-) diff --git a/lib-satysfi/dist/packages/annot/annot.0.0.1/src/annot.satyh b/lib-satysfi/dist/packages/annot/annot.0.0.1/src/annot.satyh index 0f5ba267b..2486289b8 100644 --- a/lib-satysfi/dist/packages/annot/annot.0.0.1/src/annot.satyh +++ b/lib-satysfi/dist/packages/annot/annot.0.0.1/src/annot.satyh @@ -1,4 +1,4 @@ -use package Stdlib +use package open Stdlib module Annot :> sig val \href : inline [?(border : length * color) string, inline-text] @@ -7,13 +7,6 @@ module Annot :> sig val register-location-frame : string -> deco-set end = struct - %- TODO: remove this by using 'open' - module Option = Stdlib.Option - module Pervasives = Stdlib.Pervasives - module Color = Stdlib.Color - module Gr = Stdlib.Gr - - val link-to-uri-frame uri borderopt = let deco (x, y) w h d = let () = register-link-to-uri uri (x, y) w h d borderopt in diff --git a/lib-satysfi/dist/packages/code/code.0.0.1/src/code.satyh b/lib-satysfi/dist/packages/code/code.0.0.1/src/code.satyh index dd597e35a..17d9b11d4 100644 --- a/lib-satysfi/dist/packages/code/code.0.0.1/src/code.satyh +++ b/lib-satysfi/dist/packages/code/code.0.0.1/src/code.satyh @@ -1,4 +1,4 @@ -use package Stdlib +use package open Stdlib module Code % :> sig @@ -15,14 +15,6 @@ module Code % end = struct - %- TODO: remove this by using 'open' - module Pervasives = Stdlib.Pervasives - module List = Stdlib.List - module Color = Stdlib.Color - module Gr = Stdlib.Gr - module VDecoSet = Stdlib.VDecoSet - - signature S = sig val font-family : string val text-color : color diff --git a/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/src/footnote-scheme.satyh b/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/src/footnote-scheme.satyh index 4aef5f167..a9459e6d1 100644 --- a/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/src/footnote-scheme.satyh +++ b/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/src/footnote-scheme.satyh @@ -1,4 +1,4 @@ -use package Stdlib +use package open Stdlib module FootnoteScheme :> sig val initialize : unit -> unit @@ -7,12 +7,6 @@ module FootnoteScheme :> sig val main-no-number : context -> (unit -> inline-boxes) -> (unit -> block-boxes) -> inline-boxes end = struct - %- TODO: remove this by using 'open' - module Pervasives = Stdlib.Pervasives - module Color = Stdlib.Color - module Gr = Stdlib.Gr - - val mutable footnote-ref <- 0 val mutable first-footnote <- true diff --git a/lib-satysfi/dist/packages/itemize/itemize.0.0.1/src/itemize.satyh b/lib-satysfi/dist/packages/itemize/itemize.0.0.1/src/itemize.satyh index 05cea8a39..33fb33dcb 100644 --- a/lib-satysfi/dist/packages/itemize/itemize.0.0.1/src/itemize.satyh +++ b/lib-satysfi/dist/packages/itemize/itemize.0.0.1/src/itemize.satyh @@ -1,4 +1,4 @@ -use package Stdlib +use package open Stdlib module Itemize :> sig val +listing : block [?(break : bool) itemize] @@ -7,13 +7,6 @@ module Itemize :> sig val \enumerate : inline [itemize] end = struct - %- TODO: remove this by using 'open' - module List = Stdlib.List - module Option = Stdlib.Option - module Pervasives = Stdlib.Pervasives - module Gr = Stdlib.Gr - - val (+++>) = List.fold-left (+++) val concat-blocks = (+++>) block-nil diff --git a/lib-satysfi/dist/packages/math/math.0.0.1/src/math.satyh b/lib-satysfi/dist/packages/math/math.0.0.1/src/math.satyh index 1a7a67d8d..99e1bf411 100644 --- a/lib-satysfi/dist/packages/math/math.0.0.1/src/math.satyh +++ b/lib-satysfi/dist/packages/math/math.0.0.1/src/math.satyh @@ -1,4 +1,4 @@ -use package Stdlib +use package open Stdlib module Math :> sig @@ -426,11 +426,6 @@ module Math :> sig % end = struct - %- TODO: replace this with 'open' - module List = Stdlib.List - module Pervasives = Stdlib.Pervasives - module Gr = Stdlib.Gr - val join (msep : math-text) (ms : list math-text) = match ms |> List.fold-left (fun maccopt m -> ( diff --git a/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/src/md-ja.satyh b/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/src/md-ja.satyh index 25a2acd5f..1b1c8d6b1 100644 --- a/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/src/md-ja.satyh +++ b/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/src/md-ja.satyh @@ -1,4 +1,4 @@ -use package Stdlib +use package open Stdlib use package Math use package Code use package Itemize @@ -35,16 +35,6 @@ module MDJa :> sig val \error : inline [string] end = struct - %- TODO: remove this by using 'open' - module List = Stdlib.List - module Pervasives = Stdlib.Pervasives - module Color = Stdlib.Color - module Gr = Stdlib.Gr - module PaperSize = Stdlib.PaperSize - module HDecoSet = Stdlib.HDecoSet - module VDecoSet = Stdlib.VDecoSet - - val paper = PaperSize.a4 val text-origin = (80pt, 100pt) val text-width = 440pt diff --git a/lib-satysfi/dist/packages/proof/proof.0.0.1/src/proof.satyh b/lib-satysfi/dist/packages/proof/proof.0.0.1/src/proof.satyh index c264bed66..e9dffdcc5 100644 --- a/lib-satysfi/dist/packages/proof/proof.0.0.1/src/proof.satyh +++ b/lib-satysfi/dist/packages/proof/proof.0.0.1/src/proof.satyh @@ -1,4 +1,4 @@ -use package Stdlib +use package open Stdlib module Proof :> sig @@ -7,12 +7,6 @@ module Proof :> sig end = struct - %- TODO: remove this by using 'open' - module List = Stdlib.List - module Pervasives = Stdlib.Pervasives - module Gr = Stdlib.Gr - - val math ctx \math-space len = embed-inline-to-math MathOrd (inline-skip len) diff --git a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh index e21e20956..0c646ec6d 100644 --- a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh +++ b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh @@ -1,4 +1,4 @@ -use package Stdlib +use package open Stdlib use package Math use package Annot use package Code @@ -47,15 +47,6 @@ module StdJaBook :> sig end = struct - %- TODO: remove this by using 'open' - module Option = Stdlib.Option - module List = Stdlib.List - module Pervasives = Stdlib.Pervasives - module Gr = Stdlib.Gr - module Color = Stdlib.Color - module PaperSize = Stdlib.PaperSize - - type toc-element = | TOCElementSection of string * inline-text | TOCElementSubsection of string * inline-text diff --git a/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/src/std-ja-report.satyh b/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/src/std-ja-report.satyh index 5e998f742..b09dc0575 100644 --- a/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/src/std-ja-report.satyh +++ b/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/src/std-ja-report.satyh @@ -1,4 +1,4 @@ -use package Stdlib +use package open Stdlib use package Math use package Code use package Annot @@ -49,15 +49,6 @@ module StdJaReport :> sig end = struct - %- TODO: remove this by using 'open' - module Pervasives = Stdlib.Pervasives - module Gr = Stdlib.Gr - module List = Stdlib.List - module Color = Stdlib.Color - module Option = Stdlib.Option - module PaperSize = Stdlib.PaperSize - - % type toc-element = % | TOCElementChapter of string * inline-text % | TOCElementSection of string * inline-text diff --git a/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/src/std-ja.satyh b/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/src/std-ja.satyh index ce70e7d7f..cb3dfd7ad 100644 --- a/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/src/std-ja.satyh +++ b/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/src/std-ja.satyh @@ -1,4 +1,4 @@ -use package Stdlib +use package open Stdlib use package Math use package Code use package Annot @@ -42,15 +42,6 @@ module StdJa :> sig end = struct - %- TODO: remove this by using 'open' - module Option = Stdlib.Option - module List = Stdlib.List - module Pervasives = Stdlib.Pervasives - module Color = Stdlib.Color - module Gr = Stdlib.Gr - module PaperSize = Stdlib.PaperSize - - type toc-element = | TOCElementSection of string * inline-text | TOCElementSubsection of string * inline-text From 604bcbe761e32e841d23d185e484d128da654c21 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Thu, 3 Nov 2022 17:55:28 +0900 Subject: [PATCH 070/288] fix how to extend type environments with 'use package open' --- .../dist/packages/math/math.0.0.1/src/math.satyh | 2 +- src/frontend/packageChecker.ml | 14 +++++++++----- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/lib-satysfi/dist/packages/math/math.0.0.1/src/math.satyh b/lib-satysfi/dist/packages/math/math.0.0.1/src/math.satyh index 99e1bf411..72fd7c102 100644 --- a/lib-satysfi/dist/packages/math/math.0.0.1/src/math.satyh +++ b/lib-satysfi/dist/packages/math/math.0.0.1/src/math.satyh @@ -396,7 +396,7 @@ module Math :> sig val \setsep : math [math-text, math-text] val \cases : math [list (math-text * inline-text)] - type paren = Stdlib.Pervasives.paren %TODO (enhance): remove this + type paren = Pervasives.paren %TODO (enhance): remove this val paren-left : paren val paren-right : paren val paren : context -> math-boxes -> math-boxes diff --git a/src/frontend/packageChecker.ml b/src/frontend/packageChecker.ml index 2be0d05c2..931c86db0 100644 --- a/src/frontend/packageChecker.ml +++ b/src/frontend/packageChecker.ml @@ -38,11 +38,15 @@ let add_dependency_to_type_environment ~(package_only : bool) (header : header_e err @@ UnknownPackageDependency(rng, modnm) | (_, Some(ssig)) -> - if opening then - return (tyenv |> TypecheckUtil.add_to_type_environment_by_signature ssig) - else - let mentry = { mod_signature = ConcStructure(ssig) } in - return (tyenv |> Typeenv.add_module modnm mentry) + let mentry = { mod_signature = ConcStructure(ssig) } in + let tyenv = tyenv |> Typeenv.add_module modnm mentry in + let tyenv = + if opening then + tyenv |> TypecheckUtil.add_to_type_environment_by_signature ssig + else + tyenv + in + return tyenv end ) tyenv From ae65ebc107784681a38d98e8afb84a585657ea01 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Thu, 3 Nov 2022 17:57:30 +0900 Subject: [PATCH 071/288] remove 'Stdlib.' --- .../std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh | 6 +++--- .../std-ja-report.0.0.1/src/std-ja-report.satyh | 6 +++--- .../dist/packages/std-ja/std-ja.0.0.1/src/std-ja.satyh | 6 +++--- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh index 0c646ec6d..a35017e6c 100644 --- a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh +++ b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh @@ -15,9 +15,9 @@ module StdJaBook :> sig paper-size : length * length, text-width : length, text-height : length, - text-origin : Stdlib.Pervasives.point, %- TODO: remove this by using 'open' - header-origin : Stdlib.Pervasives.point, - footer-origin : Stdlib.Pervasives.point, + text-origin : Pervasives.point, %- TODO: remove this by using 'open' + header-origin : Pervasives.point, + footer-origin : Pervasives.point, header-width : length, footer-width : length, ) (| diff --git a/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/src/std-ja-report.satyh b/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/src/std-ja-report.satyh index b09dc0575..b59d2dfd7 100644 --- a/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/src/std-ja-report.satyh +++ b/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/src/std-ja-report.satyh @@ -11,9 +11,9 @@ module StdJaReport :> sig show-page-number : bool, text-width : length, text-height : length, - text-origin : Stdlib.Pervasives.point, %- TODO: remove this by using 'open' - header-origin : Stdlib.Pervasives.point, - footer-origin : Stdlib.Pervasives.point, + text-origin : Pervasives.point, %- TODO: remove this by using 'open' + header-origin : Pervasives.point, + footer-origin : Pervasives.point, header-width : length, footer-width : length, ) (| diff --git a/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/src/std-ja.satyh b/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/src/std-ja.satyh index cb3dfd7ad..36d2dea39 100644 --- a/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/src/std-ja.satyh +++ b/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/src/std-ja.satyh @@ -13,9 +13,9 @@ module StdJa :> sig paper-size : length * length, text-width : length, text-height : length, - text-origin : Stdlib.Pervasives.point, %- TODO: remove this by using 'open' - header-origin : Stdlib.Pervasives.point, - footer-origin : Stdlib.Pervasives.point, + text-origin : Pervasives.point, %- TODO: remove this by using 'open' + header-origin : Pervasives.point, + footer-origin : Pervasives.point, header-width : length, footer-width : length, ) (| From bda1b1a0b8f87f855d9690d9e4fe884707af14f7 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Thu, 3 Nov 2022 18:04:24 +0900 Subject: [PATCH 072/288] use 'use package open' and 'use open' in '{tests,doc,demo}' --- demo/demo.saty | 24 ++++++++---------------- doc/doc-lang.saty | 13 +++++-------- doc/doc-primitives.saty | 18 ++++++------------ doc/math1.saty | 15 +++++---------- tests/clip.saty | 6 ++---- tests/math-typefaces.saty | 12 ++++-------- tests/refactor1.saty | 6 ++---- 7 files changed, 32 insertions(+), 62 deletions(-) diff --git a/demo/demo.saty b/demo/demo.saty index 481228778..b35ba8db7 100644 --- a/demo/demo.saty +++ b/demo/demo.saty @@ -1,22 +1,14 @@ -use package Stdlib -use package Math -use package Annot -use package Code -use package Itemize -use package Proof +use package open Stdlib +use package open Math +use package open Annot +use package open Code +use package open Itemize +use package open Proof use package Tabular -use package StdJaBook -use Local of `./local` +use package open StdJaBook +use open Local of `./local` -let open Stdlib in let open Pervasives in -let open Math in -let open Proof in -let open Code in -let open Itemize in -let open Annot in -let open StdJaBook in -let open Local in document ?( show-toc = true, ) (| diff --git a/doc/doc-lang.saty b/doc/doc-lang.saty index 7cc71fae0..52cdcc778 100644 --- a/doc/doc-lang.saty +++ b/doc/doc-lang.saty @@ -1,12 +1,9 @@ -use package Stdlib -use package Math -use package StdJa -use LocalMath of `local-math` +use package open Stdlib +use package open StdJa +use package open Math +use open LocalMath of `local-math` -let open Stdlib in let open Pervasives in -let open StdJa in -let open LocalMath in document (| title = {\SATySFi;言語仕様}, author = {Takashi SUWA}, @@ -23,7 +20,7 @@ document (| ${\cstc}, ${\patas{\patp}{\varx}}, ${\constrapp{\constrC}{\patp}}, - ${\tuple![${\patp}, ${\Math.ldots}, ${\patp}]}, + ${\tuple![${\patp}, ${\ldots}, ${\patp}]}, ] } } diff --git a/doc/doc-primitives.saty b/doc/doc-primitives.saty index c321c572f..b59fa5274 100644 --- a/doc/doc-primitives.saty +++ b/doc/doc-primitives.saty @@ -1,17 +1,11 @@ -use package Stdlib -use package Math -use package Itemize -use package StdJaBook -use Local of `local` -use LocalMath of `local-math` +use package open Stdlib +use package open Math +use package open Itemize +use package open StdJaBook +use open Local of `local` +use open LocalMath of `local-math` -let open Stdlib in let open Pervasives in -let open Itemize in -let open Math in -let open StdJaBook in -let open Local in -let open LocalMath in document ?( show-toc = true, ) (| diff --git a/doc/math1.saty b/doc/math1.saty index 149bd21c0..9958c04eb 100644 --- a/doc/math1.saty +++ b/doc/math1.saty @@ -1,15 +1,10 @@ -use package Stdlib -use package Math -use package Proof -use package Tabular -use package StdJa +use package open Stdlib +use package open Math +use package open Proof +use package open Tabular +use package open StdJa -let open Stdlib in let open Pervasives in -let open Math in -let open Proof in -let open Tabular in -let open StdJa in let math ctx \overwrite mf ma mb = read-math ctx ${#mf\sqbracket{#ma \mapsto #mb}} diff --git a/tests/clip.saty b/tests/clip.saty index edda9de02..9741d1a46 100644 --- a/tests/clip.saty +++ b/tests/clip.saty @@ -1,9 +1,7 @@ -use package Stdlib -use Head of `head` +use package open Stdlib +use open Head of `head` -let open Stdlib in let open Pervasives in -let open Head in let inline ctx \do-fill wid f = let ib = use-image-by-width (load-image `images/peppers-rgb.jpg`) wid in diff --git a/tests/math-typefaces.saty b/tests/math-typefaces.saty index 208359896..37d2867cb 100644 --- a/tests/math-typefaces.saty +++ b/tests/math-typefaces.saty @@ -1,13 +1,9 @@ -use package Stdlib -use package Math -use package Itemize -use package StdJaReport +use package open Stdlib +use package open Math +use package open Itemize +use package open StdJaReport -let open Stdlib in let open Pervasives in -let open Math in -let open Itemize in -let open StdJaReport in let block ctx +test-math-style name style = let it = embed-string name in diff --git a/tests/refactor1.saty b/tests/refactor1.saty index 85a8c8564..fe6bd6139 100644 --- a/tests/refactor1.saty +++ b/tests/refactor1.saty @@ -1,5 +1,5 @@ -use package Stdlib -use package Math +use package open Stdlib +use package open Math %let rec fold-left f i l = % match l with @@ -8,8 +8,6 @@ use package Math % end %in -let open Stdlib in -let open Math in let sum = List.fold-left (+) 0 [3, 1, 4, 1, 5, 9, 2] in let f t y = From b12b274f5cdc963da38d1e4fd7adc161face26d3 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Thu, 3 Nov 2022 21:44:28 +0900 Subject: [PATCH 073/288] begin to support package builds --- src/frontend/main.ml | 176 +++++++++++++++++++++++++++---------------- 1 file changed, 111 insertions(+), 65 deletions(-) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index eb3412811..db8e32183 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -8,6 +8,7 @@ open TypeError exception NoLibraryRootDesignation exception ShouldSpecifyOutputFile +exception UnexpectedInputExtension of string exception ConfigError of config_error @@ -25,12 +26,11 @@ let reset () = (* Initialization that should be performed before typechecking *) -let initialize (abspath_dump : abs_path) : Typeenv.t * environment * bool = +let initialize () : Typeenv.t * environment = FreeID.initialize (); BoundID.initialize (); EvalVarID.initialize (); StoreID.initialize (); - let dump_file_exists = CrossRef.initialize abspath_dump in let res = if OptionState.is_text_mode () then Primitives.make_text_mode_environments () @@ -48,7 +48,7 @@ let initialize (abspath_dump : abs_path) : Typeenv.t * environment * bool = else () end; - (tyenv, env, dump_file_exists) + (tyenv, env) module StoreIDMap = Map.Make(StoreID) @@ -1245,6 +1245,17 @@ let get_candidate_file_extensions () = | TextMode(formats) -> List.append (formats |> List.map (fun s -> ".satyh-" ^ s)) [ ".satyg" ] +type build_input = + | PackageInput of { + lock : abs_path; + } + | DocumentInput of { + lock : abs_path; + out : abs_path; + dump : abs_path; + } + + let build ~(fpath_in : string) ~(fpath_out_opt : string option) @@ -1300,78 +1311,113 @@ let build setup_root_dirs curdir; let abspath_in = input_file in - let basename_without_extension = + let build_input = let abspathstr_in = get_abs_path_string abspath_in in - try Filename.chop_extension abspathstr_in with - | Invalid_argument(_) -> abspathstr_in - in - - let abspath_lock_config = make_abs_path (Printf.sprintf "%s.satysfi-lock" basename_without_extension) in - Logging.lock_config_file abspath_lock_config; - let lock_config = - match LockConfig.load abspath_lock_config with - | Ok(lock_config) -> lock_config - | Error(e) -> raise (ConfigError(e)) - in - - let abspath_out = - match (output_mode, output_file) with - | (_, Some(abspath_out)) -> abspath_out - | (TextMode(_), None) -> raise ShouldSpecifyOutputFile - | (PdfMode, None) -> make_abs_path (Printf.sprintf "%s.pdf" basename_without_extension) + match Filename.extension abspathstr_in with + | ".saty" -> + (* If the input is a document file: *) + let basename_without_extension = Filename.remove_extension abspathstr_in in + let abspath_lock_config = make_abs_path (Printf.sprintf "%s.satysfi-lock" basename_without_extension) in + let abspath_out = + match (output_mode, output_file) with + | (_, Some(abspath_out)) -> abspath_out + | (TextMode(_), None) -> raise ShouldSpecifyOutputFile + | (PdfMode, None) -> make_abs_path (Printf.sprintf "%s.pdf" basename_without_extension) + in + let abspath_dump = make_abs_path (Printf.sprintf "%s.satysfi-aux" basename_without_extension) in + DocumentInput{ + lock = abspath_lock_config; + out = abspath_out; + dump = abspath_dump; + } + + | "" -> + (* If the input is a package directory: *) + let abspath_lock_config = make_abs_path (Printf.sprintf "%s/package.satysfi-lock" abspathstr_in) in + PackageInput{ + lock = abspath_lock_config; + } + + | ext -> + raise (UnexpectedInputExtension(ext)) in - Logging.target_file abspath_out; - - let abspath_dump = make_abs_path (Printf.sprintf "%s.satysfi-aux" basename_without_extension) in - let (tyenv_prim, env, dump_file_exists) = initialize abspath_dump in - Logging.dump_file dump_file_exists abspath_dump; let extensions = get_candidate_file_extensions () in + let (tyenv_prim, env) = initialize () in + + match build_input with + | PackageInput{ + lock = abspath_lock_config; + } -> + Logging.lock_config_file abspath_lock_config; + let _lock_config = + match LockConfig.load abspath_lock_config with + | Ok(lock_config) -> lock_config + | Error(e) -> raise (ConfigError(e)) + in + failwith "TODO: PackageInput" + + | DocumentInput{ + lock = abspath_lock_config; + out = abspath_out; + dump = abspath_dump; + } -> + Logging.lock_config_file abspath_lock_config; + let lock_config = + match LockConfig.load abspath_lock_config with + | Ok(lock_config) -> lock_config + | Error(e) -> raise (ConfigError(e)) + in - (* Resolve dependency of the document and the local source files: *) - let (_dep_main_module_names, sorted_locals, utdoc_opt) = - match OpenFileDependencyResolver.main ~extensions abspath_in with - | Ok(triple) -> triple - | Error(e) -> raise (ConfigError(e)) - in + Logging.target_file abspath_out; - (* Resolve dependency among locked packages: *) - let sorted_packages = - match ClosedLockDependencyResolver.main ~extensions lock_config with - | Ok(sorted_packages) -> sorted_packages - | Error(e) -> raise (ConfigError(e)) - in + let dump_file_exists = CrossRef.initialize abspath_dump in + Logging.dump_file dump_file_exists abspath_dump; - (* Typecheck every locked package: *) - let (genv, libacc) = - sorted_packages |> List.fold_left (fun (genv, libacc) (_lock_name, package) -> - let main_module_name = package.main_module_name in - let (ssig, libs) = - match PackageChecker.main tyenv_prim genv package with - | Ok(pair) -> pair - | Error(e) -> raise (ConfigError(e)) + (* Resolve dependency of the document and the local source files: *) + let (_dep_main_module_names, sorted_locals, utdoc_opt) = + match OpenFileDependencyResolver.main ~extensions abspath_in with + | Ok(triple) -> triple + | Error(e) -> raise (ConfigError(e)) in - let genv = genv |> GlobalTypeenv.add main_module_name ssig in - let libacc = Alist.append libacc libs in - (genv, libacc) - ) (GlobalTypeenv.empty, Alist.empty) - in - match utdoc_opt with - | None -> - () + (* Resolve dependency among locked packages: *) + let sorted_packages = + match ClosedLockDependencyResolver.main ~extensions lock_config with + | Ok(sorted_packages) -> sorted_packages + | Error(e) -> raise (ConfigError(e)) + in - | Some(utdoc) -> - (* Typechecking and elaboration: *) - let (libs_local, ast_doc) = - match PackageChecker.main_document tyenv_prim genv sorted_locals (abspath_in, utdoc) with - | Ok(pair) -> pair - | Error(e) -> raise (ConfigError(e)) + (* Typecheck every locked package: *) + let (genv, libacc) = + sorted_packages |> List.fold_left (fun (genv, libacc) (_lock_name, package) -> + let main_module_name = package.main_module_name in + let (ssig, libs) = + match PackageChecker.main tyenv_prim genv package with + | Ok(pair) -> pair + | Error(e) -> raise (ConfigError(e)) + in + let genv = genv |> GlobalTypeenv.add main_module_name ssig in + let libacc = Alist.append libacc libs in + (genv, libacc) + ) (GlobalTypeenv.empty, Alist.empty) in - let libs = Alist.to_list (Alist.append libacc libs_local) in - if type_check_only then - () - else - preprocess_and_evaluate env libs ast_doc abspath_in abspath_out abspath_dump + match utdoc_opt with + | None -> + () + + | Some(utdoc) -> + (* Typechecking and elaboration: *) + let (libs_local, ast_doc) = + match PackageChecker.main_document tyenv_prim genv sorted_locals (abspath_in, utdoc) with + | Ok(pair) -> pair + | Error(e) -> raise (ConfigError(e)) + in + let libs = Alist.to_list (Alist.append libacc libs_local) in + + if type_check_only then + () + else + preprocess_and_evaluate env libs ast_doc abspath_in abspath_out abspath_dump ) From d451f37697e8bf8d9c70e30d5bc76bd066cdc577 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Thu, 3 Nov 2022 22:11:58 +0900 Subject: [PATCH 074/288] support package builds --- src/frontend/main.ml | 132 ++++++++++---------- src/frontend/openFileDependencyResolver.ml | 37 +----- src/frontend/openFileDependencyResolver.mli | 2 +- 3 files changed, 76 insertions(+), 95 deletions(-) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index db8e32183..358c720ac 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -8,7 +8,6 @@ open TypeError exception NoLibraryRootDesignation exception ShouldSpecifyOutputFile -exception UnexpectedInputExtension of string exception ConfigError of config_error @@ -1256,6 +1255,31 @@ type build_input = } +let check_depended_packages ~(extensions : string list) (tyenv_prim : Typeenv.t) (lock_config : LockConfig.t) = + (* Resolve dependency among locked packages: *) + let sorted_packages = + match ClosedLockDependencyResolver.main ~extensions lock_config with + | Ok(sorted_packages) -> sorted_packages + | Error(e) -> raise (ConfigError(e)) + in + + (* Typecheck every locked package: *) + let (genv, libacc) = + sorted_packages |> List.fold_left (fun (genv, libacc) (_lock_name, package) -> + let main_module_name = package.main_module_name in + let (ssig, libs) = + match PackageChecker.main tyenv_prim genv package with + | Ok(pair) -> pair + | Error(e) -> raise (ConfigError(e)) + in + let genv = genv |> GlobalTypeenv.add main_module_name ssig in + let libacc = Alist.append libacc libs in + (genv, libacc) + ) (GlobalTypeenv.empty, Alist.empty) + in + (genv, Alist.to_list libacc) + + let build ~(fpath_in : string) ~(fpath_out_opt : string option) @@ -1313,33 +1337,28 @@ let build let abspath_in = input_file in let build_input = let abspathstr_in = get_abs_path_string abspath_in in - match Filename.extension abspathstr_in with - | ".saty" -> - (* If the input is a document file: *) - let basename_without_extension = Filename.remove_extension abspathstr_in in - let abspath_lock_config = make_abs_path (Printf.sprintf "%s.satysfi-lock" basename_without_extension) in - let abspath_out = - match (output_mode, output_file) with - | (_, Some(abspath_out)) -> abspath_out - | (TextMode(_), None) -> raise ShouldSpecifyOutputFile - | (PdfMode, None) -> make_abs_path (Printf.sprintf "%s.pdf" basename_without_extension) - in - let abspath_dump = make_abs_path (Printf.sprintf "%s.satysfi-aux" basename_without_extension) in - DocumentInput{ - lock = abspath_lock_config; - out = abspath_out; - dump = abspath_dump; - } - - | "" -> + if Sys.is_directory abspathstr_in then (* If the input is a package directory: *) let abspath_lock_config = make_abs_path (Printf.sprintf "%s/package.satysfi-lock" abspathstr_in) in PackageInput{ lock = abspath_lock_config; } - - | ext -> - raise (UnexpectedInputExtension(ext)) + else + (* If the input is a document file: *) + let basename_without_extension = Filename.remove_extension abspathstr_in in + let abspath_lock_config = make_abs_path (Printf.sprintf "%s.satysfi-lock" basename_without_extension) in + let abspath_out = + match (output_mode, output_file) with + | (_, Some(abspath_out)) -> abspath_out + | (TextMode(_), None) -> raise ShouldSpecifyOutputFile + | (PdfMode, None) -> make_abs_path (Printf.sprintf "%s.pdf" basename_without_extension) + in + let abspath_dump = make_abs_path (Printf.sprintf "%s.satysfi-aux" basename_without_extension) in + DocumentInput{ + lock = abspath_lock_config; + out = abspath_out; + dump = abspath_dump; + } in let extensions = get_candidate_file_extensions () in @@ -1350,12 +1369,25 @@ let build lock = abspath_lock_config; } -> Logging.lock_config_file abspath_lock_config; - let _lock_config = + let lock_config = match LockConfig.load abspath_lock_config with | Ok(lock_config) -> lock_config | Error(e) -> raise (ConfigError(e)) in - failwith "TODO: PackageInput" + + let package = + match PackageReader.main ~extensions abspath_in with + | Ok(package) -> package + | Error(e) -> raise (ConfigError(e)) + in + + let (genv, _libs_dep) = check_depended_packages ~extensions tyenv_prim lock_config in + + begin + match PackageChecker.main tyenv_prim genv package with + | Ok((_ssig, _libs)) -> () + | Error(e) -> raise (ConfigError(e)) + end | DocumentInput{ lock = abspath_lock_config; @@ -1375,49 +1407,23 @@ let build Logging.dump_file dump_file_exists abspath_dump; (* Resolve dependency of the document and the local source files: *) - let (_dep_main_module_names, sorted_locals, utdoc_opt) = + let (_dep_main_module_names, sorted_locals, utdoc) = match OpenFileDependencyResolver.main ~extensions abspath_in with | Ok(triple) -> triple | Error(e) -> raise (ConfigError(e)) in - (* Resolve dependency among locked packages: *) - let sorted_packages = - match ClosedLockDependencyResolver.main ~extensions lock_config with - | Ok(sorted_packages) -> sorted_packages - | Error(e) -> raise (ConfigError(e)) - in + let (genv, libs) = check_depended_packages ~extensions tyenv_prim lock_config in - (* Typecheck every locked package: *) - let (genv, libacc) = - sorted_packages |> List.fold_left (fun (genv, libacc) (_lock_name, package) -> - let main_module_name = package.main_module_name in - let (ssig, libs) = - match PackageChecker.main tyenv_prim genv package with - | Ok(pair) -> pair - | Error(e) -> raise (ConfigError(e)) - in - let genv = genv |> GlobalTypeenv.add main_module_name ssig in - let libacc = Alist.append libacc libs in - (genv, libacc) - ) (GlobalTypeenv.empty, Alist.empty) + (* Typechecking and elaboration: *) + let (libs_local, ast_doc) = + match PackageChecker.main_document tyenv_prim genv sorted_locals (abspath_in, utdoc) with + | Ok(pair) -> pair + | Error(e) -> raise (ConfigError(e)) in - - match utdoc_opt with - | None -> - () - - | Some(utdoc) -> - (* Typechecking and elaboration: *) - let (libs_local, ast_doc) = - match PackageChecker.main_document tyenv_prim genv sorted_locals (abspath_in, utdoc) with - | Ok(pair) -> pair - | Error(e) -> raise (ConfigError(e)) - in - let libs = Alist.to_list (Alist.append libacc libs_local) in - - if type_check_only then - () - else - preprocess_and_evaluate env libs ast_doc abspath_in abspath_out abspath_dump + let libs = List.append libs libs_local in + if type_check_only then + () + else + preprocess_and_evaluate env libs ast_doc abspath_in abspath_out abspath_dump ) diff --git a/src/frontend/openFileDependencyResolver.ml b/src/frontend/openFileDependencyResolver.ml index 7b2c72369..3af810866 100644 --- a/src/frontend/openFileDependencyResolver.ml +++ b/src/frontend/openFileDependencyResolver.ml @@ -13,23 +13,6 @@ type graph = untyped_library_file FileDependencyGraph.t type vertex = FileDependencyGraph.Vertex.t - -let has_library_extension (abspath : abs_path) : bool = - let ext = get_abs_path_extension abspath in - match ext with - | ".satyh" | ".satyg" -> - true - - | _ -> - begin - try - let extpre = String.sub ext 0 7 in - String.equal extpre ".satyh-" - with - | _ -> false - end - - type local_or_package = | Local of module_name ranged * abs_path | Package of module_name ranged @@ -150,28 +133,20 @@ let register_markdown_file (setting : string) (abspath_in : abs_path) : (Package return (package_names, (header, utast)) -let main ~(extensions : string list) (abspath_in : abs_path) : (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file option) ok = +let main ~(extensions : string list) (abspath_in : abs_path) : (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file) ok = let open ResultMonad in - let* (package_names, graph, utdoc_opt) = + let* (package_names, graph, utdoc) = match OptionState.get_input_kind () with | OptionState.SATySFi -> - if has_library_extension abspath_in && OptionState.is_type_check_only () then - let graph = FileDependencyGraph.empty in - let package_names = PackageNameSet.empty in - let* (package_names, graph) = - register_library_file extensions graph package_names ~prev:None abspath_in - in - return (package_names, graph, None) - else - let* (package_names, graph, utdoc) = register_document_file extensions abspath_in in - return (package_names, graph, Some(utdoc)) + let* (package_names, graph, utdoc) = register_document_file extensions abspath_in in + return (package_names, graph, utdoc) | OptionState.Markdown(setting) -> let* (package_names, utdoc) = register_markdown_file setting abspath_in in - return (package_names, FileDependencyGraph.empty, Some(utdoc)) + return (package_names, FileDependencyGraph.empty, utdoc) in let* sorted_locals = FileDependencyGraph.topological_sort graph |> Result.map_error (fun cycle -> CyclicFileDependency(cycle)) in - return (package_names, sorted_locals, utdoc_opt) + return (package_names, sorted_locals, utdoc) diff --git a/src/frontend/openFileDependencyResolver.mli b/src/frontend/openFileDependencyResolver.mli index be3410128..7fdc7df99 100644 --- a/src/frontend/openFileDependencyResolver.mli +++ b/src/frontend/openFileDependencyResolver.mli @@ -3,4 +3,4 @@ open MyUtil open Types open ConfigError -val main : extensions:(string list) -> abs_path -> (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file option, config_error) result +val main : extensions:(string list) -> abs_path -> (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file, config_error) result From da2866fa1f3a4d58f38a5c0fd5cc7b75c6d8798d Mon Sep 17 00:00:00 2001 From: gfngfn Date: Thu, 3 Nov 2022 22:38:59 +0900 Subject: [PATCH 075/288] add 'package.satysfi-lock' to packages --- .../annot/annot.0.0.1/package.satysfi-lock | 5 +++ .../code/code.0.0.1/package.satysfi-lock | 5 +++ .../package.satysfi-lock | 5 +++ .../itemize.0.0.1/package.satysfi-lock | 5 +++ .../math/math.0.0.1/package.satysfi-lock | 5 +++ .../md-ja/md-ja.0.0.1/package.satysfi-lock | 40 +++++++++++++++++++ .../proof/proof.0.0.1/package.satysfi-lock | 5 +++ .../std-ja-book.0.0.1/package.satysfi-lock | 33 +++++++++++++++ .../std-ja-report.0.0.1/package.satysfi-lock | 33 +++++++++++++++ .../std-ja/std-ja.0.0.1/package.satysfi-lock | 26 ++++++++++++ .../stdlib/stdlib.0.0.1/package.satysfi-lock | 1 + .../tabular.0.0.1/package.satysfi-lock | 5 +++ 12 files changed, 168 insertions(+) create mode 100644 lib-satysfi/dist/packages/annot/annot.0.0.1/package.satysfi-lock create mode 100644 lib-satysfi/dist/packages/code/code.0.0.1/package.satysfi-lock create mode 100644 lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/package.satysfi-lock create mode 100644 lib-satysfi/dist/packages/itemize/itemize.0.0.1/package.satysfi-lock create mode 100644 lib-satysfi/dist/packages/math/math.0.0.1/package.satysfi-lock create mode 100644 lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/package.satysfi-lock create mode 100644 lib-satysfi/dist/packages/proof/proof.0.0.1/package.satysfi-lock create mode 100644 lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/package.satysfi-lock create mode 100644 lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/package.satysfi-lock create mode 100644 lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/package.satysfi-lock create mode 100644 lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/package.satysfi-lock create mode 100644 lib-satysfi/dist/packages/tabular/tabular.0.0.1/package.satysfi-lock diff --git a/lib-satysfi/dist/packages/annot/annot.0.0.1/package.satysfi-lock b/lib-satysfi/dist/packages/annot/annot.0.0.1/package.satysfi-lock new file mode 100644 index 000000000..3a4c4e576 --- /dev/null +++ b/lib-satysfi/dist/packages/annot/annot.0.0.1/package.satysfi-lock @@ -0,0 +1,5 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/stdlib/stdlib.0.0.1/" diff --git a/lib-satysfi/dist/packages/code/code.0.0.1/package.satysfi-lock b/lib-satysfi/dist/packages/code/code.0.0.1/package.satysfi-lock new file mode 100644 index 000000000..3a4c4e576 --- /dev/null +++ b/lib-satysfi/dist/packages/code/code.0.0.1/package.satysfi-lock @@ -0,0 +1,5 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/stdlib/stdlib.0.0.1/" diff --git a/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/package.satysfi-lock b/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/package.satysfi-lock new file mode 100644 index 000000000..3a4c4e576 --- /dev/null +++ b/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/package.satysfi-lock @@ -0,0 +1,5 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/stdlib/stdlib.0.0.1/" diff --git a/lib-satysfi/dist/packages/itemize/itemize.0.0.1/package.satysfi-lock b/lib-satysfi/dist/packages/itemize/itemize.0.0.1/package.satysfi-lock new file mode 100644 index 000000000..3a4c4e576 --- /dev/null +++ b/lib-satysfi/dist/packages/itemize/itemize.0.0.1/package.satysfi-lock @@ -0,0 +1,5 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/stdlib/stdlib.0.0.1/" diff --git a/lib-satysfi/dist/packages/math/math.0.0.1/package.satysfi-lock b/lib-satysfi/dist/packages/math/math.0.0.1/package.satysfi-lock new file mode 100644 index 000000000..3a4c4e576 --- /dev/null +++ b/lib-satysfi/dist/packages/math/math.0.0.1/package.satysfi-lock @@ -0,0 +1,5 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/stdlib/stdlib.0.0.1/" diff --git a/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/package.satysfi-lock b/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/package.satysfi-lock new file mode 100644 index 000000000..08f78416a --- /dev/null +++ b/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/package.satysfi-lock @@ -0,0 +1,40 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/stdlib/stdlib.0.0.1/" + + - name: "math.0.0.1" + location: + type: "global" + path: "./dist/packages/math/math.0.0.1/" + dependencies: + - "stdlib.0.0.1" + + - name: "annot.0.0.1" + location: + type: "global" + path: "./dist/packages/annot/annot.0.0.1/" + dependencies: + - "stdlib.0.0.1" + + - name: "code.0.0.1" + location: + type: "global" + path: "./dist/packages/code/code.0.0.1/" + dependencies: + - "stdlib.0.0.1" + + - name: "footnote-scheme.0.0.1" + location: + type: "global" + path: "./dist/packages/footnote-scheme/footnote-scheme.0.0.1/" + dependencies: + - "stdlib.0.0.1" + + - name: "itemize.0.0.1" + location: + type: "global" + path: "./dist/packages/itemize/itemize.0.0.1" + dependencies: + - "stdlib.0.0.1" diff --git a/lib-satysfi/dist/packages/proof/proof.0.0.1/package.satysfi-lock b/lib-satysfi/dist/packages/proof/proof.0.0.1/package.satysfi-lock new file mode 100644 index 000000000..3a4c4e576 --- /dev/null +++ b/lib-satysfi/dist/packages/proof/proof.0.0.1/package.satysfi-lock @@ -0,0 +1,5 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/stdlib/stdlib.0.0.1/" diff --git a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/package.satysfi-lock b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/package.satysfi-lock new file mode 100644 index 000000000..c2af04a98 --- /dev/null +++ b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/package.satysfi-lock @@ -0,0 +1,33 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/stdlib/stdlib.0.0.1/" + + - name: "math.0.0.1" + location: + type: "global" + path: "./dist/packages/math/math.0.0.1/" + dependencies: + - "stdlib.0.0.1" + + - name: "annot.0.0.1" + location: + type: "global" + path: "./dist/packages/annot/annot.0.0.1/" + dependencies: + - "stdlib.0.0.1" + + - name: "code.0.0.1" + location: + type: "global" + path: "./dist/packages/code/code.0.0.1/" + dependencies: + - "stdlib.0.0.1" + + - name: "footnote-scheme.0.0.1" + location: + type: "global" + path: "./dist/packages/footnote-scheme/footnote-scheme.0.0.1/" + dependencies: + - "stdlib.0.0.1" diff --git a/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/package.satysfi-lock b/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/package.satysfi-lock new file mode 100644 index 000000000..c2af04a98 --- /dev/null +++ b/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/package.satysfi-lock @@ -0,0 +1,33 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/stdlib/stdlib.0.0.1/" + + - name: "math.0.0.1" + location: + type: "global" + path: "./dist/packages/math/math.0.0.1/" + dependencies: + - "stdlib.0.0.1" + + - name: "annot.0.0.1" + location: + type: "global" + path: "./dist/packages/annot/annot.0.0.1/" + dependencies: + - "stdlib.0.0.1" + + - name: "code.0.0.1" + location: + type: "global" + path: "./dist/packages/code/code.0.0.1/" + dependencies: + - "stdlib.0.0.1" + + - name: "footnote-scheme.0.0.1" + location: + type: "global" + path: "./dist/packages/footnote-scheme/footnote-scheme.0.0.1/" + dependencies: + - "stdlib.0.0.1" diff --git a/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/package.satysfi-lock b/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/package.satysfi-lock new file mode 100644 index 000000000..088d42950 --- /dev/null +++ b/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/package.satysfi-lock @@ -0,0 +1,26 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/stdlib/stdlib.0.0.1/" + + - name: "math.0.0.1" + location: + type: "global" + path: "./dist/packages/math/math.0.0.1/" + dependencies: + - "stdlib.0.0.1" + + - name: "annot.0.0.1" + location: + type: "global" + path: "./dist/packages/annot/annot.0.0.1/" + dependencies: + - "stdlib.0.0.1" + + - name: "code.0.0.1" + location: + type: "global" + path: "./dist/packages/code/code.0.0.1/" + dependencies: + - "stdlib.0.0.1" diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/package.satysfi-lock b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/package.satysfi-lock new file mode 100644 index 000000000..a2e98fa3c --- /dev/null +++ b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/package.satysfi-lock @@ -0,0 +1 @@ +locks: [] diff --git a/lib-satysfi/dist/packages/tabular/tabular.0.0.1/package.satysfi-lock b/lib-satysfi/dist/packages/tabular/tabular.0.0.1/package.satysfi-lock new file mode 100644 index 000000000..3a4c4e576 --- /dev/null +++ b/lib-satysfi/dist/packages/tabular/tabular.0.0.1/package.satysfi-lock @@ -0,0 +1,5 @@ +locks: + - name: "stdlib.0.0.1" + location: + type: "global" + path: "./dist/packages/stdlib/stdlib.0.0.1/" From 42ee6091048263019b4d96280791284faede0cb8 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Thu, 3 Nov 2022 22:48:07 +0900 Subject: [PATCH 076/288] set 'opam-depext' to false --- .github/workflows/ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index eaa510a50..c203a18df 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -51,7 +51,7 @@ jobs: ocaml-compiler: ${{ matrix.ocaml-version }} dune-cache: ${{ matrix.os != 'macos-latest' }} - opam-depext: true + opam-depext: false opam-pin: true opam-repositories: | From edc8e297481530d2e9bd1b863dd3d9bfdb683b8a Mon Sep 17 00:00:00 2001 From: gfngfn Date: Thu, 3 Nov 2022 23:01:52 +0900 Subject: [PATCH 077/288] set 'opam-depext' to true again --- .github/workflows/ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index c203a18df..eaa510a50 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -51,7 +51,7 @@ jobs: ocaml-compiler: ${{ matrix.ocaml-version }} dune-cache: ${{ matrix.os != 'macos-latest' }} - opam-depext: false + opam-depext: true opam-pin: true opam-repositories: | From 48fd6d6f4ac2df32ac9fe9574dfb452ae2afb63a Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 4 Nov 2022 00:00:52 +0900 Subject: [PATCH 078/288] re-support the 'Foo.(...)' syntax --- src/frontend/lexer.mll | 5 +++++ src/frontend/parser.mly | 7 ++++++- 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/src/frontend/lexer.mll b/src/frontend/lexer.mll index c8fbd3298..049cb9fd0 100644 --- a/src/frontend/lexer.mll +++ b/src/frontend/lexer.mll @@ -306,6 +306,11 @@ rule lex_program stack = parse let (modidents, lower_ident) = split_module_list pos s in LONG_LOWER(pos, modidents, lower_ident) } + | (upper as s) "." + { + let pos = get_pos lexbuf in + UPPER_DOT(pos, s) + } | lower { let tokstr = Lexing.lexeme lexbuf in diff --git a/src/frontend/parser.mly b/src/frontend/parser.mly index 0fcd85053..4d344a8ea 100644 --- a/src/frontend/parser.mly +++ b/src/frontend/parser.mly @@ -253,7 +253,7 @@ %token UNOP_EXCLAM %token LOWER -%token UPPER +%token UPPER UPPER_DOT %token LONG_LOWER %token LONG_UPPER @@ -929,6 +929,11 @@ expr_bot: | utast2 :: utast_rest -> make_standard (Tok tokL) (Tok tokR) (UTTuple(TupleList.make utast1 utast2 utast_rest)) } + | upper_dot=UPPER_DOT; L_PAREN; utast=expr; tokR=R_PAREN + { + let (tokL, _) = upper_dot in + make_standard (Tok tokL) (Tok tokR) (UTOpenIn(upper_dot, utast)) + } | utast=expr_bot_list { utast } | utast=expr_bot_record From 43612a83b84ccc7aa1d9a8efa5ba615f61892552 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 4 Nov 2022 03:07:09 +0900 Subject: [PATCH 079/288] fix 'subtype_type_scheme' --- src/frontend/main.ml | 3 ++- src/frontend/signatureSubtyping.ml | 7 +++++-- src/frontend/staticEnv.mli | 1 + 3 files changed, 8 insertions(+), 3 deletions(-) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 358c720ac..7a7fbd056 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -703,7 +703,8 @@ let report_type_error = function NormalLine(Printf.sprintf "not a subtype about constructor '%s' (TODO (enhance): detailed report)" ctornm); ] - | NotASubtypeAboutType(rng, tynm, _tentry1, _tentry2) -> + | NotASubtypeAboutType(rng, tynm, tentry1, tentry2) -> + Format.printf "1: %a,@ 2: %a@," pp_type_entry tentry1 pp_type_entry tentry2; (* TODO: remove this *) report_error Typechecker [ NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); NormalLine(Printf.sprintf "not a subtype about type '%s' (TODO (enhance): detailed report)" tynm); diff --git a/src/frontend/signatureSubtyping.ml b/src/frontend/signatureSubtyping.ml index cea569a0c..278048a87 100644 --- a/src/frontend/signatureSubtyping.ml +++ b/src/frontend/signatureSubtyping.ml @@ -63,6 +63,7 @@ let rec lookup_struct (rng : Range.t) (modsig1 : signature) (modsig2 : signature begin match lookup_type_entry tentry1 tentry2 with | None -> + let () = print_endline "****** 3" in (* TODO: remove this *) err (NotASubtypeAboutType(rng, tynm2, tentry1, tentry2)) | Some(subst0) -> @@ -345,6 +346,7 @@ and subtype_concrete_with_concrete (rng : Range.t) (modsig1 : signature) (modsig begin match (ssig1 |> StructSig.find_type tynm2, ssig2 |> StructSig.find_type tynm2) with | (Some(tentry1), Some(tentry2)) -> + print_endline "****** 1"; (* TODO: remove this *) err (NotASubtypeAboutType(rng, tynm2, tentry1, tentry2)) | _ -> @@ -369,6 +371,7 @@ and subtype_concrete_with_concrete (rng : Range.t) (modsig1 : signature) (modsig if b1 && b2 then return () else + let () = print_endline "****** 2" in (* TODO: remove this *) err (NotASubtypeAboutType(rng, tynm2, tentry1, tentry2)) ) ~m:(fun modnm2 { mod_signature = modsig2; _ } res -> @@ -565,9 +568,9 @@ and subtype_type_scheme (tyscheme1 : type_scheme) (tyscheme2 : type_scheme) : bo match pty2 with | (_, TypeVariable(PolyBound(bid2))) -> begin - match map |> BoundIDMap.find_opt bid1 with + match map |> BoundIDMap.find_opt bid2 with | None -> false - | Some(bid) -> BoundID.equal bid bid2 + | Some(bid) -> BoundID.equal bid bid1 end | _ -> diff --git a/src/frontend/staticEnv.mli b/src/frontend/staticEnv.mli index 1a3b7cc48..71c4f6e07 100644 --- a/src/frontend/staticEnv.mli +++ b/src/frontend/staticEnv.mli @@ -35,6 +35,7 @@ type type_entry = { type_scheme : type_scheme; type_kind : kind; } +[@@deriving show] type constructor_entry = { ctor_belongs_to : TypeID.t; From ddcc3847f900cc734b3335ff701b55244718053f Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 4 Nov 2022 03:37:22 +0900 Subject: [PATCH 080/288] extend 'UTConstructor' to take module names --- src/frontend/lexer.mll | 10 ++--- src/frontend/parser.mly | 24 ++++++++++-- src/frontend/typechecker.ml | 73 +++++++++++++++++++++++-------------- src/frontend/types.cppo.ml | 4 +- src/md/decodeMD.ml | 4 +- 5 files changed, 76 insertions(+), 39 deletions(-) diff --git a/src/frontend/lexer.mll b/src/frontend/lexer.mll index 049cb9fd0..cc3ca132b 100644 --- a/src/frontend/lexer.mll +++ b/src/frontend/lexer.mll @@ -306,11 +306,6 @@ rule lex_program stack = parse let (modidents, lower_ident) = split_module_list pos s in LONG_LOWER(pos, modidents, lower_ident) } - | (upper as s) "." - { - let pos = get_pos lexbuf in - UPPER_DOT(pos, s) - } | lower { let tokstr = Lexing.lexeme lexbuf in @@ -357,6 +352,11 @@ rule lex_program stack = parse let (modidents, upper_ident) = split_module_list pos s in LONG_UPPER(pos, modidents, upper_ident) } + | (upper as s) "." + { + let pos = get_pos lexbuf in + UPPER_DOT(pos, s) + } | upper { UPPER(get_pos lexbuf, Lexing.lexeme lexbuf) } | (digit | (nzdigit digit+)) diff --git a/src/frontend/parser.mly b/src/frontend/parser.mly index 4d344a8ea..cc6078039 100644 --- a/src/frontend/parser.mly +++ b/src/frontend/parser.mly @@ -845,12 +845,23 @@ expr_op: | tok=EXACT_MINUS; utast2=expr_app { make_uminus tok utast2 } | ctor=UPPER; utast2=expr_un - { make_standard (Ranged ctor) (Ranged utast2) (UTConstructor(extract_main ctor, utast2)) } + { make_standard (Ranged ctor) (Ranged utast2) (UTConstructor([], extract_main ctor, utast2)) } + | long_ctor=LONG_UPPER; utast2=expr_un + { + let (rng, modidents, ctor) = long_ctor in + make_standard (Tok rng) (Ranged utast2) (UTConstructor(modidents, extract_main ctor, utast2)) + } | ctor=UPPER { let utast_unit = (Range.dummy "constructor-unitvalue", UTUnitConstant) in let (rng, ctornm) = ctor in - (rng, UTConstructor(ctornm, utast_unit)) + (rng, UTConstructor([], ctornm, utast_unit)) + } + | long_ctor=LONG_UPPER + { + let (rng, modidents, ctor) = long_ctor in + let utast_unit = (Range.dummy "constructor-unitvalue", UTUnitConstant) in + (rng, UTConstructor(modidents, extract_main ctor, utast_unit)) } | utast=expr_app { utast } @@ -864,7 +875,14 @@ expr_app: { let utast_unit = (Range.dummy "constructor-unitvalue", UTUnitConstant) in let (rng, ctornm) = ctor in - let utast2 = (rng, UTConstructor(ctornm, utast_unit)) in + let utast2 = (rng, UTConstructor([], ctornm, utast_unit)) in + make_standard (Ranged utast1) (Tok rng) (UTApply(mnopts, utast1, utast2)) + } + | utast1=expr_app; mnopts=expr_opts; long_ctor=LONG_UPPER + { + let (rng, modidents, ctor) = long_ctor in + let utast_unit = (Range.dummy "constructor-unitvalue", UTUnitConstant) in + let utast2 = (rng, UTConstructor(modidents, extract_main ctor, utast_unit)) in make_standard (Ranged utast1) (Tok rng) (UTApply(mnopts, utast1, utast2)) } | utast=expr_un diff --git a/src/frontend/typechecker.ml b/src/frontend/typechecker.ml index e514a7aa2..de816e7c2 100644 --- a/src/frontend/typechecker.ml +++ b/src/frontend/typechecker.ml @@ -12,32 +12,49 @@ module PatternVarMap = Map.Make(String) type pattern_var_map = (Range.t * EvalVarID.t * mono_type) PatternVarMap.t -let find_constructor_and_instantiate (pre : pre) (tyenv : Typeenv.t) (ctornm : constructor_name) (rng : Range.t) : (mono_type list * TypeID.t * mono_type) ok = +let find_constructor (rng : Range.t) (tyenv : Typeenv.t) (modidents : (module_name ranged) list) (ctornm : constructor_name) : constructor_entry ok = let open ResultMonad in - match tyenv |> Typeenv.find_constructor ctornm with + let* centry_opt = + match modidents with + | [] -> + return (tyenv |> Typeenv.find_constructor ctornm) + + | modident0 :: proj -> + let modchain = (modident0, proj) in + let* mentry = find_module_chain tyenv modchain in + let* ssig = + match mentry.mod_signature with + | ConcStructure(ssig) -> return ssig + | ConcFunctor(fsig) -> err (NotAStructureSignature(rng, fsig)) + (*TODO (error): give a better code range to this error. *) + in + return (ssig |> StructSig.find_constructor ctornm) + in + match centry_opt with | None -> - let cands = - [] (* TODO (error): find candidate constructors *) - (* tyenv |> Typeenv.find_constructor_candidates ctornm *) - in + let cands = [] in (* TODO (error): find candidate constructors *) err (UndefinedConstructor(rng, ctornm, cands)) | Some(centry) -> - let qtfbl = pre.quantifiability in - let lev = pre.level in - let tyid = centry.ctor_belongs_to in - let (bids, pty) = centry.ctor_parameter in - let (bidmap, tyacc) = - bids |> List.fold_left (fun (bidmap, tyacc) bid -> - let fid = fresh_free_id qtfbl lev in - let tv = Updatable(ref (MonoFree(fid))) in - let ty = (Range.dummy "tc-constructor", TypeVariable(tv)) in - (bidmap |> BoundIDMap.add bid ty, Alist.extend tyacc ty) - ) (BoundIDMap.empty, Alist.empty) - in - let ty = TypeConv.instantiate_by_map_mono bidmap pty in - let tys_arg = Alist.to_list tyacc in - return (tys_arg, tyid, ty) + return centry + + +let instantiate_constructor (pre : pre) (centry : constructor_entry) : mono_type list * TypeID.t * mono_type = + let qtfbl = pre.quantifiability in + let lev = pre.level in + let tyid = centry.ctor_belongs_to in + let (bids, pty) = centry.ctor_parameter in + let (bidmap, tyacc) = + bids |> List.fold_left (fun (bidmap, tyacc) bid -> + let fid = fresh_free_id qtfbl lev in + let tv = Updatable(ref (MonoFree(fid))) in + let ty = (Range.dummy "tc-constructor", TypeVariable(tv)) in + (bidmap |> BoundIDMap.add bid ty, Alist.extend tyacc ty) + ) (BoundIDMap.empty, Alist.empty) + in + let ty = TypeConv.instantiate_by_map_mono bidmap pty in + let tys_arg = Alist.to_list tyacc in + (tys_arg, tyid, ty) let find_macro (tyenv : Typeenv.t) (modidents : (module_name ranged) list) ((rng_cs, csnm) : macro_name ranged) : macro_entry ok = @@ -230,11 +247,12 @@ let rec typecheck_pattern (pre : pre) (tyenv : Typeenv.t) ((rng, utpatmain) : un return (PAsVariable(evid, epat1), typat1, patvarmap1 |> PatternVarMap.add varnm (rng, evid, beta)) end - | UTPConstructor(constrnm, utpat1) -> - let* (tyargs, tyid, tyc) = find_constructor_and_instantiate pre tyenv constrnm rng in + | UTPConstructor(ctornm, utpat1) -> + let* centry = find_constructor rng tyenv [] ctornm in + let (tyargs, tyid, tyc) = instantiate_constructor pre centry in let* (epat1, typat1, tyenv1) = iter utpat1 in let* () = unify tyc typat1 in - return (PConstructor(constrnm, epat1), (rng, DataType(tyargs, tyid)), tyenv1) + return (PConstructor(ctornm, epat1), (rng, DataType(tyargs, tyid)), tyenv1) let rec typecheck (pre : pre) (tyenv : Typeenv.t) ((rng, utastmain) : untyped_abstract_tree) : (abstract_tree * mono_type) ok = @@ -405,12 +423,13 @@ let rec typecheck (pre : pre) (tyenv : Typeenv.t) ((rng, utastmain) : untyped_ab let tyres = TypeConv.overwrite_range_of_type tyfree rng in return (e, tyres) - | UTConstructor(constrnm, utast1) -> - let* (tyargs, tyid, tyc) = find_constructor_and_instantiate pre tyenv constrnm rng in + | UTConstructor(modidents, ctornm, utast1) -> + let* centry = find_constructor rng tyenv modidents ctornm in + let (tyargs, tyid, tyc) = instantiate_constructor pre centry in let* (e1, ty1) = typecheck_iter tyenv utast1 in let* () = unify ty1 tyc in let tyres = (rng, DataType(tyargs, tyid)) in - return (NonValueConstructor(constrnm, e1), tyres) + return (NonValueConstructor(ctornm, e1), tyres) | UTLambdaInlineCommand{ parameters = param_units; diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index d14fa13b6..7b6ad79b6 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -526,14 +526,14 @@ and untyped_abstract_tree_main = | UTAccessField of untyped_abstract_tree * label ranged | UTUpdateField of untyped_abstract_tree * label ranged * untyped_abstract_tree (* Fundamentals: *) - | UTContentOf of ((module_name ranged) list) * var_name ranged + | UTContentOf of (module_name ranged) list * var_name ranged | UTApply of (label ranged * untyped_abstract_tree) list * untyped_abstract_tree * untyped_abstract_tree | UTLetIn of untyped_rec_or_nonrec * untyped_abstract_tree | UTIfThenElse of untyped_abstract_tree * untyped_abstract_tree * untyped_abstract_tree | UTFunction of untyped_parameter_unit * untyped_abstract_tree | UTOpenIn of module_name ranged * untyped_abstract_tree | UTPatternMatch of untyped_abstract_tree * untyped_pattern_branch list - | UTConstructor of constructor_name * untyped_abstract_tree + | UTConstructor of (module_name ranged) list * constructor_name * untyped_abstract_tree | UTOverwrite of var_name ranged * untyped_abstract_tree (* Lightweight itemizes: *) | UTItemize of untyped_itemize diff --git a/src/md/decodeMD.ml b/src/md/decodeMD.ml index 5b326fe4c..2fd22a023 100644 --- a/src/md/decodeMD.ml +++ b/src/md/decodeMD.ml @@ -334,13 +334,13 @@ let rec convert_inline_element (cmdrcd : command_record) (ilne : inline_element) let utastarg3 = match refopt with | None -> - (dummy_range, UTConstructor("None", (dummy_range, UTUnitConstant))) + (dummy_range, UTConstructor([], "None", (dummy_range, UTUnitConstant))) | Some((title, url)) -> let u1 = (dummy_range, UTStringConstant(title)) in let u2 = (dummy_range, UTStringConstant(url)) in let upair = (dummy_range, UTTuple(TupleList.make u1 u2 [])) in - (dummy_range, UTConstructor("Some", upair)) + (dummy_range, UTConstructor([], "Some", upair)) in make_inline_application cmdrcd.reference [utastarg1; utastarg2; utastarg3] From 288a2dbd4bd342c601c684319ea09ed6bc0bf8a7 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 4 Nov 2022 03:50:40 +0900 Subject: [PATCH 081/288] update the parser test --- test/parsing/parser.expected | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/test/parsing/parser.expected b/test/parsing/parser.expected index 98c4de8db..268148c5c 100644 --- a/test/parsing/parser.expected +++ b/test/parsing/parser.expected @@ -481,7 +481,7 @@ (UTApply ([], (UTContentOf ([], ((Range.Normal ), "*"))), - (UTConstructor ("F", + (UTConstructor ([], "F", (UTContentOf ([], ((Range.Normal ), "a"))) )) @@ -493,7 +493,7 @@ (UTApply ([], (UTContentOf ([], ((Range.Normal ), "*"))), - (UTConstructor ("A", UTUnitConstant)))), + (UTConstructor ([], "A", UTUnitConstant)))), (UTContentOf ([], ((Range.Normal ), "b"))) )) @@ -570,7 +570,7 @@ (UTContentOf ([], ((Range.Normal ), "a"))) )), - (UTConstructor ("F", + (UTConstructor ([], "F", (UTContentOf ([], ((Range.Normal ), "b"))) )) @@ -582,7 +582,7 @@ (UTContentOf ([], ((Range.Normal ), "a"))) )), - (UTConstructor ("B", UTUnitConstant)))) + (UTConstructor ([], "B", UTUnitConstant)))) (UTApply ([], (UTApply ([], (UTContentOf ([], @@ -601,7 +601,7 @@ (UTApply ([], (UTContentOf ([], ((Range.Normal ), "*"))), - (UTConstructor ("F", + (UTConstructor ([], "F", (UTContentOf ([], ((Range.Normal ), "a"))) )) @@ -613,7 +613,7 @@ (UTApply ([], (UTContentOf ([], ((Range.Normal ), "*"))), - (UTConstructor ("A", UTUnitConstant)))), + (UTConstructor ([], "A", UTUnitConstant)))), (UTContentOf ([], ((Range.Normal ), "b"))) ))))) From e911722bf863ff0ffc3344e9d0292d3bcb77e881 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 4 Nov 2022 04:57:02 +0900 Subject: [PATCH 082/288] implement 'update_subsignature' for 'with type' --- src/frontend/moduleTypechecker.ml | 44 +++++++++++++++++++++++++++++-- 1 file changed, 42 insertions(+), 2 deletions(-) diff --git a/src/frontend/moduleTypechecker.ml b/src/frontend/moduleTypechecker.ml index 6397c33bd..3ba9b0c7c 100644 --- a/src/frontend/moduleTypechecker.ml +++ b/src/frontend/moduleTypechecker.ml @@ -116,6 +116,38 @@ let add_constructor_definitions (ctordefs : variant_definition list) (ssig : Str ) ssig +let rec update_subsignature (modnms : module_name list) (updater : signature -> signature) (modsig : signature) : signature = + match modnms with + | [] -> + updater modsig + + | modnm0 :: proj -> + begin + match modsig with + | ConcFunctor(_) -> + assert false + + | ConcStructure(ssig) -> + let ssig = + ssig |> StructSig.map + ~v:(fun _x ventry -> ventry) + ~a:(fun _csnm macentry -> macentry) + ~c:(fun _ctornm centry -> centry) + ~f:(fun _tynm pty -> pty) + ~t:(fun _tynm tentry -> tentry) + ~m:(fun modnm mentry -> + if String.equal modnm modnm0 then + let modsig = mentry.mod_signature |> update_subsignature proj updater in + { mod_signature = modsig } + else + mentry + ) + ~s:(fun _signm sentry -> sentry) + in + ConcStructure(ssig) + end + + let add_macro_parameters_to_type_environment (tyenv : Typeenv.t) (pre : pre) (macparams : untyped_macro_parameter list) : Typeenv.t * EvalVarID.t list * mono_macro_parameter_type list = let (tyenv, evidacc, macparamtyacc) = macparams |> List.fold_left (fun (tyenv, evidacc, macptyacc) macparam -> @@ -448,7 +480,7 @@ let rec typecheck_signature (tyenv : Typeenv.t) (utsig : untyped_signature) : (s end ) ssig0 in - let* (tydefs, _ctordefs) = bind_types tyenv tybinds in + let* (tydefs, ctordefs) = bind_types tyenv tybinds in let* (subst, quant) = tydefs |> foldM (fun (subst, quant) (tynm, tentry) -> let* (tyid, kd_expected) = @@ -477,7 +509,15 @@ let rec typecheck_signature (tyenv : Typeenv.t) (utsig : untyped_signature) : (s ) (SubstMap.empty, quant0) in let modsig = modsig0 |> SignatureSubtyping.substitute_concrete subst in - (* TODO: use `ctordefs` to update `modsig` *) + let modsig = + modsig |> update_subsignature (modidents |> List.map (fun (_, modnm) -> modnm)) (function + | ConcFunctor(_) -> + assert false + + | ConcStructure(ssig) -> + ConcStructure(ssig |> add_constructor_definitions ctordefs) + ) + in return (quant, modsig) From 35685083c2f5acf513ca630bf5d0f15583f57951 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 4 Nov 2022 05:17:37 +0900 Subject: [PATCH 083/288] extend 'UTPConstructor' to take module names --- src/frontend/parser.mly | 31 +++++++++++++++++++++++++++---- src/frontend/typechecker.ml | 4 ++-- src/frontend/types.cppo.ml | 2 +- 3 files changed, 30 insertions(+), 7 deletions(-) diff --git a/src/frontend/parser.mly b/src/frontend/parser.mly index cc6078039..2fe23406a 100644 --- a/src/frontend/parser.mly +++ b/src/frontend/parser.mly @@ -1023,11 +1023,23 @@ pattern_cons: | utpat1=pattern_bot; CONS; utpat2=pattern_cons { make_standard (Ranged utpat1) (Ranged utpat2) (UTPListCons(utpat1, utpat2)) } | ctor=UPPER; utpat=pattern_bot - { make_standard (Ranged ctor) (Ranged utpat) (UTPConstructor(extract_main ctor, utpat)) } + { make_standard (Ranged ctor) (Ranged utpat) (UTPConstructor([], extract_main ctor, utpat)) } + | long_ctor=LONG_UPPER; utpat=pattern_bot + { + let (rng, modidents, ctor) = long_ctor in + make_standard (Tok rng) (Ranged utpat) (UTPConstructor(modidents, extract_main ctor, utpat)) + } | ctor=UPPER { let utast_unit = (Range.dummy "constructor-unit-value", UTPUnitConstant) in - let (rng, ctornm) = ctor in (rng, UTPConstructor(ctornm, utast_unit)) + let (rng, ctornm) = ctor in + (rng, UTPConstructor([], ctornm, utast_unit)) + } + | long_ctor=LONG_UPPER + { + let (rng, modidents, ctor) = long_ctor in + let utast_unit = (Range.dummy "constructor-unit-value", UTPUnitConstant) in + (rng, UTPConstructor(modidents, extract_main ctor, utast_unit)) } | utpat=pattern_bot { utpat } @@ -1036,11 +1048,22 @@ pattern_non_var_cons: | utpat1=pattern_bot; CONS; utpat2=pattern_cons { make_standard (Ranged utpat1) (Ranged utpat2) (UTPListCons(utpat1, utpat2)) } | ctor=UPPER; utpat=pattern_bot - { make_standard (Ranged ctor) (Ranged utpat) (UTPConstructor(extract_main ctor, utpat)) } + { make_standard (Ranged ctor) (Ranged utpat) (UTPConstructor([], extract_main ctor, utpat)) } + | long_ctor=LONG_UPPER; utpat=pattern_bot + { + let (rng, modidents, ctor) = long_ctor in + make_standard (Tok rng) (Ranged utpat) (UTPConstructor(modidents, extract_main ctor, utpat)) + } | ctor=UPPER { let utast_unit = (Range.dummy "constructor-unit-value", UTPUnitConstant) in - let (rng, ctornm) = ctor in (rng, UTPConstructor(ctornm, utast_unit)) + let (rng, ctornm) = ctor in (rng, UTPConstructor([], ctornm, utast_unit)) + } + | long_ctor=LONG_UPPER + { + let (rng, modidents, ctor) = long_ctor in + let utast_unit = (Range.dummy "constructor-unit-value", UTPUnitConstant) in + (rng, UTPConstructor(modidents, extract_main ctor, utast_unit)) } | utpat=pattern_non_var_bot { utpat } diff --git a/src/frontend/typechecker.ml b/src/frontend/typechecker.ml index de816e7c2..5300d3059 100644 --- a/src/frontend/typechecker.ml +++ b/src/frontend/typechecker.ml @@ -247,8 +247,8 @@ let rec typecheck_pattern (pre : pre) (tyenv : Typeenv.t) ((rng, utpatmain) : un return (PAsVariable(evid, epat1), typat1, patvarmap1 |> PatternVarMap.add varnm (rng, evid, beta)) end - | UTPConstructor(ctornm, utpat1) -> - let* centry = find_constructor rng tyenv [] ctornm in + | UTPConstructor(modidents, ctornm, utpat1) -> + let* centry = find_constructor rng tyenv modidents ctornm in let (tyargs, tyid, tyc) = instantiate_constructor pre centry in let* (epat1, typat1, tyenv1) = iter utpat1 in let* () = unify tyc typat1 in diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index 7b6ad79b6..c9ec1ccd2 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -558,7 +558,7 @@ and untyped_pattern_tree_main = | UTPWildCard | UTPVariable of var_name | UTPAsVariable of var_name * untyped_pattern_tree - | UTPConstructor of constructor_name * untyped_pattern_tree + | UTPConstructor of (module_name ranged) list * constructor_name * untyped_pattern_tree and untyped_pattern_branch = | UTPatternBranch of untyped_pattern_tree * untyped_abstract_tree From f06325af7b73056322bd824c7a160bf412a9b716 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 5 Nov 2022 01:01:18 +0900 Subject: [PATCH 084/288] remove OCaml 4.12.1 from CI --- .github/workflows/ci.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index eaa510a50..3536ef009 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -10,7 +10,6 @@ jobs: matrix: os: [ 'ubuntu-latest', 'macos-latest' ] ocaml-version: - - 4.12.1 - 4.13.1 - 4.14.0 runs-on: ${{ matrix.os }} From 7943569c0b14668354400a063ff24a174f10ea27 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 5 Nov 2022 04:04:30 +0900 Subject: [PATCH 085/288] make lock configs support 'local' --- src/frontend/lockConfig.ml | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/src/frontend/lockConfig.ml b/src/frontend/lockConfig.ml index aca69f347..d0e25a0fe 100644 --- a/src/frontend/lockConfig.ml +++ b/src/frontend/lockConfig.ml @@ -14,7 +14,7 @@ type t = { module LockConfigDecoder = YamlDecoder.Make(YamlError) -let lock_location_decoder : abs_path LockConfigDecoder.t = +let lock_location_decoder ~(lock_config_dir : abs_path) : abs_path LockConfigDecoder.t = let open LockConfigDecoder in branch "type" [ "global" ==> begin @@ -24,16 +24,23 @@ let lock_location_decoder : abs_path LockConfigDecoder.t = | Ok(abspath) -> succeed abspath | Error(candidates) -> failure (fun _context -> PackageNotFound(libpath, candidates)) end; + "local" ==> begin + get "path" string >>= fun s_relpath -> + let abspath = + make_abs_path (Filename.concat (get_abs_path_string lock_config_dir) s_relpath) + in + succeed abspath + end; ] ~other:(fun tag -> failure (fun context -> UnexpectedTag(context, tag)) ) -let lock_decoder : lock_info LockConfigDecoder.t = +let lock_decoder ~(lock_config_dir : abs_path) : lock_info LockConfigDecoder.t = let open LockConfigDecoder in get "name" string >>= fun lock_name -> - get "location" lock_location_decoder >>= fun lock_directory -> + get "location" (lock_location_decoder ~lock_config_dir) >>= fun lock_directory -> get_or_else "dependencies" (list string) [] >>= fun lock_dependencies -> succeed { lock_name; @@ -42,9 +49,9 @@ let lock_decoder : lock_info LockConfigDecoder.t = } -let lock_config_decoder : t LockConfigDecoder.t = +let lock_config_decoder ~(lock_config_dir : abs_path) : t LockConfigDecoder.t = let open LockConfigDecoder in - get_or_else "locks" (list lock_decoder) [] >>= fun locked_packages -> + get_or_else "locks" (list (lock_decoder ~lock_config_dir)) [] >>= fun locked_packages -> succeed { locked_packages; } @@ -60,5 +67,6 @@ let load (abspath_lock_config : abs_path) : t ok = in let s = Core.In_channel.input_all inc in close_in inc; - LockConfigDecoder.run lock_config_decoder s + let lock_config_dir = make_abs_path (Filename.dirname (get_abs_path_string abspath_lock_config)) in + LockConfigDecoder.run (lock_config_decoder ~lock_config_dir) s |> Result.map_error (fun e -> LockConfigError(abspath_lock_config, e)) From 03874ea829549a256d70ac9c5b06c74c26a30fb8 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 7 Nov 2022 01:45:29 +0900 Subject: [PATCH 086/288] begin to develop 'PackageConstraintSolver' --- satysfi.opam | 1 + src/dune | 3 +- src/frontend/packageConstraintSolver.ml | 183 ++++++++++++++++++++++++ 3 files changed, 186 insertions(+), 1 deletion(-) create mode 100644 src/frontend/packageConstraintSolver.ml diff --git a/satysfi.opam b/satysfi.opam index 99782f65c..4845ffdf1 100644 --- a/satysfi.opam +++ b/satysfi.opam @@ -39,6 +39,7 @@ depends: [ "ocamlgraph" "alcotest" {with-test & >= "1.4.0"} "yaml" {>= "2.1.0"} + "0install-solver" {>= "2.0" & < "3.0"} ] synopsis: "A statically-typed, functional typesetting system" description: """ diff --git a/src/dune b/src/dune index be549f789..924a4f3e0 100644 --- a/src/dune +++ b/src/dune @@ -16,7 +16,8 @@ yojson-with-position omd ocamlgraph - yaml) + yaml + 0install-solver) (preprocess (pps ppx_deriving.show )) diff --git a/src/frontend/packageConstraintSolver.ml b/src/frontend/packageConstraintSolver.ml new file mode 100644 index 000000000..ddbf7daa1 --- /dev/null +++ b/src/frontend/packageConstraintSolver.ml @@ -0,0 +1,183 @@ + +type package_name = string + +type semver = string + + +let is_backward_compatible ~new_:(_ : semver) ~old:(_ : semver) : bool = + failwith "TODO: is_backward_compatible" + + +module SolverInput = struct + + module Role = struct + + type t = package_name + + + let pp ppf s = + Format.fprintf ppf "%s" s + + + let compare = + String.compare + + end + + + (* Unused *) + type command = unit + + (* Unused *) + type command_name = string + + type restriction = + | CompatibleWith of semver + + type dependency = + | Dependency of { + role : Role.t; + restrictions : restriction list; + } + + type dep_info = { + dep_role : Role.t; + dep_importance : [ `Essential | `Recommended | `Restricts ]; + dep_required_commands : command_name list; + } + + type requirements = { + role : Role.t; + command : command_name option; + } + + type impl = + | DummyImpl + | Impl of { + role : Role.t; + version : semver; + dependencies : dependency list; + } + + type role_information = { + replacement : Role.t option; + impls : impl list; + } + + (* Unused *) + type machine_group = string + + type conflict_class = string + + type rejection = unit (* TODO: define this *) + + + let pp_impl (_ppf : Format.formatter) (_impl : impl) = + failwith "TODO: SolverInput.pp_impl" + + + let pp_impl_long (_ppf : Format.formatter) (_impl : impl) = + failwith "TODO: SolverInput.pp_impl_long" + + + (* Unused *) + let pp_command (_ppf : Format.formatter) (_cmd : command) = + () + + + let pp_version (_ppf : Format.formatter) (_impl : impl) = + failwith "TODO: SolverInput.pp_version" + + + (* Unused *) + let get_command (_impl : impl) (_cmdnm : command_name) = + None + + + let dep_info (dep : dependency) : dep_info = + let Dependency{ role; _ } = dep in + { dep_role = role; dep_importance = `Essential; dep_required_commands = [] } + + + let requires (_role : Role.t) (impl : impl) : dependency list * command_name list = + match impl with + | DummyImpl -> ([], []) + | Impl{ dependencies; _ } -> (dependencies, []) + + + (* Unused *) + let command_requires (_role : Role.t) (_cmd : command) = + ([], []) + + + let implementations (_role : Role.t) : role_information = + failwith "TODO: SolverInput.implementations; must access registry" + + + let restrictions (dep : dependency) : restriction list = + let Dependency{ restrictions; _ } = dep in + restrictions + + + let meets_restriction (impl : impl) (restr : restriction) : bool = + match impl with + | DummyImpl -> + false + + | Impl{ version = semver_provided; _} -> + begin + match restr with + | CompatibleWith(semver_required) -> + is_backward_compatible ~new_:semver_provided ~old:semver_required + end + + + (* Unused *) + let machine_group (_impl : impl) : machine_group option = + None + + + let conflict_class (impl : impl) : conflict_class list = + match impl with + | DummyImpl -> [] + | Impl{ role; _ } -> [ role ] (* TODO: take major versions into account *) + + + let rejects (_role : Role.t) : (impl * rejection) list * string list = + failwith "TODO: SolverInput.rejects" + + + let compare_version (_impl1 : impl) (_impl2 : impl) : int = + failwith "TODO: SolverInput.compare_version" + + + let user_restrictions (_role : Role.t) : restriction option = + None + + + let format_machine (_impl : impl) : string = + "" + + + let string_of_restriction (_restr : restriction) : string = + failwith "TODO: SolverInput.string_of_restriction" + + + let describe_problem (_impl : impl) (_rej : rejection) : string = + failwith "TODO: SolverInput.describe_problem" + + + let dummy_impl : impl = + DummyImpl + +end + + +module Impl = Zeroinstall_solver.Make(SolverInput) + + +let solve (package_name : package_name) = + Impl.do_solve { + role = package_name; + command = None; + } From 3ebfbe117e6963ae3cb8e5231c3e501b18c65efb Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 7 Nov 2022 02:21:12 +0900 Subject: [PATCH 087/288] develop 'PackageConstraintSolver' about semver --- satysfi.opam | 1 + src/dune | 3 +- src/frontend/packageConstraintSolver.ml | 50 ++++++++++++++----------- src/frontend/semanticVersion.ml | 26 +++++++++++++ src/frontend/semanticVersion.mli | 10 +++++ 5 files changed, 68 insertions(+), 22 deletions(-) create mode 100644 src/frontend/semanticVersion.ml create mode 100644 src/frontend/semanticVersion.mli diff --git a/satysfi.opam b/satysfi.opam index 4845ffdf1..feae54825 100644 --- a/satysfi.opam +++ b/satysfi.opam @@ -40,6 +40,7 @@ depends: [ "alcotest" {with-test & >= "1.4.0"} "yaml" {>= "2.1.0"} "0install-solver" {>= "2.0" & < "3.0"} + "semver2" {>= "1.2.0"} ] synopsis: "A statically-typed, functional typesetting system" description: """ diff --git a/src/dune b/src/dune index 924a4f3e0..96e3eadd5 100644 --- a/src/dune +++ b/src/dune @@ -17,7 +17,8 @@ omd ocamlgraph yaml - 0install-solver) + 0install-solver + semver2) (preprocess (pps ppx_deriving.show )) diff --git a/src/frontend/packageConstraintSolver.ml b/src/frontend/packageConstraintSolver.ml index ddbf7daa1..ea8d92287 100644 --- a/src/frontend/packageConstraintSolver.ml +++ b/src/frontend/packageConstraintSolver.ml @@ -1,12 +1,6 @@ type package_name = string -type semver = string - - -let is_backward_compatible ~new_:(_ : semver) ~old:(_ : semver) : bool = - failwith "TODO: is_backward_compatible" - module SolverInput = struct @@ -32,7 +26,7 @@ module SolverInput = struct type command_name = string type restriction = - | CompatibleWith of semver + | CompatibleWith of SemanticVersion.t type dependency = | Dependency of { @@ -55,7 +49,7 @@ module SolverInput = struct | DummyImpl | Impl of { role : Role.t; - version : semver; + version : SemanticVersion.t; dependencies : dependency list; } @@ -72,12 +66,17 @@ module SolverInput = struct type rejection = unit (* TODO: define this *) - let pp_impl (_ppf : Format.formatter) (_impl : impl) = - failwith "TODO: SolverInput.pp_impl" + let pp_impl (ppf : Format.formatter) (impl : impl) = + match impl with + | DummyImpl -> + Format.fprintf ppf "dummy" + + | Impl{ role; version; _ } -> + Format.fprintf ppf "%s %s" role (SemanticVersion.to_string version) - let pp_impl_long (_ppf : Format.formatter) (_impl : impl) = - failwith "TODO: SolverInput.pp_impl_long" + let pp_impl_long (ppf : Format.formatter) (impl : impl) = + pp_impl ppf impl (* TODO: show dependencies *) (* Unused *) @@ -85,8 +84,10 @@ module SolverInput = struct () - let pp_version (_ppf : Format.formatter) (_impl : impl) = - failwith "TODO: SolverInput.pp_version" + let pp_version (ppf : Format.formatter) (impl : impl) = + match impl with + | DummyImpl -> Format.fprintf ppf "dummy" + | Impl{ version; _ } -> Format.fprintf ppf "%s" (SemanticVersion.to_string version) (* Unused *) @@ -128,7 +129,7 @@ module SolverInput = struct begin match restr with | CompatibleWith(semver_required) -> - is_backward_compatible ~new_:semver_provided ~old:semver_required + SemanticVersion.is_compatible ~old:semver_required ~new_:semver_provided end @@ -144,11 +145,17 @@ module SolverInput = struct let rejects (_role : Role.t) : (impl * rejection) list * string list = - failwith "TODO: SolverInput.rejects" + ([], []) (* TODO: define `rejection` and implement this *) + + let compare_version (impl1 : impl) (impl2 : impl) : int = + match (impl1, impl2) with + | (DummyImpl, DummyImpl) -> 0 + | (DummyImpl, _) -> 1 + | (_, DummyImpl) -> -1 - let compare_version (_impl1 : impl) (_impl2 : impl) : int = - failwith "TODO: SolverInput.compare_version" + | (Impl{ version = semver1; _ }, Impl{ version = semver2; _ }) -> + SemanticVersion.compare semver1 semver2 let user_restrictions (_role : Role.t) : restriction option = @@ -159,12 +166,13 @@ module SolverInput = struct "" - let string_of_restriction (_restr : restriction) : string = - failwith "TODO: SolverInput.string_of_restriction" + let string_of_restriction (restr : restriction) : string = + match restr with + | CompatibleWith(semver) -> SemanticVersion.to_string semver let describe_problem (_impl : impl) (_rej : rejection) : string = - failwith "TODO: SolverInput.describe_problem" + "" (* TODO: define `rejection` and implement this *) let dummy_impl : impl = diff --git a/src/frontend/semanticVersion.ml b/src/frontend/semanticVersion.ml new file mode 100644 index 000000000..29cc422c3 --- /dev/null +++ b/src/frontend/semanticVersion.ml @@ -0,0 +1,26 @@ + +type t = Semver.t + + +let parse (s : string) : t option = + Semver.of_string s + + +let to_string (semver : t) : string = + Semver.to_string semver + + +let compare = + Semver.compare + + +let is_compatible ~(old : t) ~(new_ : t) = + let open Semver in + match (old.major, new_.major) with + | (0, 0) -> + old.minor = new_.minor && old.patch <= new_.patch + + | _ -> + old.major = new_.major && + ((old.minor < new_.minor) || + (old.minor == new_.minor && old.patch <= new_.patch)) diff --git a/src/frontend/semanticVersion.mli b/src/frontend/semanticVersion.mli new file mode 100644 index 000000000..043247e5b --- /dev/null +++ b/src/frontend/semanticVersion.mli @@ -0,0 +1,10 @@ + +type t + +val parse : string -> t option + +val to_string : t -> string + +val compare : t -> t -> int + +val is_compatible : old:t -> new_:t -> bool From 8c3d612d91cb05bbddab19036ada7d1b02f22b45 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 7 Nov 2022 02:44:59 +0900 Subject: [PATCH 088/288] develop 'PackageConstraintSolver.solve' --- src/frontend/packageConstraintSolver.ml | 57 +++++++++++++++++++++---- 1 file changed, 49 insertions(+), 8 deletions(-) diff --git a/src/frontend/packageConstraintSolver.ml b/src/frontend/packageConstraintSolver.ml index ea8d92287..9d4a5611b 100644 --- a/src/frontend/packageConstraintSolver.ml +++ b/src/frontend/packageConstraintSolver.ml @@ -181,11 +181,52 @@ module SolverInput = struct end -module Impl = Zeroinstall_solver.Make(SolverInput) - - -let solve (package_name : package_name) = - Impl.do_solve { - role = package_name; - command = None; - } +module InternalSolver = Zeroinstall_solver.Make(SolverInput) + + +type package_solution = { + package_name : package_name; + locked_version : SemanticVersion.t; + dependencies : (package_name * SemanticVersion.t) list; +} + + +let solve (package_name : package_name) : (package_solution list) option = + let output_opt = + InternalSolver.do_solve ~closest_match:false { + role = package_name; + command = None; + } + in + output_opt |> Option.map (fun output -> + let open InternalSolver in + let rolemap = output |> Output.to_map in + let acc = + Output.RoleMap.fold (fun role impl acc -> + let open SolverInput in + match Output.unwrap impl with + | DummyImpl -> + acc + + | Impl{ version; dependencies; _ } -> + let dependencies_with_version = + dependencies |> List.map (fun dep -> + let Dependency{ role = role_dep; _ } = dep in + match rolemap |> Output.RoleMap.find_opt role_dep |> Option.map Output.unwrap with + | None | Some(DummyImpl) -> + assert false + + | Some(Impl{ version = version_dep; _ }) -> + (role_dep, version_dep) + ) + in + Alist.extend acc { + package_name = role; + locked_version = version; + dependencies = dependencies_with_version; + } + + ) rolemap Alist.empty + in + Alist.to_list acc + ) From 79919ae885ca1c9701b2653e282921b19b0585c7 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 7 Nov 2022 03:34:35 +0900 Subject: [PATCH 089/288] begin to develop 'PackageRegistry' --- src/frontend/packageConstraintSolver.ml | 25 +++++++++++++++---------- src/frontend/packageRegistry.ml | 12 ++++++++++++ src/frontend/packageSystemBase.ml | 11 +++++++++++ 3 files changed, 38 insertions(+), 10 deletions(-) create mode 100644 src/frontend/packageRegistry.ml create mode 100644 src/frontend/packageSystemBase.ml diff --git a/src/frontend/packageConstraintSolver.ml b/src/frontend/packageConstraintSolver.ml index 9d4a5611b..77b7d0bfd 100644 --- a/src/frontend/packageConstraintSolver.ml +++ b/src/frontend/packageConstraintSolver.ml @@ -1,5 +1,5 @@ -type package_name = string +open PackageSystemBase module SolverInput = struct @@ -25,14 +25,9 @@ module SolverInput = struct (* Unused *) type command_name = string - type restriction = - | CompatibleWith of SemanticVersion.t + type restriction = package_restriction - type dependency = - | Dependency of { - role : Role.t; - restrictions : restriction list; - } + type dependency = package_dependency type dep_info = { dep_role : Role.t; @@ -111,8 +106,18 @@ module SolverInput = struct ([], []) - let implementations (_role : Role.t) : role_information = - failwith "TODO: SolverInput.implementations; must access registry" + let implementations (role : Role.t) : role_information = + let impl_records = PackageRegistry.find role in + let impls = + impl_records |> List.map (fun impl_record -> + Impl{ + role = role; + version = impl_record.PackageRegistry.version; + dependencies = impl_record.PackageRegistry.requires; + } + ) + in + { replacement = None; impls } let restrictions (dep : dependency) : restriction list = diff --git a/src/frontend/packageRegistry.ml b/src/frontend/packageRegistry.ml new file mode 100644 index 000000000..65efe3a11 --- /dev/null +++ b/src/frontend/packageRegistry.ml @@ -0,0 +1,12 @@ + +open PackageSystemBase + + +type implementation_record = { + version : SemanticVersion.t; + requires : package_dependency list; +} + + +let find (_package_name : package_name) : implementation_record list = + failwith "TODO: PackageRegistry.find" diff --git a/src/frontend/packageSystemBase.ml b/src/frontend/packageSystemBase.ml new file mode 100644 index 000000000..c34c7de27 --- /dev/null +++ b/src/frontend/packageSystemBase.ml @@ -0,0 +1,11 @@ + +type package_name = string + +type package_restriction = + | CompatibleWith of SemanticVersion.t + +type package_dependency = + | Dependency of { + role : package_name; + restrictions : package_restriction list; + } From f7553b1f13482680473b5cff0bc7da9264a80171 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 7 Nov 2022 04:42:21 +0900 Subject: [PATCH 090/288] make package contexts passed to the constraint solver through roles --- src/frontend/packageConstraintSolver.ml | 78 +++++++++++++++---------- src/frontend/packageRegistry.ml | 13 +---- src/frontend/packageSystemBase.ml | 15 ++++- 3 files changed, 63 insertions(+), 43 deletions(-) diff --git a/src/frontend/packageConstraintSolver.ml b/src/frontend/packageConstraintSolver.ml index 77b7d0bfd..d284b2497 100644 --- a/src/frontend/packageConstraintSolver.ml +++ b/src/frontend/packageConstraintSolver.ml @@ -6,15 +6,22 @@ module SolverInput = struct module Role = struct - type t = package_name + type t = + | Role of { + package_name : package_name; + context : package_context; + } - let pp ppf s = - Format.fprintf ppf "%s" s + let pp ppf (role : t) = + let Role{ package_name; _ } = role in + Format.fprintf ppf "%s" package_name - let compare = - String.compare + let compare (role1 : t) (role2 : t) = + let Role{ package_name = name1; _ } = role1 in + let Role{ package_name = name2; _ } = role2 in + String.compare name1 name2 end @@ -27,7 +34,11 @@ module SolverInput = struct type restriction = package_restriction - type dependency = package_dependency + type dependency = + | Dependency of { + role : Role.t; + restrictions : package_restriction list; + } type dep_info = { dep_role : Role.t; @@ -66,8 +77,8 @@ module SolverInput = struct | DummyImpl -> Format.fprintf ppf "dummy" - | Impl{ role; version; _ } -> - Format.fprintf ppf "%s %s" role (SemanticVersion.to_string version) + | Impl{ role = Role{ package_name; _ }; version; _ } -> + Format.fprintf ppf "%s %s" package_name (SemanticVersion.to_string version) let pp_impl_long (ppf : Format.formatter) (impl : impl) = @@ -107,15 +118,21 @@ module SolverInput = struct let implementations (role : Role.t) : role_information = - let impl_records = PackageRegistry.find role in + let Role{ package_name; context } = role in + let impl_records = + context.registry_contents |> PackageNameMap.find_opt package_name |> Option.value ~default:[] + in let impls = - impl_records |> List.map (fun impl_record -> - Impl{ - role = role; - version = impl_record.PackageRegistry.version; - dependencies = impl_record.PackageRegistry.requires; - } + impl_records |> List.map (fun impl_record -> + let version = impl_record.version in + let dependencies = + impl_record.requires |> List.map (function + | PackageDependency{ package_name; restrictions } -> + Dependency{ role = Role{ package_name; context }; restrictions } ) + in + Impl{ role; version; dependencies } + ) in { replacement = None; impls } @@ -145,8 +162,11 @@ module SolverInput = struct let conflict_class (impl : impl) : conflict_class list = match impl with - | DummyImpl -> [] - | Impl{ role; _ } -> [ role ] (* TODO: take major versions into account *) + | DummyImpl -> + [] + + | Impl{ role = Role{ package_name; _ }; _ } -> + [ package_name ] (* TODO: take major versions into account *) let rejects (_role : Role.t) : (impl * rejection) list * string list = @@ -190,16 +210,16 @@ module InternalSolver = Zeroinstall_solver.Make(SolverInput) type package_solution = { - package_name : package_name; - locked_version : SemanticVersion.t; - dependencies : (package_name * SemanticVersion.t) list; + package_name : package_name; + locked_version : SemanticVersion.t; + locked_dependencies : (package_name * SemanticVersion.t) list; } -let solve (package_name : package_name) : (package_solution list) option = +let solve (context : package_context) (package_name : package_name) : (package_solution list) option = let output_opt = InternalSolver.do_solve ~closest_match:false { - role = package_name; + role = Role{ package_name; context }; command = None; } in @@ -209,27 +229,25 @@ let solve (package_name : package_name) : (package_solution list) option = let acc = Output.RoleMap.fold (fun role impl acc -> let open SolverInput in + let Role{ package_name; _ } = role in match Output.unwrap impl with | DummyImpl -> acc - | Impl{ version; dependencies; _ } -> - let dependencies_with_version = + | Impl{ version = locked_version; dependencies; _ } -> + let locked_dependencies = dependencies |> List.map (fun dep -> let Dependency{ role = role_dep; _ } = dep in + let Role{ package_name = package_name_dep; _ } = role in match rolemap |> Output.RoleMap.find_opt role_dep |> Option.map Output.unwrap with | None | Some(DummyImpl) -> assert false | Some(Impl{ version = version_dep; _ }) -> - (role_dep, version_dep) + (package_name_dep, version_dep) ) in - Alist.extend acc { - package_name = role; - locked_version = version; - dependencies = dependencies_with_version; - } + Alist.extend acc { package_name; locked_version; locked_dependencies } ) rolemap Alist.empty in diff --git a/src/frontend/packageRegistry.ml b/src/frontend/packageRegistry.ml index 65efe3a11..175585bcb 100644 --- a/src/frontend/packageRegistry.ml +++ b/src/frontend/packageRegistry.ml @@ -1,12 +1,3 @@ -open PackageSystemBase - - -type implementation_record = { - version : SemanticVersion.t; - requires : package_dependency list; -} - - -let find (_package_name : package_name) : implementation_record list = - failwith "TODO: PackageRegistry.find" +let load_cache () = + failwith "TODO: PackageRegistry.load_cache" diff --git a/src/frontend/packageSystemBase.ml b/src/frontend/packageSystemBase.ml index c34c7de27..dd80bb100 100644 --- a/src/frontend/packageSystemBase.ml +++ b/src/frontend/packageSystemBase.ml @@ -1,11 +1,22 @@ +module PackageNameMap = Map.Make(String) + type package_name = string type package_restriction = | CompatibleWith of SemanticVersion.t type package_dependency = - | Dependency of { - role : package_name; + | PackageDependency of { + package_name : package_name; restrictions : package_restriction list; } + +type implementation_record = { + version : SemanticVersion.t; + requires : package_dependency list; +} + +type package_context = { + registry_contents : (implementation_record list) PackageNameMap.t; +} From 2ce9a8e3e815aa0e43318020f331a9c0a26da7be Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 7 Nov 2022 05:12:45 +0900 Subject: [PATCH 091/288] introduce 'LocalRole' and 'LocalImpl' --- src/frontend/packageConstraintSolver.ml | 125 ++++++++++++++++-------- 1 file changed, 82 insertions(+), 43 deletions(-) diff --git a/src/frontend/packageConstraintSolver.ml b/src/frontend/packageConstraintSolver.ml index d284b2497..a33ae3ca2 100644 --- a/src/frontend/packageConstraintSolver.ml +++ b/src/frontend/packageConstraintSolver.ml @@ -7,6 +7,10 @@ module SolverInput = struct module Role = struct type t = + | LocalRole of { + requires : package_dependency list; + context : package_context; + } | Role of { package_name : package_name; context : package_context; @@ -14,14 +18,19 @@ module SolverInput = struct let pp ppf (role : t) = - let Role{ package_name; _ } = role in - Format.fprintf ppf "%s" package_name + match role with + | Role{ package_name; _ } -> Format.fprintf ppf "%s" package_name + | LocalRole(_) -> Format.fprintf ppf "local" let compare (role1 : t) (role2 : t) = - let Role{ package_name = name1; _ } = role1 in - let Role{ package_name = name2; _ } = role2 in - String.compare name1 name2 + match (role1, role2) with + | (LocalRole(_), LocalRole(_)) -> 0 + | (LocalRole(_), _) -> 1 + | (_, LocalRole(_)) -> -1 + + | (Role{ package_name = name1; _ }, Role{ package_name = name2; _ }) -> + String.compare name1 name2 end @@ -53,8 +62,11 @@ module SolverInput = struct type impl = | DummyImpl + | LocalImpl of { + dependencies : dependency list; + } | Impl of { - role : Role.t; + package_name : package_name; version : SemanticVersion.t; dependencies : dependency list; } @@ -77,7 +89,10 @@ module SolverInput = struct | DummyImpl -> Format.fprintf ppf "dummy" - | Impl{ role = Role{ package_name; _ }; version; _ } -> + | LocalImpl(_) -> + Format.fprintf ppf "local" + + | Impl{ package_name; version; _ } -> Format.fprintf ppf "%s %s" package_name (SemanticVersion.to_string version) @@ -93,6 +108,7 @@ module SolverInput = struct let pp_version (ppf : Format.formatter) (impl : impl) = match impl with | DummyImpl -> Format.fprintf ppf "dummy" + | LocalImpl(_) -> Format.fprintf ppf "local" | Impl{ version; _ } -> Format.fprintf ppf "%s" (SemanticVersion.to_string version) @@ -108,8 +124,8 @@ module SolverInput = struct let requires (_role : Role.t) (impl : impl) : dependency list * command_name list = match impl with - | DummyImpl -> ([], []) - | Impl{ dependencies; _ } -> (dependencies, []) + | DummyImpl | LocalImpl(_) -> ([], []) + | Impl{ dependencies; _ } -> (dependencies, []) (* Unused *) @@ -117,24 +133,32 @@ module SolverInput = struct ([], []) + let make_internal_dependency (context : package_context) (requires : package_dependency list) : dependency list = + requires |> List.map (function + | PackageDependency{ package_name; restrictions } -> + Dependency{ role = Role{ package_name; context }; restrictions } + ) + + let implementations (role : Role.t) : role_information = - let Role{ package_name; context } = role in - let impl_records = - context.registry_contents |> PackageNameMap.find_opt package_name |> Option.value ~default:[] - in - let impls = - impl_records |> List.map (fun impl_record -> - let version = impl_record.version in - let dependencies = - impl_record.requires |> List.map (function - | PackageDependency{ package_name; restrictions } -> - Dependency{ role = Role{ package_name; context }; restrictions } + match role with + | Role{ package_name; context } -> + let impl_records = + context.registry_contents |> PackageNameMap.find_opt package_name |> Option.value ~default:[] + in + let impls = + impl_records |> List.map (fun impl_record -> + let version = impl_record.version in + let dependencies = make_internal_dependency context impl_record.requires in + Impl{ package_name; version; dependencies } ) in - Impl{ role; version; dependencies } - ) - in - { replacement = None; impls } + { replacement = None; impls } + + | LocalRole{ requires; context } -> + let dependencies = make_internal_dependency context requires in + let impls = [ LocalImpl{ dependencies } ] in + { replacement = None; impls } let restrictions (dep : dependency) : restriction list = @@ -147,6 +171,9 @@ module SolverInput = struct | DummyImpl -> false + | LocalImpl(_) -> + true + | Impl{ version = semver_provided; _} -> begin match restr with @@ -162,10 +189,10 @@ module SolverInput = struct let conflict_class (impl : impl) : conflict_class list = match impl with - | DummyImpl -> + | DummyImpl | LocalImpl(_) -> [] - | Impl{ role = Role{ package_name; _ }; _ } -> + | Impl{ package_name; _ } -> [ package_name ] (* TODO: take major versions into account *) @@ -179,6 +206,10 @@ module SolverInput = struct | (DummyImpl, _) -> 1 | (_, DummyImpl) -> -1 + | (LocalImpl(_), LocalImpl(_)) -> 0 + | (LocalImpl(_), _) -> 1 + | (_, LocalImpl(_)) -> -1 + | (Impl{ version = semver1; _ }, Impl{ version = semver2; _ }) -> SemanticVersion.compare semver1 semver2 @@ -216,10 +247,10 @@ type package_solution = { } -let solve (context : package_context) (package_name : package_name) : (package_solution list) option = +let solve (context : package_context) (requires : package_dependency list) : (package_solution list) option = let output_opt = InternalSolver.do_solve ~closest_match:false { - role = Role{ package_name; context }; + role = LocalRole{ requires; context }; command = None; } in @@ -227,26 +258,34 @@ let solve (context : package_context) (package_name : package_name) : (package_s let open InternalSolver in let rolemap = output |> Output.to_map in let acc = - Output.RoleMap.fold (fun role impl acc -> + Output.RoleMap.fold (fun _role impl acc -> let open SolverInput in - let Role{ package_name; _ } = role in - match Output.unwrap impl with - | DummyImpl -> + let impl = Output.unwrap impl in + match impl with + | DummyImpl | LocalImpl(_) -> acc - | Impl{ version = locked_version; dependencies; _ } -> - let locked_dependencies = - dependencies |> List.map (fun dep -> + | Impl{ package_name; version = locked_version; dependencies; _ } -> + let locked_dependency_acc = + dependencies |> List.fold_left (fun locked_dependency_acc dep -> let Dependency{ role = role_dep; _ } = dep in - let Role{ package_name = package_name_dep; _ } = role in - match rolemap |> Output.RoleMap.find_opt role_dep |> Option.map Output.unwrap with - | None | Some(DummyImpl) -> - assert false - - | Some(Impl{ version = version_dep; _ }) -> - (package_name_dep, version_dep) - ) + match role_dep with + | Role{ package_name = package_name_dep; _ } -> + begin + match rolemap |> Output.RoleMap.find_opt role_dep |> Option.map Output.unwrap with + | None | Some(DummyImpl) | Some(LocalImpl(_)) -> + locked_dependency_acc + + | Some(Impl{ version = version_dep; _ }) -> + Alist.extend locked_dependency_acc (package_name_dep, version_dep) + end + + | LocalRole(_) -> + locked_dependency_acc + + ) Alist.empty in + let locked_dependencies = Alist.to_list locked_dependency_acc in Alist.extend acc { package_name; locked_version; locked_dependencies } ) rolemap Alist.empty From ea7446b998cc4026832ac83bbbce4817649ba71e Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 7 Nov 2022 22:37:03 +0900 Subject: [PATCH 092/288] add the interface file of 'PackageConstraintSolver' --- src/frontend/packageConstraintSolver.ml | 7 ------- src/frontend/packageConstraintSolver.mli | 4 ++++ src/frontend/packageSystemBase.ml | 6 ++++++ 3 files changed, 10 insertions(+), 7 deletions(-) create mode 100644 src/frontend/packageConstraintSolver.mli diff --git a/src/frontend/packageConstraintSolver.ml b/src/frontend/packageConstraintSolver.ml index a33ae3ca2..9708c2e8e 100644 --- a/src/frontend/packageConstraintSolver.ml +++ b/src/frontend/packageConstraintSolver.ml @@ -240,13 +240,6 @@ end module InternalSolver = Zeroinstall_solver.Make(SolverInput) -type package_solution = { - package_name : package_name; - locked_version : SemanticVersion.t; - locked_dependencies : (package_name * SemanticVersion.t) list; -} - - let solve (context : package_context) (requires : package_dependency list) : (package_solution list) option = let output_opt = InternalSolver.do_solve ~closest_match:false { diff --git a/src/frontend/packageConstraintSolver.mli b/src/frontend/packageConstraintSolver.mli new file mode 100644 index 000000000..030ef88e3 --- /dev/null +++ b/src/frontend/packageConstraintSolver.mli @@ -0,0 +1,4 @@ + +open PackageSystemBase + +val solve : package_context -> package_dependency list -> (package_solution list) option diff --git a/src/frontend/packageSystemBase.ml b/src/frontend/packageSystemBase.ml index dd80bb100..cf9e19f90 100644 --- a/src/frontend/packageSystemBase.ml +++ b/src/frontend/packageSystemBase.ml @@ -20,3 +20,9 @@ type implementation_record = { type package_context = { registry_contents : (implementation_record list) PackageNameMap.t; } + +type package_solution = { + package_name : package_name; + locked_version : SemanticVersion.t; + locked_dependencies : (package_name * SemanticVersion.t) list; +} From 540282fd547ffd16ed9002c68a323c01637239ee Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 7 Nov 2022 22:40:36 +0900 Subject: [PATCH 093/288] begin to add a subcommand 'solve' for constraint solving --- bin/satysfi.ml | 39 ++++++++++++++++++++++++++++++++++++--- demo/Makefile | 2 +- doc/Makefile | 2 +- src/frontend/main.ml | 8 ++++++++ src/frontend/main.mli | 4 ++++ tests/Makefile | 2 +- tests/images/Makefile | 2 +- tests/md/Makefile | 2 +- tests/text_mode/Makefile | 2 +- 9 files changed, 54 insertions(+), 9 deletions(-) diff --git a/bin/satysfi.ml b/bin/satysfi.ml index 584e6c9e2..d897610dd 100644 --- a/bin/satysfi.ml +++ b/bin/satysfi.ml @@ -40,6 +40,13 @@ let build ~no_default_config +let solve + fpath_in += + Main.solve + ~fpath_in + + let arg_in : string Cmdliner.Term.t = let open Cmdliner in Arg.(required (pos 0 (some file) None (info []))) @@ -140,7 +147,7 @@ let flag_no_default_config = ~doc:"Does not use default configuration search path" -let command_main : unit Cmdliner.Cmd.t = +let command_build = let open Cmdliner in let term : unit Term.t = Term.(const build @@ -163,10 +170,36 @@ let command_main : unit Cmdliner.Cmd.t = ) in let info : Cmd.info = - Cmd.info ~version:version "satysfi" + Cmd.info "build" in Cmd.v info term + +let command_solve = + let open Cmdliner in + let term : unit Term.t = + Term.(const solve + $ arg_in + ) + in + let info : Cmd.info = + Cmd.info "solve" + in + Cmd.v info term + + let () = let open Cmdliner in - exit (Cmd.eval command_main) + let term : unit Term.t = + Term.(ret (const (`Error(true, "No subcommand specified.")))) + in + let info : Cmd.info = + Cmd.info ~version:version "satysfi" + in + let subcommands = + [ + command_build; + command_solve; + ] + in + Stdlib.exit (Cmd.eval (Cmd.group ~default:term info subcommands)) diff --git a/demo/Makefile b/demo/Makefile index 7226ad043..e3c1eb488 100644 --- a/demo/Makefile +++ b/demo/Makefile @@ -8,7 +8,7 @@ SATYSFI ?= satysfi .SUFFIXES: .saty .pdf .saty.pdf: - $(SATYSFI) $< -o $@ + $(SATYSFI) build $< -o $@ all:: $(TARGETS) diff --git a/doc/Makefile b/doc/Makefile index 2bb0d9010..af8ebf383 100644 --- a/doc/Makefile +++ b/doc/Makefile @@ -10,7 +10,7 @@ SATYSFI ?= satysfi .SUFFIXES: .saty .pdf .saty.pdf: - $(SATYSFI) $< -o $@ + $(SATYSFI) build $< -o $@ all:: $(TARGETS) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 7a7fbd056..28d695b13 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1428,3 +1428,11 @@ let build else preprocess_and_evaluate env libs ast_doc abspath_in abspath_out abspath_dump ) + + +let solve + ~fpath_in:(_ : string) += + error_log_environment (fun () -> + failwith "TODO: Main.solve" + ) diff --git a/src/frontend/main.mli b/src/frontend/main.mli index ae49284e0..36cc6a8d2 100644 --- a/src/frontend/main.mli +++ b/src/frontend/main.mli @@ -17,3 +17,7 @@ val build : show_fonts:bool -> no_default_config:bool -> unit + +val solve : + fpath_in:string -> + unit diff --git a/tests/Makefile b/tests/Makefile index b0fd5d8ee..a10dd3960 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -21,7 +21,7 @@ SATYSFI ?= satysfi .SUFFIXES: .saty .pdf .saty.pdf: - $(SATYSFI) $< -o $@ + $(SATYSFI) build $< -o $@ all:: $(TARGETS) diff --git a/tests/images/Makefile b/tests/images/Makefile index 44cfbd08b..e7f988ac2 100644 --- a/tests/images/Makefile +++ b/tests/images/Makefile @@ -8,7 +8,7 @@ SATYSFI ?= satysfi .SUFFIXES: .saty .pdf .saty.pdf: - $(SATYSFI) $< -o $@ + $(SATYSFI) build $< -o $@ all:: $(TARGETS) diff --git a/tests/md/Makefile b/tests/md/Makefile index 69230abb1..b218023d4 100644 --- a/tests/md/Makefile +++ b/tests/md/Makefile @@ -8,7 +8,7 @@ SATYSFI ?= satysfi .SUFFIXES: .md .pdf .md.pdf: - $(SATYSFI) --markdown "mdja" $< -o $@ + $(SATYSFI) build --markdown "mdja" $< -o $@ all:: $(TARGETS) diff --git a/tests/text_mode/Makefile b/tests/text_mode/Makefile index 881e1e2fb..77615806e 100644 --- a/tests/text_mode/Makefile +++ b/tests/text_mode/Makefile @@ -8,7 +8,7 @@ SATYSFI ?= satysfi .SUFFIXES: .saty .tex .saty.tex: - $(SATYSFI) $< --text-mode "latex" -o $@ + $(SATYSFI) build $< --text-mode "latex" -o $@ all:: $(TARGETS) From 4d53ed1aebad3c0c6ced77445652edc5c674f383 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 7 Nov 2022 23:13:30 +0900 Subject: [PATCH 094/288] begin to develop 'Main.solve' --- src/frontend/main.ml | 68 +++++++++++++++++++++++++++++++++++++------- 1 file changed, 58 insertions(+), 10 deletions(-) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 28d695b13..837ce48c9 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1246,10 +1246,10 @@ let get_candidate_file_extensions () = type build_input = - | PackageInput of { + | PackageBuildInput of { lock : abs_path; } - | DocumentInput of { + | DocumentBuildInput of { lock : abs_path; out : abs_path; dump : abs_path; @@ -1281,6 +1281,14 @@ let check_depended_packages ~(extensions : string list) (tyenv_prim : Typeenv.t) (genv, Alist.to_list libacc) +let make_package_lock_config_path (abspathstr_in : string) = + make_abs_path (Printf.sprintf "%s/package.satysfi-lock" abspathstr_in) + + +let make_document_lock_config_path (basename_without_extension : string) = + make_abs_path (Printf.sprintf "%s.satysfi-lock" basename_without_extension) + + let build ~(fpath_in : string) ~(fpath_out_opt : string option) @@ -1340,14 +1348,14 @@ let build let abspathstr_in = get_abs_path_string abspath_in in if Sys.is_directory abspathstr_in then (* If the input is a package directory: *) - let abspath_lock_config = make_abs_path (Printf.sprintf "%s/package.satysfi-lock" abspathstr_in) in - PackageInput{ + let abspath_lock_config = make_package_lock_config_path abspathstr_in in + PackageBuildInput{ lock = abspath_lock_config; } else (* If the input is a document file: *) let basename_without_extension = Filename.remove_extension abspathstr_in in - let abspath_lock_config = make_abs_path (Printf.sprintf "%s.satysfi-lock" basename_without_extension) in + let abspath_lock_config = make_document_lock_config_path basename_without_extension in let abspath_out = match (output_mode, output_file) with | (_, Some(abspath_out)) -> abspath_out @@ -1355,7 +1363,7 @@ let build | (PdfMode, None) -> make_abs_path (Printf.sprintf "%s.pdf" basename_without_extension) in let abspath_dump = make_abs_path (Printf.sprintf "%s.satysfi-aux" basename_without_extension) in - DocumentInput{ + DocumentBuildInput{ lock = abspath_lock_config; out = abspath_out; dump = abspath_dump; @@ -1366,7 +1374,7 @@ let build let (tyenv_prim, env) = initialize () in match build_input with - | PackageInput{ + | PackageBuildInput{ lock = abspath_lock_config; } -> Logging.lock_config_file abspath_lock_config; @@ -1390,7 +1398,7 @@ let build | Error(e) -> raise (ConfigError(e)) end - | DocumentInput{ + | DocumentBuildInput{ lock = abspath_lock_config; out = abspath_out; dump = abspath_dump; @@ -1430,9 +1438,49 @@ let build ) +type solve_input = + | PackageSolveInput of { + root : abs_path; + lock : abs_path; + } + | DocumentSolveInput + + let solve - ~fpath_in:(_ : string) + ~(fpath_in : string) = error_log_environment (fun () -> - failwith "TODO: Main.solve" + let curdir = Sys.getcwd () in + + let abspath_in = make_absolute_if_relative ~origin:curdir fpath_in in + let solve_input = + let abspathstr_in = get_abs_path_string abspath_in in + if Sys.is_directory abspathstr_in then + (* If the input is a package directory: *) + let abspath_lock_config = make_package_lock_config_path abspathstr_in in + PackageSolveInput{ + root = abspath_in; + lock = abspath_lock_config; + } + else + DocumentSolveInput + in + match solve_input with + | PackageSolveInput{ + root = absdir_package; + lock = _abspath_lock_config; + } -> + let res = + let open ResultMonad in + let* _config = PackageConfig.load absdir_package in + failwith "TODO: Main.solve" + in + begin + match res with + | Ok(()) -> () + | Error(e) -> raise (ConfigError(e)) + end + + | DocumentSolveInput -> + failwith "TODO: Main.solve, DocumentSolveInput" ) From 2f2fa4829a8e560ee5aa2ce3603874301fdbc9d0 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 7 Nov 2022 23:49:05 +0900 Subject: [PATCH 095/288] develop command 'solve' --- src/frontend/configError.ml | 21 +++++++++++---------- src/frontend/lockConfig.ml | 4 ++++ src/frontend/main.ml | 22 ++++++++++++++++++++-- src/frontend/packageConfig.ml | 31 ++++++++++++++++++++++--------- src/frontend/packageConfig.mli | 5 ++--- src/frontend/packageReader.ml | 8 +------- src/frontend/packageRegistry.ml | 9 ++++++++- 7 files changed, 68 insertions(+), 32 deletions(-) diff --git a/src/frontend/configError.ml b/src/frontend/configError.ml index 01e2515ef..1b17831bd 100644 --- a/src/frontend/configError.ml +++ b/src/frontend/configError.ml @@ -5,16 +5,17 @@ open HorzBox type yaml_error = - | ParseError of string - | FieldNotFound of YamlDecoder.context * string - | NotAFloat of YamlDecoder.context - | NotAString of YamlDecoder.context - | NotABool of YamlDecoder.context - | NotAnArray of YamlDecoder.context - | NotAnObject of YamlDecoder.context - | UnexpectedTag of YamlDecoder.context * string - | PackageNotFound of lib_path * abs_path list - | UnexpectedLanguage of string + | ParseError of string + | FieldNotFound of YamlDecoder.context * string + | NotAFloat of YamlDecoder.context + | NotAString of YamlDecoder.context + | NotABool of YamlDecoder.context + | NotAnArray of YamlDecoder.context + | NotAnObject of YamlDecoder.context + | UnexpectedTag of YamlDecoder.context * string + | PackageNotFound of lib_path * abs_path list + | UnexpectedLanguage of string + | NotASemanticVersion of YamlDecoder.context * string module YamlError = struct type t = yaml_error diff --git a/src/frontend/lockConfig.ml b/src/frontend/lockConfig.ml index d0e25a0fe..12745cc3b 100644 --- a/src/frontend/lockConfig.ml +++ b/src/frontend/lockConfig.ml @@ -70,3 +70,7 @@ let load (abspath_lock_config : abs_path) : t ok = let lock_config_dir = make_abs_path (Filename.dirname (get_abs_path_string abspath_lock_config)) in LockConfigDecoder.run (lock_config_decoder ~lock_config_dir) s |> Result.map_error (fun e -> LockConfigError(abspath_lock_config, e)) + + +let write (_abspath_lock_config : abs_path) (_lock_config : t) : unit = + failwith "TODO: LockConfig.write" diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 837ce48c9..e6922b10e 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -9,6 +9,7 @@ open TypeError exception NoLibraryRootDesignation exception ShouldSpecifyOutputFile exception ConfigError of config_error +exception CannotSolvePackageConstraints (* Initialization that should be performed before every cross-reference-solving loop *) @@ -821,6 +822,9 @@ let make_yaml_error_lines = function | UnexpectedLanguage(s_language_version) -> [ NormalLine(Printf.sprintf "unexpected language version '%s'" s_language_version) ] + | NotASemanticVersion(yctx, s) -> + [ NormalLine(Printf.sprintf "not a semantic version: '%s'%s" s (show_yaml_context yctx)) ] + let report_config_error = function | NotADocumentFile(abspath_in, ty) -> @@ -1452,6 +1456,7 @@ let solve error_log_environment (fun () -> let curdir = Sys.getcwd () in + setup_root_dirs curdir; let abspath_in = make_absolute_if_relative ~origin:curdir fpath_in in let solve_input = let abspathstr_in = get_abs_path_string abspath_in in @@ -1472,8 +1477,21 @@ let solve } -> let res = let open ResultMonad in - let* _config = PackageConfig.load absdir_package in - failwith "TODO: Main.solve" + let* config = PackageConfig.load absdir_package in + begin + match config.package_contents with + | PackageConfig.Library{ dependencies; _ } -> + let* package_context = PackageRegistry.load_cache () in + let solutions_opt = PackageConstraintSolver.solve package_context dependencies in + begin + match solutions_opt with + | None -> + raise CannotSolvePackageConstraints + + | Some(_solutions) -> + failwith "TODO: Main.solve, write a lock file" + end + end in begin match res with diff --git a/src/frontend/packageConfig.ml b/src/frontend/packageConfig.ml index 63cefda6a..4290e92b1 100644 --- a/src/frontend/packageConfig.ml +++ b/src/frontend/packageConfig.ml @@ -2,6 +2,7 @@ open MyUtil open Types open ConfigError +open PackageSystemBase type 'a ok = ('a, config_error) result @@ -12,9 +13,7 @@ type package_contents = | Library of { main_module_name : module_name; source_directories : relative_path list; - } - | Document of { - document_file : relative_path; + dependencies : package_dependency list; } type t = { @@ -25,21 +24,35 @@ type t = { module PackageConfigDecoder = YamlDecoder.Make(YamlError) +let requirement_decoder : package_restriction PackageConfigDecoder.t = + let open PackageConfigDecoder in + string >>= fun s_version -> + match SemanticVersion.parse s_version with + | None -> failure (fun context -> NotASemanticVersion(context, s_version)) + | Some(semver) -> succeed @@ CompatibleWith(semver) + + +let dependency_decoder : package_dependency PackageConfigDecoder.t = + let open PackageConfigDecoder in + get "name" string >>= fun package_name -> + get "requirements" (list requirement_decoder) >>= fun restrictions -> + succeed @@ PackageDependency{ + package_name; + restrictions; + } + + let contents_decoder : package_contents PackageConfigDecoder.t = let open PackageConfigDecoder in branch "type" [ "library" ==> begin get "main_module" string >>= fun main_module_name -> get "source_directories" (list string) >>= fun source_directories -> + get_or_else "dependencies" (list dependency_decoder) [] >>= fun dependencies -> succeed @@ Library { main_module_name; source_directories; - } - end; - "document" ==> begin - get "file" string >>= fun document_file -> - succeed @@ Document { - document_file; + dependencies; } end; ] diff --git a/src/frontend/packageConfig.mli b/src/frontend/packageConfig.mli index ada371a0c..22817e095 100644 --- a/src/frontend/packageConfig.mli +++ b/src/frontend/packageConfig.mli @@ -2,6 +2,7 @@ open MyUtil open Types open ConfigError +open PackageSystemBase type relative_path = string @@ -9,9 +10,7 @@ type package_contents = | Library of { main_module_name : module_name; source_directories : relative_path list; - } - | Document of { - document_file : relative_path; + dependencies : package_dependency list; } type t = { diff --git a/src/frontend/packageReader.ml b/src/frontend/packageReader.ml index 2efd432ec..51c484ae6 100644 --- a/src/frontend/packageReader.ml +++ b/src/frontend/packageReader.ml @@ -22,13 +22,7 @@ let main ~(extensions : string list) (absdir_package : abs_path) : untyped_packa let* config = PackageConfig.load absdir_package in let* package = match config.package_contents with - | PackageConfig.Document(_) -> - failwith "TODO: PackageConfig.Document" - - | PackageConfig.Library { - main_module_name; - source_directories; - } -> + | PackageConfig.Library{ main_module_name; source_directories; _ } -> let absdirs_src = source_directories |> List.map (fun source_directory -> make_abs_path (Filename.concat (get_abs_path_string absdir_package) source_directory) diff --git a/src/frontend/packageRegistry.ml b/src/frontend/packageRegistry.ml index 175585bcb..703e70151 100644 --- a/src/frontend/packageRegistry.ml +++ b/src/frontend/packageRegistry.ml @@ -1,3 +1,10 @@ -let load_cache () = +open ConfigError +open PackageSystemBase + + +type 'a ok = ('a, config_error) result + + +let load_cache () : package_context ok = failwith "TODO: PackageRegistry.load_cache" From 4ca690b1b8934834028bc59194c114c9e0fd1932 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 8 Nov 2022 00:11:34 +0900 Subject: [PATCH 096/288] refactor how to decode lock configs --- src/frontend/closedLockDependencyResolver.ml | 33 ++++++++++++---- src/frontend/configError.ml | 2 +- src/frontend/lockConfig.ml | 41 ++++++++++++-------- src/frontend/main.ml | 39 +++++++++++-------- 4 files changed, 74 insertions(+), 41 deletions(-) diff --git a/src/frontend/closedLockDependencyResolver.ml b/src/frontend/closedLockDependencyResolver.ml index 32fef455a..024119317 100644 --- a/src/frontend/closedLockDependencyResolver.ml +++ b/src/frontend/closedLockDependencyResolver.ml @@ -10,34 +10,53 @@ type 'a ok = ('a, config_error) result module LockDependencyGraph = DependencyGraph.Make(String) -let main ~(extensions : string list) (lock_config : LockConfig.t) : ((lock_name * untyped_package) list) ok = +let main ~(lock_config_dir : abs_path) ~(extensions : string list) (lock_config : LockConfig.t) : ((lock_name * untyped_package) list) ok = let open ResultMonad in let locks = lock_config.LockConfig.locked_packages in (* Add vertices: *) let* (graph, entryacc) = - locks |> foldM (fun (graph, entryacc) lock -> + locks |> foldM (fun (graph, entryacc) (lock : LockConfig.locked_package) -> let lock_name = lock.lock_name in - let absdir_package = lock.lock_directory in + let* absdir_package = + match lock.lock_location with + | GlobalLocation{ path = s_libpath } -> + let libpath = make_lib_path s_libpath in + begin + match Config.resolve_lib_file libpath with + | Ok(abspath) -> return abspath + | Error(candidates) -> err @@ LockedPackageNotFound(libpath, candidates) + end + + | LocalLocation{ path = s_relpath } -> + return (make_abs_path (Filename.concat (get_abs_path_string lock_config_dir) s_relpath)) + in let* package = PackageReader.main ~extensions absdir_package in let* (graph, vertex) = graph |> LockDependencyGraph.add_vertex lock_name package |> Result.map_error (fun _ -> LockNameConflict(lock_name)) in - return (graph, Alist.extend entryacc (lock, vertex)) + let lock_info = + { + lock_name; + lock_directory = absdir_package; + lock_dependencies = lock.lock_dependencies; + } + in + return (graph, Alist.extend entryacc (lock_info, vertex)) ) (LockDependencyGraph.empty, Alist.empty) in (* Add edges: *) let* graph = - entryacc |> Alist.to_list |> foldM (fun graph (lock, vertex) -> - lock.lock_dependencies |> foldM (fun graph lock_name_dep -> + entryacc |> Alist.to_list |> foldM (fun graph (lock_info, vertex) -> + lock_info.lock_dependencies |> foldM (fun graph lock_name_dep -> begin match graph |> LockDependencyGraph.get_vertex lock_name_dep with | None -> err @@ DependencyOnUnknownLock{ - depending = lock.lock_name; + depending = lock_info.lock_name; depended = lock_name_dep; } diff --git a/src/frontend/configError.ml b/src/frontend/configError.ml index 1b17831bd..e8917034b 100644 --- a/src/frontend/configError.ml +++ b/src/frontend/configError.ml @@ -13,7 +13,6 @@ type yaml_error = | NotAnArray of YamlDecoder.context | NotAnObject of YamlDecoder.context | UnexpectedTag of YamlDecoder.context * string - | PackageNotFound of lib_path * abs_path list | UnexpectedLanguage of string | NotASemanticVersion of YamlDecoder.context * string @@ -46,6 +45,7 @@ type config_error = | LockConfigNotFound of abs_path | LockConfigError of abs_path * yaml_error | LockNameConflict of lock_name + | LockedPackageNotFound of lib_path * abs_path list | DependencyOnUnknownLock of { depending : lock_name; depended : lock_name; diff --git a/src/frontend/lockConfig.ml b/src/frontend/lockConfig.ml index 12745cc3b..3893d1b37 100644 --- a/src/frontend/lockConfig.ml +++ b/src/frontend/lockConfig.ml @@ -6,30 +6,38 @@ open ConfigError type 'a ok = ('a, config_error) result +type lock_location = + | GlobalLocation of { + path : string; + } + | LocalLocation of { + path : string; + } + +type locked_package = { + lock_name : lock_name; + lock_location : lock_location; + lock_dependencies : lock_name list; +} + type t = { - locked_packages : lock_info list; + locked_packages : locked_package list; } module LockConfigDecoder = YamlDecoder.Make(YamlError) -let lock_location_decoder ~(lock_config_dir : abs_path) : abs_path LockConfigDecoder.t = +let lock_location_decoder : lock_location LockConfigDecoder.t = let open LockConfigDecoder in branch "type" [ "global" ==> begin get "path" string >>= fun s_libpath -> - let libpath = make_lib_path s_libpath in - match Config.resolve_lib_file libpath with - | Ok(abspath) -> succeed abspath - | Error(candidates) -> failure (fun _context -> PackageNotFound(libpath, candidates)) + succeed @@ GlobalLocation{ path = s_libpath } end; "local" ==> begin get "path" string >>= fun s_relpath -> - let abspath = - make_abs_path (Filename.concat (get_abs_path_string lock_config_dir) s_relpath) - in - succeed abspath + succeed @@ LocalLocation{ path = s_relpath } end; ] ~other:(fun tag -> @@ -37,21 +45,21 @@ let lock_location_decoder ~(lock_config_dir : abs_path) : abs_path LockConfigDec ) -let lock_decoder ~(lock_config_dir : abs_path) : lock_info LockConfigDecoder.t = +let lock_decoder : locked_package LockConfigDecoder.t = let open LockConfigDecoder in get "name" string >>= fun lock_name -> - get "location" (lock_location_decoder ~lock_config_dir) >>= fun lock_directory -> + get "location" lock_location_decoder >>= fun lock_location -> get_or_else "dependencies" (list string) [] >>= fun lock_dependencies -> succeed { lock_name; - lock_directory; + lock_location; lock_dependencies; } -let lock_config_decoder ~(lock_config_dir : abs_path) : t LockConfigDecoder.t = +let lock_config_decoder : t LockConfigDecoder.t = let open LockConfigDecoder in - get_or_else "locks" (list (lock_decoder ~lock_config_dir)) [] >>= fun locked_packages -> + get_or_else "locks" (list lock_decoder) [] >>= fun locked_packages -> succeed { locked_packages; } @@ -67,8 +75,7 @@ let load (abspath_lock_config : abs_path) : t ok = in let s = Core.In_channel.input_all inc in close_in inc; - let lock_config_dir = make_abs_path (Filename.dirname (get_abs_path_string abspath_lock_config)) in - LockConfigDecoder.run (lock_config_decoder ~lock_config_dir) s + LockConfigDecoder.run lock_config_decoder s |> Result.map_error (fun e -> LockConfigError(abspath_lock_config, e)) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index e6922b10e..266ac913c 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -786,7 +786,7 @@ let show_yaml_context (context : YamlDecoder.context) = Printf.sprintf " (context: %s)" s_context -let make_yaml_error_lines = function +let make_yaml_error_lines : yaml_error -> line list = function | ParseError(s) -> [ NormalLine(Printf.sprintf "parse error: %s" s) ] @@ -811,14 +811,6 @@ let make_yaml_error_lines = function | UnexpectedTag(yctx, tag) -> [ NormalLine(Printf.sprintf "unexpected type tag '%s'%s" tag (show_yaml_context yctx)) ] - | PackageNotFound(libpath, candidates) -> - let lines = - candidates |> List.map (fun abspath -> - DisplayLine(Printf.sprintf "- %s" (get_abs_path_string abspath)) - ) - in - (NormalLine(Printf.sprintf "package '%s' not found. candidates:" (get_lib_path_string libpath)) :: lines) - | UnexpectedLanguage(s_language_version) -> [ NormalLine(Printf.sprintf "unexpected language version '%s'" s_language_version) ] @@ -826,7 +818,7 @@ let make_yaml_error_lines = function [ NormalLine(Printf.sprintf "not a semantic version: '%s'%s" s (show_yaml_context yctx)) ] -let report_config_error = function +let report_config_error : config_error -> unit = function | NotADocumentFile(abspath_in, ty) -> let fname = convert_abs_path_to_show abspath_in in report_error Typechecker [ @@ -955,6 +947,15 @@ let report_config_error = function NormalLine(Printf.sprintf "lock name conflict: '%s'" lock_name); ] + | LockedPackageNotFound(libpath, candidates) -> + let lines = + candidates |> List.map (fun abspath -> + DisplayLine(Printf.sprintf "- %s" (get_abs_path_string abspath)) + ) + in + report_error Interface + (NormalLine(Printf.sprintf "package '%s' not found. candidates:" (get_lib_path_string libpath)) :: lines) + | DependencyOnUnknownLock{ depending; depended } -> report_error Interface [ NormalLine(Printf.sprintf "unknown depended lock '%s' of '%s'." depended depending); @@ -999,7 +1000,7 @@ let report_config_error = function (NormalLine(Printf.sprintf "cannot find local file '%s'. candidates:" relative) :: lines) -let report_font_error = function +let report_font_error : font_error -> unit = function | InvalidFontAbbrev(abbrev) -> report_error Interface [ NormalLine (Printf.sprintf "cannot find a font named '%s'." abbrev); @@ -1052,7 +1053,7 @@ let report_font_error = function (NormalLine(Printf.sprintf "cannot find '%s'. candidates:" (get_lib_path_string libpath)) :: lines) -let error_log_environment suspended = +let error_log_environment (suspended : unit -> unit) : unit = try suspended () with @@ -1260,10 +1261,10 @@ type build_input = } -let check_depended_packages ~(extensions : string list) (tyenv_prim : Typeenv.t) (lock_config : LockConfig.t) = +let check_depended_packages ~(lock_config_dir : abs_path) ~(extensions : string list) (tyenv_prim : Typeenv.t) (lock_config : LockConfig.t) = (* Resolve dependency among locked packages: *) let sorted_packages = - match ClosedLockDependencyResolver.main ~extensions lock_config with + match ClosedLockDependencyResolver.main ~lock_config_dir ~extensions lock_config with | Ok(sorted_packages) -> sorted_packages | Error(e) -> raise (ConfigError(e)) in @@ -1394,7 +1395,10 @@ let build | Error(e) -> raise (ConfigError(e)) in - let (genv, _libs_dep) = check_depended_packages ~extensions tyenv_prim lock_config in + let (genv, _libs_dep) = + let lock_config_dir = make_abs_path (Filename.dirname (get_abs_path_string abspath_lock_config)) in + check_depended_packages ~lock_config_dir ~extensions tyenv_prim lock_config + in begin match PackageChecker.main tyenv_prim genv package with @@ -1426,7 +1430,10 @@ let build | Error(e) -> raise (ConfigError(e)) in - let (genv, libs) = check_depended_packages ~extensions tyenv_prim lock_config in + let (genv, libs) = + let lock_config_dir = make_abs_path (Filename.dirname (get_abs_path_string abspath_lock_config)) in + check_depended_packages ~lock_config_dir ~extensions tyenv_prim lock_config + in (* Typechecking and elaboration: *) let (libs_local, ast_doc) = From 7dbee97a034ca0d80ad477884d16b5b66840d807 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 8 Nov 2022 00:35:46 +0900 Subject: [PATCH 097/288] develop how to convert solutions to lock configs --- src/frontend/configError.ml | 1 + src/frontend/main.ml | 54 ++++++++++++++++++++++++------- src/frontend/packageSystemBase.ml | 8 ++--- 3 files changed, 48 insertions(+), 15 deletions(-) diff --git a/src/frontend/configError.ml b/src/frontend/configError.ml index e8917034b..b41a0819b 100644 --- a/src/frontend/configError.ml +++ b/src/frontend/configError.ml @@ -64,6 +64,7 @@ type config_error = relative : string; candidates : abs_path list; } + | CannotSolvePackageConstraints type font_error = | InvalidFontAbbrev of font_abbrev diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 266ac913c..ba90e9ecd 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -2,6 +2,7 @@ open MyUtil open Types open StaticEnv +open PackageSystemBase open ConfigError open TypeError @@ -9,7 +10,6 @@ open TypeError exception NoLibraryRootDesignation exception ShouldSpecifyOutputFile exception ConfigError of config_error -exception CannotSolvePackageConstraints (* Initialization that should be performed before every cross-reference-solving loop *) @@ -999,6 +999,11 @@ let report_config_error : config_error -> unit = function report_error Interface (NormalLine(Printf.sprintf "cannot find local file '%s'. candidates:" relative) :: lines) + | CannotSolvePackageConstraints -> + report_error Interface [ + NormalLine("cannot solve package constraints."); + ] + let report_font_error : font_error -> unit = function | InvalidFontAbbrev(abbrev) -> @@ -1457,6 +1462,31 @@ type solve_input = | DocumentSolveInput +let make_lock_name (package_name : package_name) (semver : SemanticVersion.t) : lock_name = + Printf.sprintf "%s.%s" package_name (SemanticVersion.to_string semver) + + +let convert_solutions_to_lock_config (solutions : package_solution list) : LockConfig.t = + let locked_packages = + solutions |> List.map (fun solution -> + let package_name = solution.package_name in + let lock_name = make_lock_name package_name solution.locked_version in + let lock_location = + LockConfig.GlobalLocation{ + path = Printf.sprintf "./dist/packages/%s/%s/" package_name lock_name; + } + in + let lock_dependencies = + solution.locked_dependencies |> List.map (fun (package_name_dep, semver_dep) -> + make_lock_name package_name_dep semver_dep + ) + in + LockConfig.{ lock_name; lock_location; lock_dependencies } + ) + in + LockConfig.{ locked_packages } + + let solve ~(fpath_in : string) = @@ -1468,19 +1498,19 @@ let solve let solve_input = let abspathstr_in = get_abs_path_string abspath_in in if Sys.is_directory abspathstr_in then - (* If the input is a package directory: *) - let abspath_lock_config = make_package_lock_config_path abspathstr_in in - PackageSolveInput{ - root = abspath_in; - lock = abspath_lock_config; - } + (* If the input is a package directory: *) + let abspath_lock_config = make_package_lock_config_path abspathstr_in in + PackageSolveInput{ + root = abspath_in; + lock = abspath_lock_config; + } else DocumentSolveInput in match solve_input with | PackageSolveInput{ root = absdir_package; - lock = _abspath_lock_config; + lock = abspath_lock_config; } -> let res = let open ResultMonad in @@ -1493,10 +1523,12 @@ let solve begin match solutions_opt with | None -> - raise CannotSolvePackageConstraints + err CannotSolvePackageConstraints - | Some(_solutions) -> - failwith "TODO: Main.solve, write a lock file" + | Some(solutions) -> + let lock_config = convert_solutions_to_lock_config solutions in + LockConfig.write abspath_lock_config lock_config; + return () end end in diff --git a/src/frontend/packageSystemBase.ml b/src/frontend/packageSystemBase.ml index cf9e19f90..4fb843519 100644 --- a/src/frontend/packageSystemBase.ml +++ b/src/frontend/packageSystemBase.ml @@ -7,10 +7,10 @@ type package_restriction = | CompatibleWith of SemanticVersion.t type package_dependency = - | PackageDependency of { - package_name : package_name; - restrictions : package_restriction list; - } + | PackageDependency of { + package_name : package_name; + restrictions : package_restriction list; + } type implementation_record = { version : SemanticVersion.t; From 853f5ef2c1b406b64c494631ab46a32b8cc09dcc Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 8 Nov 2022 01:52:29 +0900 Subject: [PATCH 098/288] fix 'requires' of constraint solving --- src/frontend/main.ml | 17 +++++++---- src/frontend/packageConstraintSolver.ml | 19 +++++++++++-- src/frontend/packageRegistry.ml | 38 ++++++++++++++++++++++++- src/frontend/packageSystemBase.ml | 4 +++ src/frontend/semanticVersion.ml | 8 ++++++ src/frontend/semanticVersion.mli | 1 + 6 files changed, 78 insertions(+), 9 deletions(-) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index ba90e9ecd..f5997dc75 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1208,7 +1208,7 @@ let error_log_environment (suspended : unit -> unit) : unit = report_error System [ NormalLine(s); ] -let setup_root_dirs (curdir : string) = +let setup_root_dirs ~(no_default_config : bool) ~(extra_config_paths : (string list) option) (curdir : string) = let runtime_dirs = if Sys.os_type = "Win32" then match Sys.getenv_opt "SATYSFI_RUNTIME" with @@ -1228,13 +1228,13 @@ let setup_root_dirs (curdir : string) = | Some(s) -> [ Filename.concat s ".satysfi" ] in let default_dirs = - if OptionState.use_no_default_config () then + if no_default_config then [] else List.concat [ home_dirs; runtime_dirs ] in let extra_dirs = - match OptionState.get_extra_config_paths () with + match extra_config_paths with | None -> [ Filename.concat curdir ".satysfi" ] | Some(extra_dirs) -> extra_dirs in @@ -1352,7 +1352,7 @@ let build no_default_config; }; - setup_root_dirs curdir; + setup_root_dirs ~no_default_config ~extra_config_paths curdir; let abspath_in = input_file in let build_input = let abspathstr_in = get_abs_path_string abspath_in in @@ -1493,7 +1493,7 @@ let solve error_log_environment (fun () -> let curdir = Sys.getcwd () in - setup_root_dirs curdir; + setup_root_dirs ~no_default_config:false ~extra_config_paths:None curdir; let abspath_in = make_absolute_if_relative ~origin:curdir fpath_in in let solve_input = let abspathstr_in = get_abs_path_string abspath_in in @@ -1526,6 +1526,13 @@ let solve err CannotSolvePackageConstraints | Some(solutions) -> + + (* TODO: remove this: *) + Format.printf "@[**** DEPENDENCIES:@ %a@," + (Format.pp_print_list pp_package_dependency) dependencies; + Format.printf "**** SOLUTIONS:@ %a@,@]" + (Format.pp_print_list pp_package_solution) solutions; + let lock_config = convert_solutions_to_lock_config solutions in LockConfig.write abspath_lock_config lock_config; return () diff --git a/src/frontend/packageConstraintSolver.ml b/src/frontend/packageConstraintSolver.ml index 9708c2e8e..d0c0f1017 100644 --- a/src/frontend/packageConstraintSolver.ml +++ b/src/frontend/packageConstraintSolver.ml @@ -42,12 +42,14 @@ module SolverInput = struct type command_name = string type restriction = package_restriction + [@@deriving show { with_path = false }] type dependency = | Dependency of { role : Role.t; restrictions : package_restriction list; } + [@@deriving show { with_path = false }] type dep_info = { dep_role : Role.t; @@ -118,14 +120,17 @@ module SolverInput = struct let dep_info (dep : dependency) : dep_info = + Format.printf "@[DEP_INFO dep: %a@]@," pp_dependency dep; (* TODO: remove this *) let Dependency{ role; _ } = dep in { dep_role = role; dep_importance = `Essential; dep_required_commands = [] } let requires (_role : Role.t) (impl : impl) : dependency list * command_name list = + Format.printf "@[REQUIRES@ impl: %a@]@," pp_impl impl; (* TODO: remove this *) match impl with - | DummyImpl | LocalImpl(_) -> ([], []) - | Impl{ dependencies; _ } -> (dependencies, []) + | DummyImpl -> ([], []) + | LocalImpl{ dependencies } -> (dependencies, []) + | Impl{ dependencies; _ } -> (dependencies, []) (* Unused *) @@ -143,6 +148,7 @@ module SolverInput = struct let implementations (role : Role.t) : role_information = match role with | Role{ package_name; context } -> + Format.printf "@[IMPLEMENTATIONS: %s@]@," package_name; (* TODO: remove this *) let impl_records = context.registry_contents |> PackageNameMap.find_opt package_name |> Option.value ~default:[] in @@ -156,17 +162,21 @@ module SolverInput = struct { replacement = None; impls } | LocalRole{ requires; context } -> + Format.printf "@[IMPLEMENTATIONS: local (requires: %a)@]@," + (Format.pp_print_list pp_package_dependency) requires; (* TODO: remove this *) let dependencies = make_internal_dependency context requires in let impls = [ LocalImpl{ dependencies } ] in { replacement = None; impls } let restrictions (dep : dependency) : restriction list = + Format.printf "@[RESTRICTIONS: %a@]\n" pp_dependency dep; (* TODO: remove this *) let Dependency{ restrictions; _ } = dep in restrictions let meets_restriction (impl : impl) (restr : restriction) : bool = + Format.printf "@[MEETS_RESTRICTION impl: %a, restr: %a@]@," pp_impl impl pp_restriction restr; (* TODO: define this *) match impl with | DummyImpl -> false @@ -188,9 +198,10 @@ module SolverInput = struct let conflict_class (impl : impl) : conflict_class list = + Format.printf "@[CONFLICT_CLASS impl: %a@]@," pp_impl impl; (* TODO: remove this *) match impl with | DummyImpl | LocalImpl(_) -> - [] + [ "*" ] (* TODO: improve this *) | Impl{ package_name; _ } -> [ package_name ] (* TODO: take major versions into account *) @@ -241,12 +252,14 @@ module InternalSolver = Zeroinstall_solver.Make(SolverInput) let solve (context : package_context) (requires : package_dependency list) : (package_solution list) option = + Format.printf "@["; (* TODO: remove this *) let output_opt = InternalSolver.do_solve ~closest_match:false { role = LocalRole{ requires; context }; command = None; } in + Format.printf "@]"; (* TODO: remove this *) output_opt |> Option.map (fun output -> let open InternalSolver in let rolemap = output |> Output.to_map in diff --git a/src/frontend/packageRegistry.ml b/src/frontend/packageRegistry.ml index 703e70151..7ad856696 100644 --- a/src/frontend/packageRegistry.ml +++ b/src/frontend/packageRegistry.ml @@ -1,4 +1,5 @@ +open MyUtil open ConfigError open PackageSystemBase @@ -6,5 +7,40 @@ open PackageSystemBase type 'a ok = ('a, config_error) result +let ( !@ ) s = + match SemanticVersion.parse s with + | None -> assert false + | Some(semver) -> semver + + +let dependency package_name semver = + PackageDependency{ + package_name; + restrictions = [ CompatibleWith(semver) ]; + } + + let load_cache () : package_context ok = - failwith "TODO: PackageRegistry.load_cache" + let open ResultMonad in + (* TODO: load this from a cache file *) + let registry_contents = + List.fold_left (fun map (package_name, impls) -> + map |> PackageNameMap.add package_name impls + ) PackageNameMap.empty [ + ("stdlib", [ + { + version = !@ "0.0.1"; + requires = []; + }; + ]); + ("math", [ + { + version = !@ "0.0.1"; + requires = [ + dependency "stdlib" (!@ "0.0.1"); + ]; + }; + ]); + ] + in + return { registry_contents } diff --git a/src/frontend/packageSystemBase.ml b/src/frontend/packageSystemBase.ml index 4fb843519..5cce2c953 100644 --- a/src/frontend/packageSystemBase.ml +++ b/src/frontend/packageSystemBase.ml @@ -2,15 +2,18 @@ module PackageNameMap = Map.Make(String) type package_name = string +[@@deriving show { with_path = false }] type package_restriction = | CompatibleWith of SemanticVersion.t +[@@deriving show { with_path = false }] type package_dependency = | PackageDependency of { package_name : package_name; restrictions : package_restriction list; } +[@@deriving show { with_path = false }] type implementation_record = { version : SemanticVersion.t; @@ -26,3 +29,4 @@ type package_solution = { locked_version : SemanticVersion.t; locked_dependencies : (package_name * SemanticVersion.t) list; } +[@@deriving show { with_path = false }] diff --git a/src/frontend/semanticVersion.ml b/src/frontend/semanticVersion.ml index 29cc422c3..1f5330ab7 100644 --- a/src/frontend/semanticVersion.ml +++ b/src/frontend/semanticVersion.ml @@ -10,6 +10,14 @@ let to_string (semver : t) : string = Semver.to_string semver +let pp ppf semver = + Format.fprintf ppf "%s" (to_string semver) + + +let show = + to_string + + let compare = Semver.compare diff --git a/src/frontend/semanticVersion.mli b/src/frontend/semanticVersion.mli index 043247e5b..b78421125 100644 --- a/src/frontend/semanticVersion.mli +++ b/src/frontend/semanticVersion.mli @@ -1,5 +1,6 @@ type t +[@@deriving show] val parse : string -> t option From e7d54e542e85fe43c08718cc4273ab23c534b750 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 8 Nov 2022 02:43:31 +0900 Subject: [PATCH 099/288] add 'dependencies:' to the configs of the pre-installed packages --- .../packages/annot/annot.0.0.1/satysfi.yaml | 4 ++ .../packages/code/code.0.0.1/satysfi.yaml | 4 ++ .../footnote-scheme.0.0.1/satysfi.yaml | 4 ++ .../itemize/itemize.0.0.1/satysfi.yaml | 4 ++ .../packages/math/math.0.0.1/satysfi.yaml | 4 ++ .../packages/md-ja/md-ja.0.0.1/satysfi.yaml | 24 ++++++++ .../packages/proof/proof.0.0.1/satysfi.yaml | 4 ++ .../std-ja-book.0.0.1/satysfi.yaml | 20 +++++++ .../std-ja-report.0.0.1/satysfi.yaml | 20 +++++++ .../packages/std-ja/std-ja.0.0.1/satysfi.yaml | 16 ++++++ .../packages/stdlib/stdlib.0.0.1/satysfi.yaml | 1 + .../tabular/tabular.0.0.1/satysfi.yaml | 4 ++ src/frontend/packageRegistry.ml | 57 +++++++++++++++++++ 13 files changed, 166 insertions(+) diff --git a/lib-satysfi/dist/packages/annot/annot.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/annot/annot.0.0.1/satysfi.yaml index 4be0243a4..f7d2f9cce 100644 --- a/lib-satysfi/dist/packages/annot/annot.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/annot/annot.0.0.1/satysfi.yaml @@ -4,3 +4,7 @@ contents: main_module: "Annot" source_directories: - "./src" + dependencies: + - name: "stdlib" + requirements: + - "0.0.1" diff --git a/lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml index 6cccc025f..a3ff270db 100644 --- a/lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml @@ -4,3 +4,7 @@ contents: main_module: "Code" source_directories: - "./src" + dependencies: + - name: "stdlib" + requirements: + - "0.0.1" diff --git a/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml index 6372e0305..4d80fb5c6 100644 --- a/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml @@ -4,3 +4,7 @@ contents: main_module: "FootnoteScheme" source_directories: - "./src" + dependencies: + - name: "stdlib" + requirements: + - "0.0.1" diff --git a/lib-satysfi/dist/packages/itemize/itemize.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/itemize/itemize.0.0.1/satysfi.yaml index d0a919e4e..4cc7fed31 100644 --- a/lib-satysfi/dist/packages/itemize/itemize.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/itemize/itemize.0.0.1/satysfi.yaml @@ -4,3 +4,7 @@ contents: main_module: "Itemize" source_directories: - "./src" + dependencies: + - name: "stdlib" + requirements: + - "0.0.1" diff --git a/lib-satysfi/dist/packages/math/math.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/math/math.0.0.1/satysfi.yaml index 7235d379b..b96d863ad 100644 --- a/lib-satysfi/dist/packages/math/math.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/math/math.0.0.1/satysfi.yaml @@ -4,3 +4,7 @@ contents: main_module: "Math" source_directories: - "./src" + dependencies: + - name: "stdlib" + requirements: + - "0.0.1" diff --git a/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml index b1579ccf7..59e7a4c62 100644 --- a/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml @@ -4,3 +4,27 @@ contents: main_module: "MDJa" source_directories: - "./src" + dependencies: + - name: "stdlib" + requirements: + - "0.0.1" + + - name: "math" + requirements: + - "0.0.1" + + - name: "annot" + requirements: + - "0.0.1" + + - name: "code" + requirements: + - "0.0.1" + + - name: "footnote-scheme" + requirements: + - "0.0.1" + + - name: "itemize" + requirements: + - "0.0.1" diff --git a/lib-satysfi/dist/packages/proof/proof.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/proof/proof.0.0.1/satysfi.yaml index ea4b4c776..5467511b2 100644 --- a/lib-satysfi/dist/packages/proof/proof.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/proof/proof.0.0.1/satysfi.yaml @@ -4,3 +4,7 @@ contents: main_module: "Proof" source_directories: - "./src" + dependencies: + - name: "stdlib" + requirements: + - "0.0.1" diff --git a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml index 5729ac46f..eb98e44f6 100644 --- a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml @@ -4,3 +4,23 @@ contents: main_module: "StdJaBook" source_directories: - "./src" + dependencies: + - name: "stdlib" + requirements: + - "0.0.1" + + - name: "math" + requirements: + - "0.0.1" + + - name: "annot" + requirements: + - "0.0.1" + + - name: "code" + requirements: + - "0.0.1" + + - name: "footnote-scheme" + requirements: + - "0.0.1" diff --git a/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml index a0e56c3ca..6628681d4 100644 --- a/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml @@ -4,3 +4,23 @@ contents: main_module: "StdJaReport" source_directories: - "./src" + dependencies: + - name: "stdlib" + requirements: + - "0.0.1" + + - name: "math" + requirements: + - "0.0.1" + + - name: "annot" + requirements: + - "0.0.1" + + - name: "code" + requirements: + - "0.0.1" + + - name: "footnote-scheme" + requirements: + - "0.0.1" diff --git a/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/satysfi.yaml index d42ef783f..cb337f004 100644 --- a/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/satysfi.yaml @@ -4,3 +4,19 @@ contents: main_module: "StdJa" source_directories: - "./src" + dependencies: + - name: "stdlib" + requirements: + - "0.0.1" + + - name: "math" + requirements: + - "0.0.1" + + - name: "annot" + requirements: + - "0.0.1" + + - name: "code" + requirements: + - "0.0.1" diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/satysfi.yaml index 3532c99df..db40422ab 100644 --- a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/satysfi.yaml @@ -4,3 +4,4 @@ contents: main_module: "Stdlib" source_directories: - "./src" + dependencies: [] diff --git a/lib-satysfi/dist/packages/tabular/tabular.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/tabular/tabular.0.0.1/satysfi.yaml index d2c003af2..be9c9a3fb 100644 --- a/lib-satysfi/dist/packages/tabular/tabular.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/tabular/tabular.0.0.1/satysfi.yaml @@ -4,3 +4,7 @@ contents: main_module: "Tabular" source_directories: - "./src" + dependencies: + - name: "stdlib" + requirements: + - "0.0.1" diff --git a/src/frontend/packageRegistry.ml b/src/frontend/packageRegistry.ml index 7ad856696..f4183e462 100644 --- a/src/frontend/packageRegistry.ml +++ b/src/frontend/packageRegistry.ml @@ -34,10 +34,67 @@ let load_cache () : package_context ok = }; ]); ("math", [ + { + version = !@ "0.0.1"; + requires = [ dependency "stdlib" (!@ "0.0.1") ]; + }; + ]); + ("code", [ + { + version = !@ "0.0.1"; + requires = [ dependency "stdlib" (!@ "0.0.1") ]; + }; + ]); + ("annot", [ + { + version = !@ "0.0.1"; + requires = [ dependency "stdlib" (!@ "0.0.1") ]; + }; + ]); + ("itemize", [ + { + version = !@ "0.0.1"; + requires = [ dependency "stdlib" (!@ "0.0.1") ]; + }; + ]); + ("proof", [ + { + version = !@ "0.0.1"; + requires = [ dependency "stdlib" (!@ "0.0.1") ]; + }; + ]); + ("tabular", [ + { + version = !@ "0.0.1"; + requires = [ dependency "stdlib" (!@ "0.0.1") ]; + }; + ]); + ("footnote-scheme", [ + { + version = !@ "0.0.1"; + requires = [ dependency "stdlib" (!@ "0.0.1") ]; + }; + ]); + ("std-ja", [ + { + version = !@ "0.0.1"; + requires = [ + dependency "stdlib" (!@ "0.0.1"); + dependency "math" (!@ "0.0.1"); + dependency "annot" (!@ "0.0.1"); + dependency "code" (!@ "0.0.1"); + ]; + }; + ]); + ("std-ja-book", [ { version = !@ "0.0.1"; requires = [ dependency "stdlib" (!@ "0.0.1"); + dependency "math" (!@ "0.0.1"); + dependency "annot" (!@ "0.0.1"); + dependency "code" (!@ "0.0.1"); + dependency "footnote-scheme" (!@ "0.0.1"); ]; }; ]); From 0d7506fe8b72f6e92ebfa4fcf73582d5b553a893 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 8 Nov 2022 03:14:30 +0900 Subject: [PATCH 100/288] introduce the attribute syntax '#[foo ...]' --- src/frontend/closedFileDependencyResolver.ml | 4 ++-- src/frontend/lexer.mll | 2 ++ src/frontend/openFileDependencyResolver.ml | 11 ++++++----- src/frontend/packageChecker.ml | 8 ++++---- src/frontend/parser.mly | 18 ++++++++++++++---- src/frontend/types.cppo.ml | 14 ++++++++++++-- src/md/decodeMD.ml | 4 ++-- 7 files changed, 42 insertions(+), 19 deletions(-) diff --git a/src/frontend/closedFileDependencyResolver.ml b/src/frontend/closedFileDependencyResolver.ml index 1d06fef24..29b40eb78 100644 --- a/src/frontend/closedFileDependencyResolver.ml +++ b/src/frontend/closedFileDependencyResolver.ml @@ -15,7 +15,7 @@ let main (utlibs : (abs_path * untyped_library_file) list) : ((abs_path * untype (* Add vertices: *) let* (graph, entryacc) = utlibs |> foldM (fun (graph, entryacc) (abspath, utlib) -> - let (_, ((_, modnm), _, _)) = utlib in + let (_attrs, _header, ((_, modnm), _, _)) = utlib in let* (graph, vertex) = match graph |> SourceModuleDependencyGraph.add_vertex modnm (abspath, utlib) with | Error(((abspath_prev, _utlib_prev), _vertex_prev)) -> @@ -31,7 +31,7 @@ let main (utlibs : (abs_path * untyped_library_file) list) : ((abs_path * untype (* Add edges: *) let* graph = entryacc |> Alist.to_list |> foldM (fun graph (utlib, vertex) -> - let (header, _) = utlib in + let (_attrs, header, _) = utlib in header |> foldM (fun graph headerelem -> match headerelem with | HeaderUse{ module_name = (rng, modnm_sub); _ } -> diff --git a/src/frontend/lexer.mll b/src/frontend/lexer.mll index cc3ca132b..f94b955b0 100644 --- a/src/frontend/lexer.mll +++ b/src/frontend/lexer.mll @@ -191,6 +191,8 @@ rule lex_program stack = parse Stack.push MathState stack; L_MATH_TEXT(get_pos lexbuf) } + | ("#[" (lower as s)) + { Stack.push ProgramState stack; ATTRIBUTE_L_SQUARE(get_pos lexbuf, s) } | "`"+ { let pos_start = get_pos lexbuf in diff --git a/src/frontend/openFileDependencyResolver.ml b/src/frontend/openFileDependencyResolver.ml index 3af810866..83195aa5b 100644 --- a/src/frontend/openFileDependencyResolver.ml +++ b/src/frontend/openFileDependencyResolver.ml @@ -53,10 +53,10 @@ let rec register_library_file (extensions : string list) (graph : graph) (packag Logging.begin_to_parse_file abspath; let* utsrc = ParserInterface.process_file abspath |> Result.map_error (fun rng -> FailedToParse(rng)) in match utsrc with - | UTLibraryFile(utlib) -> return utlib - | UTDocumentFile(_, _) -> err @@ LibraryContainsWholeReturnValue(abspath) + | UTLibraryFile(utlib) -> return utlib + | UTDocumentFile(_, _, _) -> err @@ LibraryContainsWholeReturnValue(abspath) in - let (header, _) = utlib in + let (_attrs, header, _) = utlib in let (graph, vertex) = match graph |> FileDependencyGraph.add_vertex abspath utlib with | Error(_vertex) -> assert false @@ -91,7 +91,7 @@ let register_document_file (extensions : string list) (abspath_in : abs_path) : | UTLibraryFile(_) -> err @@ DocumentLacksWholeReturnValue(abspath_in) | UTDocumentFile(utdoc) -> return utdoc in - let (header, _) = utdoc in + let (_attrs, header, _) = utdoc in let* (package_names, graph) = header |> foldM (fun (package_names, graph) headerelem -> let* local_or_package = get_header extensions curdir headerelem in @@ -130,7 +130,8 @@ let register_markdown_file (setting : string) (abspath_in : abs_path) : (Package HeaderUsePackage{ opening = false; module_name = (Range.dummy "md-header", main_module_name) } ) in - return (package_names, (header, utast)) + let utdoc = ([], header, utast) in + return (package_names, utdoc) let main ~(extensions : string list) (abspath_in : abs_path) : (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file) ok = diff --git a/src/frontend/packageChecker.ml b/src/frontend/packageChecker.ml index 931c86db0..167cd0a3e 100644 --- a/src/frontend/packageChecker.ml +++ b/src/frontend/packageChecker.ml @@ -91,7 +91,7 @@ let main (tyenv_prim : Typeenv.t) (genv : global_type_environment) (package : un (* Typecheck each source file: *) let* (_genv, libacc, ssig_opt) = sorted_utlibs |> foldM (fun (genv, libacc, ssig_opt) (abspath, utlib) -> - let (header, (modident, utsig_opt, utbinds)) = utlib in + let (_attrs, header, (modident, utsig_opt, utbinds)) = utlib in let* tyenv_for_struct = tyenv_prim |> add_dependency_to_type_environment ~package_only:false header genv in let (_, modnm) = modident in if String.equal modnm main_module_name then @@ -116,11 +116,11 @@ let main (tyenv_prim : Typeenv.t) (genv : global_type_environment) (package : un | None -> err @@ NoMainModule(main_module_name) -let main_document (tyenv_prim : Typeenv.t) (genv : global_type_environment) (sorted_locals : (abs_path * untyped_library_file) list) (utdoc : abs_path * untyped_document_file) : ((abs_path * binding list) list * abstract_tree) ok = +let main_document (tyenv_prim : Typeenv.t) (genv : global_type_environment) (sorted_locals : (abs_path * untyped_library_file) list) (abspath_and_utdoc : abs_path * untyped_document_file) : ((abs_path * binding list) list * abstract_tree) ok = let open ResultMonad in let* (genv, libacc) = sorted_locals |> foldM (fun (genv, libacc) (abspath, utlib) -> - let (header, (modident, utsig_opt, utbinds)) = utlib in + let (_attrs, header, (modident, utsig_opt, utbinds)) = utlib in let (_, modnm) = modident in let* ((_quant, ssig), binds) = let* tyenv = tyenv_prim |> add_dependency_to_type_environment ~package_only:false header genv in @@ -134,7 +134,7 @@ let main_document (tyenv_prim : Typeenv.t) (genv : global_type_environment) (sor (* Typecheck the document: *) let* ast_doc = - let (abspath, (header, utast)) = utdoc in + let (abspath, (_attrs, header, utast)) = abspath_and_utdoc in let* tyenv = tyenv_prim |> add_dependency_to_type_environment ~package_only:false header genv in typecheck_document_file tyenv abspath utast in diff --git a/src/frontend/parser.mly b/src/frontend/parser.mly index 2fe23406a..36f9f1f37 100644 --- a/src/frontend/parser.mly +++ b/src/frontend/parser.mly @@ -245,6 +245,8 @@ L_PAREN R_PAREN L_SQUARE R_SQUARE L_RECORD R_RECORD L_BLOCK_TEXT R_BLOCK_TEXT L_INLINE_TEXT R_INLINE_TEXT L_MATH_TEXT R_MATH_TEXT +%token ATTRIBUTE_L_SQUARE + %token EXACT_MINUS EXACT_TIMES EXACT_AMP EXACT_TILDE EXACT_EQ %token @@ -297,6 +299,7 @@ %start main %type main +%type attribute %type modexpr %type mod_chain %type bind @@ -359,10 +362,10 @@ optterm_nonempty_list(sep, X): { ident } ; main: - | header=list(headerelem); lib=main_lib; EOI - { UTLibraryFile(header, lib) } - | header=list(headerelem); utast=expr; EOI - { UTDocumentFile(header, utast) } + | attrs=list(attribute); header=list(headerelem); lib=main_lib; EOI + { UTLibraryFile(attrs, header, lib) } + | attrs=list(attribute); header=list(headerelem); utast=expr; EOI + { UTDocumentFile(attrs, header, utast) } | rng=EOI { raise (ParseError(EmptyInputFile(rng))) } ; @@ -386,6 +389,13 @@ optional_open: | OPEN { true } | { false } ; +attribute: + | attr_left=ATTRIBUTE_L_SQUARE; utast=expr; tokR=R_SQUARE + { + let (tokL, attrnm) = attr_left in + make_standard (Tok tokL) (Tok tokR) (UTAttribute(attrnm, utast)) + } +; modexpr: | tokL=FUN; L_PAREN; modident=UPPER; COLON; utsig=sigexpr; R_PAREN; ARROW; utmod=modexpr { make_standard (Tok tokL) (Ranged utmod) (UTModFunctor(modident, utsig, utmod)) } diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index c9ec1ccd2..200507462 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -43,6 +43,8 @@ type label = string [@@deriving show] type lock_name = string [@@deriving show] +type attribute_name = string [@@deriving show] + type input_position = { input_file_name : string; input_line : int; @@ -576,12 +578,20 @@ and untyped_parameter_unit = | UTParameterUnit of (label ranged * var_name ranged) list * untyped_pattern_tree * manual_type option [@@deriving show { with_path = false; }] +type untyped_attribute_main = + | UTAttribute of attribute_name * untyped_abstract_tree +[@@deriving show { with_path = false; }] + +type untyped_attribute = + untyped_attribute_main ranged +[@@deriving show { with_path = false; }] + type untyped_library_file = - header_element list * (module_name ranged * untyped_signature option * untyped_binding list) + untyped_attribute list * header_element list * (module_name ranged * untyped_signature option * untyped_binding list) [@@deriving show { with_path = false; }] type untyped_document_file = - header_element list * untyped_abstract_tree + untyped_attribute list * header_element list * untyped_abstract_tree [@@deriving show { with_path = false; }] type untyped_source_file = diff --git a/src/md/decodeMD.ml b/src/md/decodeMD.ml index 2fd22a023..ecfb4c65a 100644 --- a/src/md/decodeMD.ml +++ b/src/md/decodeMD.ml @@ -476,8 +476,8 @@ let decode (cmdrcd : command_record) (s : string) = in let utasthead = match ParserInterface.process_text "(markdown)" strheader with - | Ok(UTDocumentFile([], u)) -> u - | _ -> failwith "TODO (error): invalid header expression" + | Ok(UTDocumentFile([], [], u)) -> u + | _ -> failwith "TODO (error): invalid header expression" in let blk = normalize_h1 md in (* From d321e712b939e541c0d53414fe8cfd0a60f06359 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 8 Nov 2022 03:25:26 +0900 Subject: [PATCH 101/288] update the parser test --- test/parsing/parser.expected | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/test/parsing/parser.expected b/test/parsing/parser.expected index 268148c5c..c34444624 100644 --- a/test/parsing/parser.expected +++ b/test/parsing/parser.expected @@ -3,7 +3,7 @@ ;; nx.saty (UTLibraryFile - ([], + ([], [], (((Range.Normal ), "Nx"), None, [((Range.Normal ), (UTBindValue (Stage1, @@ -675,7 +675,7 @@ ;; variants.saty (UTLibraryFile - ([], + ([], [], (((Range.Normal ), "Variants"), None, [((Range.Normal ), (UTBindType @@ -708,7 +708,7 @@ ;; txprod.saty (UTLibraryFile - ([], + ([], [], (((Range.Normal ), "Txprod"), None, [((Range.Normal ), (UTBindType @@ -744,7 +744,7 @@ ;; txlist.saty (UTLibraryFile - ([], + ([], [], (((Range.Normal ), "Txlist"), None, [((Range.Normal ), (UTBindType @@ -796,7 +796,7 @@ ;; txrecord.saty (UTLibraryFile - ([], + ([], [], (((Range.Normal ), "Txrecord"), None, [((Range.Normal ), (UTBindType @@ -848,7 +848,7 @@ ;; pats.saty (UTLibraryFile - ([], + ([], [], (((Range.Normal ), "Pats"), None, [((Range.Normal ), (UTBindValue (Stage1, @@ -884,7 +884,7 @@ ;; pattuple.saty (UTLibraryFile - ([], + ([], [], (((Range.Normal ), "Pattuple"), None, [((Range.Normal ), (UTBindValue (Stage1, @@ -911,7 +911,7 @@ ;; patlist.saty (UTLibraryFile - ([], + ([], [], (((Range.Normal ), "Patlist"), None, [((Range.Normal ), (UTBindValue (Stage1, @@ -966,7 +966,7 @@ ;; sxlist.saty (UTLibraryFile - ([], + ([], [], (((Range.Normal ), "Sxlist"), None, [((Range.Normal ), (UTBindValue (Stage1, @@ -983,7 +983,7 @@ ;; mathlist.saty (UTLibraryFile - ([], + ([], [], (((Range.Normal ), "Mathlist"), None, [((Range.Normal ), (UTBindValue (Stage1, @@ -1221,7 +1221,7 @@ ;; toplevel.saty (UTLibraryFile - ([], + ([], [], (((Range.Normal ), "Toplevel"), None, [((Range.Normal ), (UTBindType From dd2bfcde5075d515463faf9834ac578b473f9486 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 8 Nov 2022 03:52:36 +0900 Subject: [PATCH 102/288] introduce 'DocumentAttribute' --- src/frontend/configError.ml | 1 + src/frontend/documentAttribute.ml | 84 +++++++++++++++++++++++++++ src/frontend/main.ml | 96 ++++++++++++++++++++++++------- 3 files changed, 160 insertions(+), 21 deletions(-) create mode 100644 src/frontend/documentAttribute.ml diff --git a/src/frontend/configError.ml b/src/frontend/configError.ml index b41a0819b..c6009517d 100644 --- a/src/frontend/configError.ml +++ b/src/frontend/configError.ml @@ -65,6 +65,7 @@ type config_error = candidates : abs_path list; } | CannotSolvePackageConstraints + | DocumentAttributeError of DocumentAttribute.error type font_error = | InvalidFontAbbrev of font_abbrev diff --git a/src/frontend/documentAttribute.ml b/src/frontend/documentAttribute.ml new file mode 100644 index 000000000..b68fe54a2 --- /dev/null +++ b/src/frontend/documentAttribute.ml @@ -0,0 +1,84 @@ + +open MyUtil +open Types +open PackageSystemBase + + +type error = + | MoreThanOneDependencyAttribute of Range.t * Range.t + | NotASemanticVersion of Range.t * string + | NotAPackageDependency of Range.t + | NotAListLiteral of Range.t + +type 'a ok = ('a, error) result + +type t = { + dependencies : package_dependency list; +} + + +let decode_package_dependency (utast : untyped_abstract_tree) : package_dependency ok = + let open ResultMonad in + match utast with + | (rng, UTTuple(utasts)) -> + begin + match TupleList.to_list utasts with + | [ (_, UTStringConstant(package_name)); (rng_version, UTStringConstant(s_version)) ] -> + begin + match SemanticVersion.parse s_version with + | Some(semver) -> + return @@ PackageDependency{ + package_name; + restrictions = [ CompatibleWith(semver) ]; + } + + | None -> + err @@ NotASemanticVersion(rng_version, s_version) + end + + | _ -> + err @@ NotAPackageDependency(rng) + end + + | (rng, _) -> + err @@ NotAPackageDependency(rng) + + +let decode_dependencies (utast : untyped_abstract_tree) : (package_dependency list) ok = + let open ResultMonad in + let rec aux depacc (utast : untyped_abstract_tree) = + match utast with + | (_, UTEndOfList) -> + return @@ Alist.to_list depacc + + | (_, UTListCons(utast_elem, utast_tail)) -> + let* dep = decode_package_dependency utast_elem in + aux (Alist.extend depacc dep) utast_tail + + | (rng, _) -> + err @@ NotAListLiteral(rng) + in + aux Alist.empty utast + + +let make (attrs : untyped_attribute list) : t ok = + let open ResultMonad in + let dependencies_attrs = + attrs |> List.filter_map (function + | (rng, UTAttribute(attrnm, utast)) -> + if String.equal "dependencies" attrnm then + Some((rng, utast)) + else + None + ) + in + match dependencies_attrs with + | [] -> + return { dependencies = [] } + + | [ (_, utast) ] -> + let* dependencies = decode_dependencies utast in + return { dependencies } + + | (rng1, _) :: (rng2, _) :: _ -> + err @@ MoreThanOneDependencyAttribute(rng1, rng2) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index f5997dc75..c117b8d9d 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -818,6 +818,33 @@ let make_yaml_error_lines : yaml_error -> line list = function [ NormalLine(Printf.sprintf "not a semantic version: '%s'%s" s (show_yaml_context yctx)) ] +let report_document_attribute_error : DocumentAttribute.error -> unit = function + | MoreThanOneDependencyAttribute(rng1, rng2) -> + report_error Interface [ + NormalLine("More than one attribute defines dependencies:"); + DisplayLine(Printf.sprintf "- %s" (Range.to_string rng1)); + DisplayLine(Printf.sprintf "- %s" (Range.to_string rng2)); + ] + + | NotASemanticVersion(rng, s) -> + report_error Interface [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "not a semantic version: '%s'" s); + ] + + | NotAPackageDependency(rng) -> + report_error Interface [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "not a package dependency description."); + ] + + | NotAListLiteral(rng) -> + report_error Interface [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine(Printf.sprintf "not a list literal."); + ] + + let report_config_error : config_error -> unit = function | NotADocumentFile(abspath_in, ty) -> let fname = convert_abs_path_to_show abspath_in in @@ -1004,6 +1031,9 @@ let report_config_error : config_error -> unit = function NormalLine("cannot solve package constraints."); ] + | DocumentAttributeError(e) -> + report_document_attribute_error e + let report_font_error : font_error -> unit = function | InvalidFontAbbrev(abbrev) -> @@ -1456,10 +1486,12 @@ let build type solve_input = | PackageSolveInput of { - root : abs_path; - lock : abs_path; + root : abs_path; (* The absolute path of a directory used as the package root *) + lock : abs_path; (* A path for writing a resulting lock file *) + } + | DocumentSolveInput of { + path : abs_path; (* The absolute path to the document file *) } - | DocumentSolveInput let make_lock_name (package_name : package_name) (semver : SemanticVersion.t) : lock_name = @@ -1487,6 +1519,22 @@ let convert_solutions_to_lock_config (solutions : package_solution list) : LockC LockConfig.{ locked_packages } +let extract_attributes_from_document_file (abspath_in : abs_path) : (DocumentAttribute.t, config_error) result = + let open ResultMonad in + Logging.begin_to_parse_file abspath_in; + let* utsrc = + ParserInterface.process_file abspath_in + |> Result.map_error (fun rng -> FailedToParse(rng)) + in + let* (attrs, _header, _utast) = + match utsrc with + | UTLibraryFile(_) -> err @@ DocumentLacksWholeReturnValue(abspath_in) + | UTDocumentFile(utdoc) -> return utdoc + in + DocumentAttribute.make attrs + |> Result.map_error (fun e -> DocumentAttributeError(e)) + + let solve ~(fpath_in : string) = @@ -1505,19 +1553,26 @@ let solve lock = abspath_lock_config; } else - DocumentSolveInput + DocumentSolveInput{ + path = abspath_in; + } in - match solve_input with - | PackageSolveInput{ - root = absdir_package; - lock = abspath_lock_config; - } -> - let res = - let open ResultMonad in + let res = + let open ResultMonad in + match solve_input with + | PackageSolveInput{ + root = absdir_package; + lock = abspath_lock_config; + } -> let* config = PackageConfig.load absdir_package in begin match config.package_contents with | PackageConfig.Library{ dependencies; _ } -> + + (* TODO: remove this: *) + Format.printf "@[**** DEPENDENCIES:@ %a@," + (Format.pp_print_list pp_package_dependency) dependencies; + let* package_context = PackageRegistry.load_cache () in let solutions_opt = PackageConstraintSolver.solve package_context dependencies in begin @@ -1528,8 +1583,6 @@ let solve | Some(solutions) -> (* TODO: remove this: *) - Format.printf "@[**** DEPENDENCIES:@ %a@," - (Format.pp_print_list pp_package_dependency) dependencies; Format.printf "**** SOLUTIONS:@ %a@,@]" (Format.pp_print_list pp_package_solution) solutions; @@ -1538,13 +1591,14 @@ let solve return () end end - in - begin - match res with - | Ok(()) -> () - | Error(e) -> raise (ConfigError(e)) - end - | DocumentSolveInput -> - failwith "TODO: Main.solve, DocumentSolveInput" + | DocumentSolveInput{ path = abspath_in } -> + let* _docattr = extract_attributes_from_document_file abspath_in in + failwith "TODO: Main.solve, DocumentSolveInput" + in + begin + match res with + | Ok(()) -> () + | Error(e) -> raise (ConfigError(e)) + end ) From 7828f72b77eb508375918273d6da2377f14ca82a Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 8 Nov 2022 04:21:06 +0900 Subject: [PATCH 103/288] use 'DocumentAttribute' for specifying dependencies of documents --- src/backend/optionState.ml | 52 ++++++++++------ src/backend/optionState.mli | 20 +++++-- src/frontend/main.ml | 116 +++++++++++++++++++++--------------- 3 files changed, 116 insertions(+), 72 deletions(-) diff --git a/src/backend/optionState.ml b/src/backend/optionState.ml index 4b7447d85..38190d71a 100644 --- a/src/backend/optionState.ml +++ b/src/backend/optionState.ml @@ -9,14 +9,12 @@ type output_mode = | PdfMode | TextMode of string list -type state = { +type build_state = { input_file : abs_path; output_file : abs_path option; - extra_config_paths : (string list) option; - output_mode : output_mode; input_kind : input_kind; + output_mode : output_mode; page_number_limit : int; - show_full_path : bool; debug_show_bbox : bool; debug_show_space : bool; debug_show_block_bbox : bool; @@ -24,8 +22,18 @@ type state = { debug_show_overfull : bool; type_check_only : bool; bytecomp : bool; - show_fonts : bool; - no_default_config : bool; +} + +type command_state = + | BuildState of build_state + | SolveState + +type state = { + command_state : command_state; + extra_config_paths : (string list) option; + show_full_path : bool; + show_fonts : bool; + no_default_config : bool; } @@ -42,20 +50,26 @@ let get () = | Some(r) -> r -let get_input_file () = (get ()).input_file -let get_output_file () = (get ()).output_file +let get_build_state () = + match (get ()).command_state with + | BuildState(b) -> b + | _ -> assert false + + +let get_input_file () = (get_build_state ()).input_file +let get_output_file () = (get_build_state ()).output_file let get_extra_config_paths () = (get ()).extra_config_paths -let get_output_mode () = (get ()).output_mode -let get_input_kind () = (get ()).input_kind -let get_page_number_limit () = (get ()).page_number_limit +let get_output_mode () = (get_build_state ()).output_mode +let get_input_kind () = (get_build_state ()).input_kind +let get_page_number_limit () = (get_build_state ()).page_number_limit let does_show_full_path () = (get ()).show_full_path -let does_debug_show_bbox () = (get ()).debug_show_bbox -let does_debug_show_space () = (get ()).debug_show_space -let does_debug_show_block_bbox () = (get ()).debug_show_block_bbox -let does_debug_show_block_space () = (get ()).debug_show_block_space -let does_debug_show_overfull () = (get ()).debug_show_overfull -let is_type_check_only () = (get ()).type_check_only -let is_bytecomp_mode () = (get ()).bytecomp +let does_debug_show_bbox () = (get_build_state ()).debug_show_bbox +let does_debug_show_space () = (get_build_state ()).debug_show_space +let does_debug_show_block_bbox () = (get_build_state ()).debug_show_block_bbox +let does_debug_show_block_space () = (get_build_state ()).debug_show_block_space +let does_debug_show_overfull () = (get_build_state ()).debug_show_overfull +let is_type_check_only () = (get_build_state ()).type_check_only +let is_bytecomp_mode () = (get_build_state ()).bytecomp let does_show_fonts () = (get ()).show_fonts let use_no_default_config () = (get ()).no_default_config @@ -66,6 +80,6 @@ let job_directory () = let is_text_mode () = - match (get ()).output_mode with + match (get_build_state ()).output_mode with | TextMode(_) -> true | PdfMode -> false diff --git a/src/backend/optionState.mli b/src/backend/optionState.mli index 53f345eff..be1e47143 100644 --- a/src/backend/optionState.mli +++ b/src/backend/optionState.mli @@ -9,14 +9,12 @@ type output_mode = | PdfMode | TextMode of string list -type state = { +type build_state = { input_file : abs_path; output_file : abs_path option; - extra_config_paths : (string list) option; - output_mode : output_mode; input_kind : input_kind; + output_mode : output_mode; page_number_limit : int; - show_full_path : bool; debug_show_bbox : bool; debug_show_space : bool; debug_show_block_bbox : bool; @@ -24,8 +22,18 @@ type state = { debug_show_overfull : bool; type_check_only : bool; bytecomp : bool; - show_fonts : bool; - no_default_config : bool; +} + +type command_state = + | BuildState of build_state + | SolveState + +type state = { + command_state : command_state; + extra_config_paths : (string list) option; + show_full_path : bool; + show_fonts : bool; + no_default_config : bool; } val set : state -> unit diff --git a/src/frontend/main.ml b/src/frontend/main.ml index c117b8d9d..3d05c806c 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1364,20 +1364,23 @@ let build | Some(setting) -> OptionState.Markdown(setting) in OptionState.set OptionState.{ - input_file; - output_file; + command_state = + BuildState{ + input_file; + output_file; + output_mode; + input_kind; + page_number_limit; + debug_show_bbox; + debug_show_space; + debug_show_block_bbox; + debug_show_block_space; + debug_show_overfull; + type_check_only; + bytecomp; + }; extra_config_paths; - output_mode; - input_kind; - page_number_limit; show_full_path; - debug_show_bbox; - debug_show_space; - debug_show_block_bbox; - debug_show_block_space; - debug_show_overfull; - type_check_only; - bytecomp; show_fonts; no_default_config; }; @@ -1491,6 +1494,7 @@ type solve_input = } | DocumentSolveInput of { path : abs_path; (* The absolute path to the document file *) + lock : abs_path; (* A path for writing a resulting lock file *) } @@ -1541,6 +1545,15 @@ let solve error_log_environment (fun () -> let curdir = Sys.getcwd () in + (* TODO: add options *) + OptionState.set OptionState.{ + command_state = SolveState; + extra_config_paths = None; + show_full_path = false; + show_fonts = false; + no_default_config = false; + }; + setup_root_dirs ~no_default_config:false ~extra_config_paths:None curdir; let abspath_in = make_absolute_if_relative ~origin:curdir fpath_in in let solve_input = @@ -1553,48 +1566,57 @@ let solve lock = abspath_lock_config; } else + let basename_without_extension = Filename.remove_extension (get_abs_path_string abspath_in) in + let abspath_lock_config = make_document_lock_config_path basename_without_extension in DocumentSolveInput{ path = abspath_in; + lock = abspath_lock_config; } in let res = let open ResultMonad in - match solve_input with - | PackageSolveInput{ - root = absdir_package; - lock = abspath_lock_config; - } -> - let* config = PackageConfig.load absdir_package in - begin - match config.package_contents with - | PackageConfig.Library{ dependencies; _ } -> - - (* TODO: remove this: *) - Format.printf "@[**** DEPENDENCIES:@ %a@," - (Format.pp_print_list pp_package_dependency) dependencies; - - let* package_context = PackageRegistry.load_cache () in - let solutions_opt = PackageConstraintSolver.solve package_context dependencies in - begin - match solutions_opt with - | None -> - err CannotSolvePackageConstraints - - | Some(solutions) -> - - (* TODO: remove this: *) - Format.printf "**** SOLUTIONS:@ %a@,@]" - (Format.pp_print_list pp_package_solution) solutions; - - let lock_config = convert_solutions_to_lock_config solutions in - LockConfig.write abspath_lock_config lock_config; - return () - end - end + let* (dependencies, abspath_lock_config) = + match solve_input with + | PackageSolveInput{ + root = absdir_package; + lock = abspath_lock_config; + } -> + let* config = PackageConfig.load absdir_package in + begin + match config.package_contents with + | PackageConfig.Library{ dependencies; _ } -> + return (dependencies, abspath_lock_config) + end + + | DocumentSolveInput{ + path = abspath_in; + lock = abspath_lock_config; + } -> + let* docattr = extract_attributes_from_document_file abspath_in in + return (docattr.DocumentAttribute.dependencies, abspath_lock_config) + in + + (* TODO: remove this: *) + Format.printf "@[**** DEPENDENCIES:@ %a@," + (Format.pp_print_list pp_package_dependency) dependencies; + + let* package_context = PackageRegistry.load_cache () in + let solutions_opt = PackageConstraintSolver.solve package_context dependencies in + begin + match solutions_opt with + | None -> + err CannotSolvePackageConstraints + + | Some(solutions) -> + + (* TODO: remove this: *) + Format.printf "**** SOLUTIONS:@ %a@,@]" + (Format.pp_print_list pp_package_solution) solutions; - | DocumentSolveInput{ path = abspath_in } -> - let* _docattr = extract_attributes_from_document_file abspath_in in - failwith "TODO: Main.solve, DocumentSolveInput" + let lock_config = convert_solutions_to_lock_config solutions in + LockConfig.write abspath_lock_config lock_config; + return () + end in begin match res with From 02d153fb346c1ecd60c4c0bbc080bdfddc6520c9 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 8 Nov 2022 04:29:56 +0900 Subject: [PATCH 104/288] add '#[dependencies ...]' attribute to '{demo,doc}/*.saty' --- demo/demo.saty | 8 ++++++++ doc/doc-lang.saty | 5 +++++ doc/doc-primitives.saty | 6 ++++++ 3 files changed, 19 insertions(+) diff --git a/demo/demo.saty b/demo/demo.saty index b35ba8db7..661db1d2f 100644 --- a/demo/demo.saty +++ b/demo/demo.saty @@ -1,3 +1,11 @@ +#[dependencies [ + (`stdlib`, `0.0.1`), + (`math`, `0.0.1`), + (`code`, `0.0.1`), + (`itemize`, `0.0.1`), + (`tabular`, `0.0.1`), + (`std-ja-book`, `0.0.1`), +]] use package open Stdlib use package open Math use package open Annot diff --git a/doc/doc-lang.saty b/doc/doc-lang.saty index 52cdcc778..c0b719255 100644 --- a/doc/doc-lang.saty +++ b/doc/doc-lang.saty @@ -1,3 +1,8 @@ +#[dependencies [ + (`stdlib`, `0.0.1`), + (`math`, `0.0.1`), + (`std-ja`, `0.0.1`), +]] use package open Stdlib use package open StdJa use package open Math diff --git a/doc/doc-primitives.saty b/doc/doc-primitives.saty index b59fa5274..449b06fc4 100644 --- a/doc/doc-primitives.saty +++ b/doc/doc-primitives.saty @@ -1,3 +1,9 @@ +#[dependencies [ + (`stdlib`, `0.0.1`), + (`math`, `0.0.1`), + (`itemize`, `0.0.1`), + (`std-ja-book`, `0.0.1`), +]] use package open Stdlib use package open Math use package open Itemize From 8ba9bf97b362b4c8fb4ac55a741c7fd79e35f9e5 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 8 Nov 2022 04:51:54 +0900 Subject: [PATCH 105/288] add 'Logging.show_package_dependency_{before_solving,solutions}' --- src/frontend/logging.ml | 21 +++++++++++++++++++++ src/frontend/main.ml | 8 ++------ 2 files changed, 23 insertions(+), 6 deletions(-) diff --git a/src/frontend/logging.ml b/src/frontend/logging.ml index afd27006d..7900d0989 100644 --- a/src/frontend/logging.ml +++ b/src/frontend/logging.ml @@ -1,5 +1,6 @@ open MyUtil +open PackageSystemBase let show_path abspath = @@ -114,6 +115,26 @@ let begin_to_write_page () = print_endline (" writing pages ...") +let show_package_dependency_before_solving (dependencies : package_dependency list) = + Printf.printf " package dependencies to solve:\n"; + dependencies |> List.iter (function + | PackageDependency{ package_name; restrictions } -> + let s_restr = + restrictions |> List.map (function + | CompatibleWith(semver) -> SemanticVersion.to_string semver + ) |> String.concat ", " + in + Printf.printf " - %s (%s)\n" package_name s_restr; + ) + + +let show_package_dependency_solutions (solutions : package_solution list) = + Printf.printf " package dependency solutions:\n"; + solutions |> List.iter (fun solution -> + Printf.printf " - %s %s\n" solution.package_name (SemanticVersion.to_string solution.locked_version) + ) + + let show_single_font abbrev relpath = print_endline (" * `" ^ abbrev ^ "`: '" ^ (get_lib_path_string relpath) ^ "'") diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 3d05c806c..968b16e93 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1596,9 +1596,7 @@ let solve return (docattr.DocumentAttribute.dependencies, abspath_lock_config) in - (* TODO: remove this: *) - Format.printf "@[**** DEPENDENCIES:@ %a@," - (Format.pp_print_list pp_package_dependency) dependencies; + Logging.show_package_dependency_before_solving dependencies; let* package_context = PackageRegistry.load_cache () in let solutions_opt = PackageConstraintSolver.solve package_context dependencies in @@ -1609,9 +1607,7 @@ let solve | Some(solutions) -> - (* TODO: remove this: *) - Format.printf "**** SOLUTIONS:@ %a@,@]" - (Format.pp_print_list pp_package_solution) solutions; + Logging.show_package_dependency_solutions solutions; let lock_config = convert_solutions_to_lock_config solutions in LockConfig.write abspath_lock_config lock_config; From d1cf57034b1e43e0a1962861af0673af8f44e38f Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 8 Nov 2022 04:54:29 +0900 Subject: [PATCH 106/288] remove printf for debugging --- src/frontend/packageConstraintSolver.ml | 14 +------------- 1 file changed, 1 insertion(+), 13 deletions(-) diff --git a/src/frontend/packageConstraintSolver.ml b/src/frontend/packageConstraintSolver.ml index d0c0f1017..f76f56986 100644 --- a/src/frontend/packageConstraintSolver.ml +++ b/src/frontend/packageConstraintSolver.ml @@ -42,14 +42,12 @@ module SolverInput = struct type command_name = string type restriction = package_restriction - [@@deriving show { with_path = false }] type dependency = | Dependency of { role : Role.t; restrictions : package_restriction list; } - [@@deriving show { with_path = false }] type dep_info = { dep_role : Role.t; @@ -120,13 +118,11 @@ module SolverInput = struct let dep_info (dep : dependency) : dep_info = - Format.printf "@[DEP_INFO dep: %a@]@," pp_dependency dep; (* TODO: remove this *) let Dependency{ role; _ } = dep in { dep_role = role; dep_importance = `Essential; dep_required_commands = [] } let requires (_role : Role.t) (impl : impl) : dependency list * command_name list = - Format.printf "@[REQUIRES@ impl: %a@]@," pp_impl impl; (* TODO: remove this *) match impl with | DummyImpl -> ([], []) | LocalImpl{ dependencies } -> (dependencies, []) @@ -148,7 +144,6 @@ module SolverInput = struct let implementations (role : Role.t) : role_information = match role with | Role{ package_name; context } -> - Format.printf "@[IMPLEMENTATIONS: %s@]@," package_name; (* TODO: remove this *) let impl_records = context.registry_contents |> PackageNameMap.find_opt package_name |> Option.value ~default:[] in @@ -162,21 +157,17 @@ module SolverInput = struct { replacement = None; impls } | LocalRole{ requires; context } -> - Format.printf "@[IMPLEMENTATIONS: local (requires: %a)@]@," - (Format.pp_print_list pp_package_dependency) requires; (* TODO: remove this *) let dependencies = make_internal_dependency context requires in let impls = [ LocalImpl{ dependencies } ] in { replacement = None; impls } let restrictions (dep : dependency) : restriction list = - Format.printf "@[RESTRICTIONS: %a@]\n" pp_dependency dep; (* TODO: remove this *) let Dependency{ restrictions; _ } = dep in restrictions let meets_restriction (impl : impl) (restr : restriction) : bool = - Format.printf "@[MEETS_RESTRICTION impl: %a, restr: %a@]@," pp_impl impl pp_restriction restr; (* TODO: define this *) match impl with | DummyImpl -> false @@ -198,10 +189,9 @@ module SolverInput = struct let conflict_class (impl : impl) : conflict_class list = - Format.printf "@[CONFLICT_CLASS impl: %a@]@," pp_impl impl; (* TODO: remove this *) match impl with | DummyImpl | LocalImpl(_) -> - [ "*" ] (* TODO: improve this *) + [ "*" ] | Impl{ package_name; _ } -> [ package_name ] (* TODO: take major versions into account *) @@ -252,14 +242,12 @@ module InternalSolver = Zeroinstall_solver.Make(SolverInput) let solve (context : package_context) (requires : package_dependency list) : (package_solution list) option = - Format.printf "@["; (* TODO: remove this *) let output_opt = InternalSolver.do_solve ~closest_match:false { role = LocalRole{ requires; context }; command = None; } in - Format.printf "@]"; (* TODO: remove this *) output_opt |> Option.map (fun output -> let open InternalSolver in let rolemap = output |> Output.to_map in From da59286bd000a605d41ac0b0e6272f4f3241bb85 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 8 Nov 2022 05:20:21 +0900 Subject: [PATCH 107/288] implement how to encode lock configs --- src/frontend/lockConfig.ml | 39 ++++++++++++++++++++++++++++++++++++-- 1 file changed, 37 insertions(+), 2 deletions(-) diff --git a/src/frontend/lockConfig.ml b/src/frontend/lockConfig.ml index 3893d1b37..6caa607f7 100644 --- a/src/frontend/lockConfig.ml +++ b/src/frontend/lockConfig.ml @@ -45,6 +45,21 @@ let lock_location_decoder : lock_location LockConfigDecoder.t = ) +let lock_location_encoder (loc : lock_location) : Yaml.value = + match loc with + | GlobalLocation{ path = s_libpath } -> + `O([ + ("type", `String("global")); + ("path", `String(s_libpath)); + ]) + + | LocalLocation{ path = s_relpath } -> + `O([ + ("type", `String("local")); + ("path", `String(s_relpath)); + ]) + + let lock_decoder : locked_package LockConfigDecoder.t = let open LockConfigDecoder in get "name" string >>= fun lock_name -> @@ -57,6 +72,14 @@ let lock_decoder : locked_package LockConfigDecoder.t = } +let lock_encoder (lock : locked_package) : Yaml.value = + `O([ + ("name", `String(lock.lock_name)); + ("location", lock_location_encoder lock.lock_location); + ("dependencies", `A(lock.lock_dependencies |> List.map (fun lock_name -> `String(lock_name)))) + ]) + + let lock_config_decoder : t LockConfigDecoder.t = let open LockConfigDecoder in get_or_else "locks" (list lock_decoder) [] >>= fun locked_packages -> @@ -65,6 +88,12 @@ let lock_config_decoder : t LockConfigDecoder.t = } +let lock_config_encoder (lock_config : t) : Yaml.value = + `O([ + ("locks", `A(lock_config.locked_packages |> List.map lock_encoder)) + ]) + + let load (abspath_lock_config : abs_path) : t ok = let open ResultMonad in let* inc = @@ -79,5 +108,11 @@ let load (abspath_lock_config : abs_path) : t ok = |> Result.map_error (fun e -> LockConfigError(abspath_lock_config, e)) -let write (_abspath_lock_config : abs_path) (_lock_config : t) : unit = - failwith "TODO: LockConfig.write" +let write (_abspath_lock_config : abs_path) (lock_config : t) : unit = + let yaml = lock_config_encoder lock_config in + match Yaml.to_string ~encoding:`Utf8 ~layout_style:`Block ~scalar_style:`Double_quoted yaml with + | Ok(s) -> + print_endline s (* TODO: output to file *) + + | Error(_) -> + assert false From 735e288dad25616b8323b6a24cb2dcfe09ed10d5 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 8 Nov 2022 05:26:46 +0900 Subject: [PATCH 108/288] make 'LockConfig.write' output lock files --- src/frontend/lockConfig.ml | 9 +++++---- src/frontend/logging.ml | 6 ++++++ 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/src/frontend/lockConfig.ml b/src/frontend/lockConfig.ml index 6caa607f7..cf8cb0abc 100644 --- a/src/frontend/lockConfig.ml +++ b/src/frontend/lockConfig.ml @@ -108,11 +108,12 @@ let load (abspath_lock_config : abs_path) : t ok = |> Result.map_error (fun e -> LockConfigError(abspath_lock_config, e)) -let write (_abspath_lock_config : abs_path) (lock_config : t) : unit = +let write (abspath_lock_config : abs_path) (lock_config : t) : unit = let yaml = lock_config_encoder lock_config in - match Yaml.to_string ~encoding:`Utf8 ~layout_style:`Block ~scalar_style:`Double_quoted yaml with - | Ok(s) -> - print_endline s (* TODO: output to file *) + match Yaml.to_string ~encoding:`Utf8 ~layout_style:`Block ~scalar_style:`Plain yaml with + | Ok(data) -> + Core.Out_channel.write_all (get_abs_path_string abspath_lock_config) ~data; + Logging.end_lock_output abspath_lock_config | Error(_) -> assert false diff --git a/src/frontend/logging.ml b/src/frontend/logging.ml index 7900d0989..9008768bf 100644 --- a/src/frontend/logging.ml +++ b/src/frontend/logging.ml @@ -135,6 +135,12 @@ let show_package_dependency_solutions (solutions : package_solution list) = ) +let end_lock_output file_name_out = + print_endline (" ---- ---- ---- ----"); + print_endline (" output written on '" ^ (show_path file_name_out) ^ "'.") + + + let show_single_font abbrev relpath = print_endline (" * `" ^ abbrev ^ "`: '" ^ (get_lib_path_string relpath) ^ "'") From 0a5607b3b3bb6c2e026eb8b047433feeba25f597 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 8 Nov 2022 05:37:04 +0900 Subject: [PATCH 109/288] generate '{demo,doc}/*.satysfi-lock' by 'satysfi solve' --- demo/demo.saty | 1 + demo/demo.satysfi-lock | 121 +++++++++++++++----------------- doc/doc-lang.satysfi-lock | 67 +++++++++--------- doc/doc-primitives.satysfi-lock | 95 ++++++++++++------------- 4 files changed, 135 insertions(+), 149 deletions(-) diff --git a/demo/demo.saty b/demo/demo.saty index 661db1d2f..18585aa85 100644 --- a/demo/demo.saty +++ b/demo/demo.saty @@ -3,6 +3,7 @@ (`math`, `0.0.1`), (`code`, `0.0.1`), (`itemize`, `0.0.1`), + (`proof`, `0.0.1`), (`tabular`, `0.0.1`), (`std-ja-book`, `0.0.1`), ]] diff --git a/demo/demo.satysfi-lock b/demo/demo.satysfi-lock index aaaba0e78..dc8fce20c 100644 --- a/demo/demo.satysfi-lock +++ b/demo/demo.satysfi-lock @@ -1,65 +1,58 @@ locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" - - - name: "math.0.0.1" - location: - type: "global" - path: "./dist/packages/math/math.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "std-ja-book.0.0.1" - dependencies: - - "stdlib.0.0.1" - - "math.0.0.1" - - "annot.0.0.1" - - "code.0.0.1" - - "footnote-scheme.0.0.1" - location: - type: "global" - path: "./dist/packages/std-ja-book/std-ja-book.0.0.1/" - - - name: "annot.0.0.1" - location: - type: "global" - path: "./dist/packages/annot/annot.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "code.0.0.1" - location: - type: "global" - path: "./dist/packages/code/code.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "footnote-scheme.0.0.1" - location: - type: "global" - path: "./dist/packages/footnote-scheme/footnote-scheme.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "itemize.0.0.1" - location: - type: "global" - path: "./dist/packages/itemize/itemize.0.0.1" - dependencies: - - "stdlib.0.0.1" - - - name: "proof.0.0.1" - location: - type: "global" - path: "./dist/packages/proof/proof.0.0.1" - dependencies: - - "stdlib.0.0.1" - - - name: "tabular.0.0.1" - location: - type: "global" - path: "./dist/packages/tabular/tabular.0.0.1" - dependencies: - - "stdlib.0.0.1" +- name: annot.0.0.1 + location: + type: global + path: ./dist/packages/annot/annot.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: code.0.0.1 + location: + type: global + path: ./dist/packages/code/code.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: footnote-scheme.0.0.1 + location: + type: global + path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: itemize.0.0.1 + location: + type: global + path: ./dist/packages/itemize/itemize.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: math.0.0.1 + location: + type: global + path: ./dist/packages/math/math.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: proof.0.0.1 + location: + type: global + path: ./dist/packages/proof/proof.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: std-ja-book.0.0.1 + location: + type: global + path: ./dist/packages/std-ja-book/std-ja-book.0.0.1/ + dependencies: + - stdlib.0.0.1 + - math.0.0.1 + - annot.0.0.1 + - code.0.0.1 + - footnote-scheme.0.0.1 +- name: stdlib.0.0.1 + location: + type: global + path: ./dist/packages/stdlib/stdlib.0.0.1/ + dependencies: [] +- name: tabular.0.0.1 + location: + type: global + path: ./dist/packages/tabular/tabular.0.0.1/ + dependencies: + - stdlib.0.0.1 diff --git a/doc/doc-lang.satysfi-lock b/doc/doc-lang.satysfi-lock index 7029ca2b4..5bd4d4d5f 100644 --- a/doc/doc-lang.satysfi-lock +++ b/doc/doc-lang.satysfi-lock @@ -1,36 +1,33 @@ locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" - - - name: "math.0.0.1" - location: - type: "global" - path: "./dist/packages/math/math.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "std-ja.0.0.1" - dependencies: - - "stdlib.0.0.1" - - "math.0.0.1" - - "annot.0.0.1" - - "code.0.0.1" - location: - type: "global" - path: "./dist/packages/std-ja/std-ja.0.0.1/" - - - name: "annot.0.0.1" - location: - type: "global" - path: "./dist/packages/annot/annot.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "code.0.0.1" - location: - type: "global" - path: "./dist/packages/code/code.0.0.1/" - dependencies: - - "stdlib.0.0.1" +- name: annot.0.0.1 + location: + type: global + path: ./dist/packages/annot/annot.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: code.0.0.1 + location: + type: global + path: ./dist/packages/code/code.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: math.0.0.1 + location: + type: global + path: ./dist/packages/math/math.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: std-ja.0.0.1 + location: + type: global + path: ./dist/packages/std-ja/std-ja.0.0.1/ + dependencies: + - stdlib.0.0.1 + - math.0.0.1 + - annot.0.0.1 + - code.0.0.1 +- name: stdlib.0.0.1 + location: + type: global + path: ./dist/packages/stdlib/stdlib.0.0.1/ + dependencies: [] diff --git a/doc/doc-primitives.satysfi-lock b/doc/doc-primitives.satysfi-lock index 245583812..77dce0f1a 100644 --- a/doc/doc-primitives.satysfi-lock +++ b/doc/doc-primitives.satysfi-lock @@ -1,51 +1,46 @@ locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" - - - name: "math.0.0.1" - location: - type: "global" - path: "./dist/packages/math/math.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "std-ja-book.0.0.1" - dependencies: - - "stdlib.0.0.1" - - "math.0.0.1" - - "annot.0.0.1" - - "code.0.0.1" - - "footnote-scheme.0.0.1" - location: - type: "global" - path: "./dist/packages/std-ja-book/std-ja-book.0.0.1/" - - - name: "annot.0.0.1" - location: - type: "global" - path: "./dist/packages/annot/annot.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "code.0.0.1" - location: - type: "global" - path: "./dist/packages/code/code.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "footnote-scheme.0.0.1" - location: - type: "global" - path: "./dist/packages/footnote-scheme/footnote-scheme.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "itemize.0.0.1" - location: - type: "global" - path: "./dist/packages/itemize/itemize.0.0.1" - dependencies: - - "stdlib.0.0.1" +- name: annot.0.0.1 + location: + type: global + path: ./dist/packages/annot/annot.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: code.0.0.1 + location: + type: global + path: ./dist/packages/code/code.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: footnote-scheme.0.0.1 + location: + type: global + path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: itemize.0.0.1 + location: + type: global + path: ./dist/packages/itemize/itemize.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: math.0.0.1 + location: + type: global + path: ./dist/packages/math/math.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: std-ja-book.0.0.1 + location: + type: global + path: ./dist/packages/std-ja-book/std-ja-book.0.0.1/ + dependencies: + - stdlib.0.0.1 + - math.0.0.1 + - annot.0.0.1 + - code.0.0.1 + - footnote-scheme.0.0.1 +- name: stdlib.0.0.1 + location: + type: global + path: ./dist/packages/stdlib/stdlib.0.0.1/ + dependencies: [] From 6038102b873828a20cd9b2d764aec370a461b62e Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 8 Nov 2022 05:56:19 +0900 Subject: [PATCH 110/288] generate 'tests/**/*.satysfi-lock' by 'satysfi solve' (except for 'tests/md/test.md') --- src/frontend/packageRegistry.ml | 12 ++++ tests/clip.saty | 4 ++ tests/clip.satysfi-lock | 22 +++---- tests/glue1.saty | 4 ++ tests/glue1.satysfi-lock | 22 +++---- tests/images/test.saty | 5 ++ tests/images/test.satysfi-lock | 80 +++++++++++++------------- tests/macro1.saty | 3 + tests/macro1.satysfi-lock | 82 +++++++++++++------------- tests/math-typefaces.saty | 6 ++ tests/math-typefaces.satysfi-lock | 95 +++++++++++++++---------------- tests/math2.saty | 4 ++ tests/refactor1.saty | 4 ++ tests/refactor1.satysfi-lock | 22 +++---- tests/staged1.saty | 3 + tests/staged1.satysfi-lock | 67 +++++++++++----------- 16 files changed, 232 insertions(+), 203 deletions(-) diff --git a/src/frontend/packageRegistry.ml b/src/frontend/packageRegistry.ml index f4183e462..413ba0422 100644 --- a/src/frontend/packageRegistry.ml +++ b/src/frontend/packageRegistry.ml @@ -98,6 +98,18 @@ let load_cache () : package_context ok = ]; }; ]); + ("std-ja-report", [ + { + version = !@ "0.0.1"; + requires = [ + dependency "stdlib" (!@ "0.0.1"); + dependency "math" (!@ "0.0.1"); + dependency "annot" (!@ "0.0.1"); + dependency "code" (!@ "0.0.1"); + dependency "footnote-scheme" (!@ "0.0.1"); + ]; + }; + ]); ] in return { registry_contents } diff --git a/tests/clip.saty b/tests/clip.saty index 9741d1a46..77fe77209 100644 --- a/tests/clip.saty +++ b/tests/clip.saty @@ -1,3 +1,7 @@ +#[dependencies [ + (`stdlib`, `0.0.1`), + (`math`, `0.0.1`), +]] use package open Stdlib use open Head of `head` diff --git a/tests/clip.satysfi-lock b/tests/clip.satysfi-lock index 002661c22..460d82536 100644 --- a/tests/clip.satysfi-lock +++ b/tests/clip.satysfi-lock @@ -1,12 +1,12 @@ locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" - - - name: "math.0.0.1" - location: - type: "global" - path: "./dist/packages/math/math.0.0.1/" - dependencies: - - "stdlib.0.0.1" +- name: math.0.0.1 + location: + type: global + path: ./dist/packages/math/math.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: stdlib.0.0.1 + location: + type: global + path: ./dist/packages/stdlib/stdlib.0.0.1/ + dependencies: [] diff --git a/tests/glue1.saty b/tests/glue1.saty index c20b1edb4..743b6bcdf 100644 --- a/tests/glue1.saty +++ b/tests/glue1.saty @@ -1,3 +1,7 @@ +#[dependencies [ + (`stdlib`, `0.0.1`), + (`math`, `0.0.1`), +]] use Head of `head` let open Head in diff --git a/tests/glue1.satysfi-lock b/tests/glue1.satysfi-lock index 002661c22..460d82536 100644 --- a/tests/glue1.satysfi-lock +++ b/tests/glue1.satysfi-lock @@ -1,12 +1,12 @@ locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" - - - name: "math.0.0.1" - location: - type: "global" - path: "./dist/packages/math/math.0.0.1/" - dependencies: - - "stdlib.0.0.1" +- name: math.0.0.1 + location: + type: global + path: ./dist/packages/math/math.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: stdlib.0.0.1 + location: + type: global + path: ./dist/packages/stdlib/stdlib.0.0.1/ + dependencies: [] diff --git a/tests/images/test.saty b/tests/images/test.saty index c76c3f6c8..aa69f53c8 100644 --- a/tests/images/test.saty +++ b/tests/images/test.saty @@ -1,3 +1,8 @@ +#[dependencies [ + (`std-ja`, `0.0.1`), + (`itemize`, `0.0.1`), + (`annot`, `0.0.1`), +]] use package StdJa use package Itemize use package Annot diff --git a/tests/images/test.satysfi-lock b/tests/images/test.satysfi-lock index 98920f151..4e3cb27f5 100644 --- a/tests/images/test.satysfi-lock +++ b/tests/images/test.satysfi-lock @@ -1,43 +1,39 @@ locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" - - - name: "math.0.0.1" - location: - type: "global" - path: "./dist/packages/math/math.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "std-ja.0.0.1" - dependencies: - - "stdlib.0.0.1" - - "math.0.0.1" - - "annot.0.0.1" - - "code.0.0.1" - location: - type: "global" - path: "./dist/packages/std-ja/std-ja.0.0.1/" - - - name: "annot.0.0.1" - location: - type: "global" - path: "./dist/packages/annot/annot.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "code.0.0.1" - location: - type: "global" - path: "./dist/packages/code/code.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "itemize.0.0.1" - location: - type: "global" - path: "./dist/packages/itemize/itemize.0.0.1" - dependencies: - - "stdlib.0.0.1" +- name: annot.0.0.1 + location: + type: global + path: ./dist/packages/annot/annot.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: code.0.0.1 + location: + type: global + path: ./dist/packages/code/code.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: itemize.0.0.1 + location: + type: global + path: ./dist/packages/itemize/itemize.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: math.0.0.1 + location: + type: global + path: ./dist/packages/math/math.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: std-ja.0.0.1 + location: + type: global + path: ./dist/packages/std-ja/std-ja.0.0.1/ + dependencies: + - stdlib.0.0.1 + - math.0.0.1 + - annot.0.0.1 + - code.0.0.1 +- name: stdlib.0.0.1 + location: + type: global + path: ./dist/packages/stdlib/stdlib.0.0.1/ + dependencies: [] diff --git a/tests/macro1.saty b/tests/macro1.saty index d88298c17..e3efb86ff 100644 --- a/tests/macro1.saty +++ b/tests/macro1.saty @@ -1,3 +1,6 @@ +#[dependencies [ + (`std-ja-report`, `0.0.1`), +]] use package StdJaReport use Macro1Local of `macro1-local` diff --git a/tests/macro1.satysfi-lock b/tests/macro1.satysfi-lock index ed8fabc37..1640427dc 100644 --- a/tests/macro1.satysfi-lock +++ b/tests/macro1.satysfi-lock @@ -1,44 +1,40 @@ locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" - - - name: "math.0.0.1" - location: - type: "global" - path: "./dist/packages/math/math.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "std-ja-report.0.0.1" - location: - type: "global" - path: "./dist/packages/std-ja-report/std-ja-report.0.0.1" - dependencies: - - "stdlib.0.0.1" - - "math.0.0.1" - - "code.0.0.1" - - "annot.0.0.1" - - "footnote-scheme.0.0.1" - - - name: "annot.0.0.1" - location: - type: "global" - path: "./dist/packages/annot/annot.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "code.0.0.1" - location: - type: "global" - path: "./dist/packages/code/code.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "footnote-scheme.0.0.1" - location: - type: "global" - path: "./dist/packages/footnote-scheme/footnote-scheme.0.0.1/" - dependencies: - - "stdlib.0.0.1" +- name: annot.0.0.1 + location: + type: global + path: ./dist/packages/annot/annot.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: code.0.0.1 + location: + type: global + path: ./dist/packages/code/code.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: footnote-scheme.0.0.1 + location: + type: global + path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: math.0.0.1 + location: + type: global + path: ./dist/packages/math/math.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: std-ja-report.0.0.1 + location: + type: global + path: ./dist/packages/std-ja-report/std-ja-report.0.0.1/ + dependencies: + - stdlib.0.0.1 + - math.0.0.1 + - annot.0.0.1 + - code.0.0.1 + - footnote-scheme.0.0.1 +- name: stdlib.0.0.1 + location: + type: global + path: ./dist/packages/stdlib/stdlib.0.0.1/ + dependencies: [] diff --git a/tests/math-typefaces.saty b/tests/math-typefaces.saty index 37d2867cb..d585d310e 100644 --- a/tests/math-typefaces.saty +++ b/tests/math-typefaces.saty @@ -1,3 +1,9 @@ +#[dependencies [ + (`stdlib`, `0.0.1`), + (`math`, `0.0.1`), + (`itemize`, `0.0.1`), + (`std-ja-report`, `0.0.1`), +]] use package open Stdlib use package open Math use package open Itemize diff --git a/tests/math-typefaces.satysfi-lock b/tests/math-typefaces.satysfi-lock index e188d754e..35b53dee8 100644 --- a/tests/math-typefaces.satysfi-lock +++ b/tests/math-typefaces.satysfi-lock @@ -1,51 +1,46 @@ locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" - - - name: "math.0.0.1" - location: - type: "global" - path: "./dist/packages/math/math.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "itemize.0.0.1" - location: - type: "global" - path: "./dist/packages/itemize/itemize.0.0.1" - dependencies: - - "stdlib.0.0.1" - - - name: "std-ja-report.0.0.1" - location: - type: "global" - path: "./dist/packages/std-ja-report/std-ja-report.0.0.1" - dependencies: - - "stdlib.0.0.1" - - "math.0.0.1" - - "code.0.0.1" - - "annot.0.0.1" - - "footnote-scheme.0.0.1" - - - name: "annot.0.0.1" - location: - type: "global" - path: "./dist/packages/annot/annot.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "code.0.0.1" - location: - type: "global" - path: "./dist/packages/code/code.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "footnote-scheme.0.0.1" - location: - type: "global" - path: "./dist/packages/footnote-scheme/footnote-scheme.0.0.1/" - dependencies: - - "stdlib.0.0.1" +- name: annot.0.0.1 + location: + type: global + path: ./dist/packages/annot/annot.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: code.0.0.1 + location: + type: global + path: ./dist/packages/code/code.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: footnote-scheme.0.0.1 + location: + type: global + path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: itemize.0.0.1 + location: + type: global + path: ./dist/packages/itemize/itemize.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: math.0.0.1 + location: + type: global + path: ./dist/packages/math/math.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: std-ja-report.0.0.1 + location: + type: global + path: ./dist/packages/std-ja-report/std-ja-report.0.0.1/ + dependencies: + - stdlib.0.0.1 + - math.0.0.1 + - annot.0.0.1 + - code.0.0.1 + - footnote-scheme.0.0.1 +- name: stdlib.0.0.1 + location: + type: global + path: ./dist/packages/stdlib/stdlib.0.0.1/ + dependencies: [] diff --git a/tests/math2.saty b/tests/math2.saty index 0eedd1562..803c45e3f 100644 --- a/tests/math2.saty +++ b/tests/math2.saty @@ -1,3 +1,7 @@ +#[dependencies [ + (`stdlib`, `0.0.1`), + (`math`, `0.0.1`), +]] use package Math use Head of `head` diff --git a/tests/refactor1.saty b/tests/refactor1.saty index fe6bd6139..62d96b758 100644 --- a/tests/refactor1.saty +++ b/tests/refactor1.saty @@ -1,3 +1,7 @@ +#[dependencies [ + (`stdlib`, `0.0.1`), + (`math`, `0.0.1`), +]] use package open Stdlib use package open Math diff --git a/tests/refactor1.satysfi-lock b/tests/refactor1.satysfi-lock index 002661c22..460d82536 100644 --- a/tests/refactor1.satysfi-lock +++ b/tests/refactor1.satysfi-lock @@ -1,12 +1,12 @@ locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" - - - name: "math.0.0.1" - location: - type: "global" - path: "./dist/packages/math/math.0.0.1/" - dependencies: - - "stdlib.0.0.1" +- name: math.0.0.1 + location: + type: global + path: ./dist/packages/math/math.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: stdlib.0.0.1 + location: + type: global + path: ./dist/packages/stdlib/stdlib.0.0.1/ + dependencies: [] diff --git a/tests/staged1.saty b/tests/staged1.saty index 31a7ac382..5fab16846 100644 --- a/tests/staged1.saty +++ b/tests/staged1.saty @@ -1,3 +1,6 @@ +#[dependencies [ + (`std-ja`, `0.0.1`), +]] use package StdJa use Staged1Local of `staged1-local` diff --git a/tests/staged1.satysfi-lock b/tests/staged1.satysfi-lock index 7029ca2b4..5bd4d4d5f 100644 --- a/tests/staged1.satysfi-lock +++ b/tests/staged1.satysfi-lock @@ -1,36 +1,33 @@ locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" - - - name: "math.0.0.1" - location: - type: "global" - path: "./dist/packages/math/math.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "std-ja.0.0.1" - dependencies: - - "stdlib.0.0.1" - - "math.0.0.1" - - "annot.0.0.1" - - "code.0.0.1" - location: - type: "global" - path: "./dist/packages/std-ja/std-ja.0.0.1/" - - - name: "annot.0.0.1" - location: - type: "global" - path: "./dist/packages/annot/annot.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "code.0.0.1" - location: - type: "global" - path: "./dist/packages/code/code.0.0.1/" - dependencies: - - "stdlib.0.0.1" +- name: annot.0.0.1 + location: + type: global + path: ./dist/packages/annot/annot.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: code.0.0.1 + location: + type: global + path: ./dist/packages/code/code.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: math.0.0.1 + location: + type: global + path: ./dist/packages/math/math.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: std-ja.0.0.1 + location: + type: global + path: ./dist/packages/std-ja/std-ja.0.0.1/ + dependencies: + - stdlib.0.0.1 + - math.0.0.1 + - annot.0.0.1 + - code.0.0.1 +- name: stdlib.0.0.1 + location: + type: global + path: ./dist/packages/stdlib/stdlib.0.0.1/ + dependencies: [] From 58c111778b75ed59b5ec5f1ea01e14282ab6badb Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 9 Nov 2022 01:26:58 +0900 Subject: [PATCH 111/288] develop how to load registry configs --- src/frontend/configError.ml | 7 +++++ src/frontend/configUtil.ml | 24 +++++++++++++++++ src/frontend/lockConfig.ml | 18 ++++++------- src/frontend/main.ml | 34 ++++++++++++++++++++++- src/frontend/packageConfig.ml | 34 +++++------------------ src/frontend/packageRegistry.ml | 48 ++++++++++++++++++++++++++++++++- 6 files changed, 126 insertions(+), 39 deletions(-) create mode 100644 src/frontend/configUtil.ml diff --git a/src/frontend/configError.ml b/src/frontend/configError.ml index c6009517d..c2f85e4a1 100644 --- a/src/frontend/configError.ml +++ b/src/frontend/configError.ml @@ -15,6 +15,10 @@ type yaml_error = | UnexpectedTag of YamlDecoder.context * string | UnexpectedLanguage of string | NotASemanticVersion of YamlDecoder.context * string + | MultiplePackageDefinition of { + context : YamlDecoder.context; + package_name : string; + } module YamlError = struct type t = yaml_error @@ -44,6 +48,9 @@ type config_error = | PackageConfigError of abs_path * yaml_error | LockConfigNotFound of abs_path | LockConfigError of abs_path * yaml_error + | RegistryConfigNotFound of abs_path + | RegistryConfigNotFoundIn of lib_path * abs_path list + | RegistryConfigError of abs_path * yaml_error | LockNameConflict of lock_name | LockedPackageNotFound of lib_path * abs_path list | DependencyOnUnknownLock of { diff --git a/src/frontend/configUtil.ml b/src/frontend/configUtil.ml new file mode 100644 index 000000000..ccac02285 --- /dev/null +++ b/src/frontend/configUtil.ml @@ -0,0 +1,24 @@ + +open ConfigError +open PackageSystemBase + + +module ConfigDecoder = YamlDecoder.Make(YamlError) + + +let requirement_decoder : package_restriction ConfigDecoder.t = + let open ConfigDecoder in + string >>= fun s_version -> + match SemanticVersion.parse s_version with + | None -> failure (fun context -> NotASemanticVersion(context, s_version)) + | Some(semver) -> succeed @@ CompatibleWith(semver) + + +let dependency_decoder : package_dependency ConfigDecoder.t = + let open ConfigDecoder in + get "name" string >>= fun package_name -> + get "requirements" (list requirement_decoder) >>= fun restrictions -> + succeed @@ PackageDependency{ + package_name; + restrictions; + } diff --git a/src/frontend/lockConfig.ml b/src/frontend/lockConfig.ml index cf8cb0abc..b22b50c0b 100644 --- a/src/frontend/lockConfig.ml +++ b/src/frontend/lockConfig.ml @@ -2,6 +2,7 @@ open MyUtil open Types open ConfigError +open ConfigUtil type 'a ok = ('a, config_error) result @@ -25,11 +26,8 @@ type t = { } -module LockConfigDecoder = YamlDecoder.Make(YamlError) - - -let lock_location_decoder : lock_location LockConfigDecoder.t = - let open LockConfigDecoder in +let lock_location_decoder : lock_location ConfigDecoder.t = + let open ConfigDecoder in branch "type" [ "global" ==> begin get "path" string >>= fun s_libpath -> @@ -60,8 +58,8 @@ let lock_location_encoder (loc : lock_location) : Yaml.value = ]) -let lock_decoder : locked_package LockConfigDecoder.t = - let open LockConfigDecoder in +let lock_decoder : locked_package ConfigDecoder.t = + let open ConfigDecoder in get "name" string >>= fun lock_name -> get "location" lock_location_decoder >>= fun lock_location -> get_or_else "dependencies" (list string) [] >>= fun lock_dependencies -> @@ -80,8 +78,8 @@ let lock_encoder (lock : locked_package) : Yaml.value = ]) -let lock_config_decoder : t LockConfigDecoder.t = - let open LockConfigDecoder in +let lock_config_decoder : t ConfigDecoder.t = + let open ConfigDecoder in get_or_else "locks" (list lock_decoder) [] >>= fun locked_packages -> succeed { locked_packages; @@ -104,7 +102,7 @@ let load (abspath_lock_config : abs_path) : t ok = in let s = Core.In_channel.input_all inc in close_in inc; - LockConfigDecoder.run lock_config_decoder s + ConfigDecoder.run lock_config_decoder s |> Result.map_error (fun e -> LockConfigError(abspath_lock_config, e)) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 968b16e93..483456eb5 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -817,6 +817,9 @@ let make_yaml_error_lines : yaml_error -> line list = function | NotASemanticVersion(yctx, s) -> [ NormalLine(Printf.sprintf "not a semantic version: '%s'%s" s (show_yaml_context yctx)) ] + | MultiplePackageDefinition{ context = yctx; package_name } -> + [ NormalLine(Printf.sprintf "More than one definition for package '%s'%s" package_name (show_yaml_context yctx)) ] + let report_document_attribute_error : DocumentAttribute.error -> unit = function | MoreThanOneDependencyAttribute(rng1, rng2) -> @@ -969,6 +972,29 @@ let report_config_error : config_error -> unit = function make_yaml_error_lines e; ]) + | RegistryConfigNotFound(abspath) -> + report_error Interface [ + NormalLine("cannot find a registry config at:"); + DisplayLine(get_abs_path_string abspath); + ] + + | RegistryConfigNotFoundIn(libpath, candidates) -> + let lines = + candidates |> List.map (fun abspath -> + DisplayLine(Printf.sprintf "- %s" (get_abs_path_string abspath)) + ) + in + report_error Interface (List.concat [ + [ NormalLine(Printf.sprintf "cannot find a registry config '%s'. candidates:" (get_lib_path_string libpath)) ]; + lines; + ]) + + | RegistryConfigError(abspath, e) -> + report_error Interface (List.concat [ + [ NormalLine(Printf.sprintf "in %s: registry config error;" (get_abs_path_string abspath)) ]; + make_yaml_error_lines e; + ]) + | LockNameConflict(lock_name) -> report_error Interface [ NormalLine(Printf.sprintf "lock name conflict: '%s'" lock_name); @@ -1573,8 +1599,14 @@ let solve lock = abspath_lock_config; } in + let res = let open ResultMonad in + let* abspath_registry_config = + let libpath = make_lib_path "dist/package/cache/registry.yaml" in + Config.resolve_lib_file libpath + |> Result.map_error (fun candidates -> RegistryConfigNotFoundIn(libpath, candidates)) + in let* (dependencies, abspath_lock_config) = match solve_input with | PackageSolveInput{ @@ -1598,7 +1630,7 @@ let solve Logging.show_package_dependency_before_solving dependencies; - let* package_context = PackageRegistry.load_cache () in + let* package_context = PackageRegistry.load abspath_registry_config in let solutions_opt = PackageConstraintSolver.solve package_context dependencies in begin match solutions_opt with diff --git a/src/frontend/packageConfig.ml b/src/frontend/packageConfig.ml index 4290e92b1..fa48585e2 100644 --- a/src/frontend/packageConfig.ml +++ b/src/frontend/packageConfig.ml @@ -2,6 +2,7 @@ open MyUtil open Types open ConfigError +open ConfigUtil open PackageSystemBase @@ -21,29 +22,8 @@ type t = { } -module PackageConfigDecoder = YamlDecoder.Make(YamlError) - - -let requirement_decoder : package_restriction PackageConfigDecoder.t = - let open PackageConfigDecoder in - string >>= fun s_version -> - match SemanticVersion.parse s_version with - | None -> failure (fun context -> NotASemanticVersion(context, s_version)) - | Some(semver) -> succeed @@ CompatibleWith(semver) - - -let dependency_decoder : package_dependency PackageConfigDecoder.t = - let open PackageConfigDecoder in - get "name" string >>= fun package_name -> - get "requirements" (list requirement_decoder) >>= fun restrictions -> - succeed @@ PackageDependency{ - package_name; - restrictions; - } - - -let contents_decoder : package_contents PackageConfigDecoder.t = - let open PackageConfigDecoder in +let contents_decoder : package_contents ConfigDecoder.t = + let open ConfigDecoder in branch "type" [ "library" ==> begin get "main_module" string >>= fun main_module_name -> @@ -61,8 +41,8 @@ let contents_decoder : package_contents PackageConfigDecoder.t = ) -let version_0_1_config_decoder : t PackageConfigDecoder.t = - let open PackageConfigDecoder in +let version_0_1_config_decoder : t ConfigDecoder.t = + let open ConfigDecoder in get "contents" contents_decoder >>= fun package_contents -> succeed @@ { package_contents; @@ -70,7 +50,7 @@ let version_0_1_config_decoder : t PackageConfigDecoder.t = let config_decoder = - let open PackageConfigDecoder in + let open ConfigDecoder in get "language" string >>= fun language -> match language with | "0.1.0" -> version_0_1_config_decoder @@ -90,5 +70,5 @@ let load (absdir_package : abs_path) : t ok = in let s = Core.In_channel.input_all inc in close_in inc; - PackageConfigDecoder.run config_decoder s + ConfigDecoder.run config_decoder s |> Result.map_error (fun e -> PackageConfigError(abspath_config, e)) diff --git a/src/frontend/packageRegistry.ml b/src/frontend/packageRegistry.ml index 413ba0422..20e0b1413 100644 --- a/src/frontend/packageRegistry.ml +++ b/src/frontend/packageRegistry.ml @@ -1,12 +1,46 @@ open MyUtil open ConfigError +open ConfigUtil open PackageSystemBase type 'a ok = ('a, config_error) result +let implementation_decoder : implementation_record ConfigDecoder.t = + let open ConfigDecoder in + get "version" string >>= fun s_version -> + get "dependencies" (list dependency_decoder) >>= fun dependencies -> + match SemanticVersion.parse s_version with + | None -> + failure @@ (fun yctx -> NotASemanticVersion(yctx, s_version)) + + | Some(semver) -> + succeed { version = semver; requires = dependencies } + + +let package_decoder : (package_name * implementation_record list) ConfigDecoder.t = + let open ConfigDecoder in + get "name" string >>= fun package_name -> + get "implementations" (list implementation_decoder) >>= fun impls -> + succeed (package_name, impls) + + +let registry_config_decoder : package_context ConfigDecoder.t = + let open ConfigDecoder in + get "packages" (list package_decoder) >>= fun packages -> + packages |> List.fold_left (fun res (package_name, impls) -> + res >>= fun map -> + if map |> PackageNameMap.mem package_name then + failure (fun yctx -> MultiplePackageDefinition{ context = yctx; package_name }) + else + succeed (map |> PackageNameMap.add package_name impls) + ) (succeed PackageNameMap.empty) >>= fun registry_contents -> + succeed { registry_contents } + + + let ( !@ ) s = match SemanticVersion.parse s with | None -> assert false @@ -20,9 +54,20 @@ let dependency package_name semver = } -let load_cache () : package_context ok = +let load (abspath_registry_config : abs_path) : package_context ok = let open ResultMonad in (* TODO: load this from a cache file *) + let* inc = + try + return (open_in_abs abspath_registry_config) + with + | Sys_error(_) -> err (RegistryConfigNotFound(abspath_registry_config)) + in + let s = Core.In_channel.input_all inc in + close_in inc; + ConfigDecoder.run registry_config_decoder s + |> Result.map_error (fun e -> RegistryConfigError(abspath_registry_config, e)) +(* let registry_contents = List.fold_left (fun map (package_name, impls) -> map |> PackageNameMap.add package_name impls @@ -113,3 +158,4 @@ let load_cache () : package_context ok = ] in return { registry_contents } +*) From ac610ba42f86e0d1e9806ab486aee8bdc36adba4 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 9 Nov 2022 01:47:32 +0900 Subject: [PATCH 112/288] introduce 'dist/cache/registry.yaml' --- bin/satysfi.ml | 9 +++ install-libs.sh | 2 + lib-satysfi/dist/cache/registry.yaml | 87 ++++++++++++++++++++++ src/frontend/main.ml | 17 +++-- src/frontend/main.mli | 3 + src/frontend/packageRegistry.ml | 106 --------------------------- 6 files changed, 112 insertions(+), 112 deletions(-) create mode 100644 lib-satysfi/dist/cache/registry.yaml diff --git a/bin/satysfi.ml b/bin/satysfi.ml index d897610dd..dba03614d 100644 --- a/bin/satysfi.ml +++ b/bin/satysfi.ml @@ -42,9 +42,15 @@ let build let solve fpath_in + show_full_path + config_paths_str_opt + no_default_config = Main.solve ~fpath_in + ~show_full_path + ~config_paths_str_opt + ~no_default_config let arg_in : string Cmdliner.Term.t = @@ -180,6 +186,9 @@ let command_solve = let term : unit Term.t = Term.(const solve $ arg_in + $ flag_full_path + $ flag_config + $ flag_no_default_config ) in let info : Cmd.info = diff --git a/install-libs.sh b/install-libs.sh index 25e19cbf8..d895ecf24 100755 --- a/install-libs.sh +++ b/install-libs.sh @@ -17,3 +17,5 @@ INSTALL=${2:-install} (cd lib-satysfi && find dist/packages -type f -exec "${INSTALL}" -Dm 644 "{}" "${LIBDIR}/{}" \;) "${INSTALL}" -d "${LIBDIR}/dist/md" "${INSTALL}" -m 644 lib-satysfi/dist/md/* "${LIBDIR}/dist/md" +"${INSTALL}" -d "${LIBDIR}/dist/cache" +"${INSTALL}" -m 644 lib-satysfi/dist/cache/* "${LIBDIR}/dist/cache" diff --git a/lib-satysfi/dist/cache/registry.yaml b/lib-satysfi/dist/cache/registry.yaml new file mode 100644 index 000000000..2d39b28d5 --- /dev/null +++ b/lib-satysfi/dist/cache/registry.yaml @@ -0,0 +1,87 @@ +packages: +- name: "stdlib" + implementations: + - version: "0.0.1" + dependencies: [] +- name: "math" + implementations: + - version: "0.0.1" + dependencies: + - name: "stdlib" + requirements: [ "0.0.1" ] +- name: "code" + implementations: + - version: "0.0.1" + dependencies: + - name: "stdlib" + requirements: [ "0.0.1" ] +- name: "annot" + implementations: + - version: "0.0.1" + dependencies: + - name: "stdlib" + requirements: [ "0.0.1" ] +- name: "itemize" + implementations: + - version: "0.0.1" + dependencies: + - name: "stdlib" + requirements: [ "0.0.1" ] +- name: "proof" + implementations: + - version: "0.0.1" + dependencies: + - name: "stdlib" + requirements: [ "0.0.1" ] +- name: "tabular" + implementations: + - version: "0.0.1" + dependencies: + - name: "stdlib" + requirements: [ "0.0.1" ] +- name: "footnote-scheme" + implementations: + - version: "0.0.1" + dependencies: + - name: "stdlib" + requirements: [ "0.0.1" ] +- name: "std-ja" + implementations: + - version: "0.0.1" + dependencies: + - name: "stdlib" + requirements: [ "0.0.1" ] + - name: "math" + requirements: [ "0.0.1" ] + - name: "annot" + requirements: [ "0.0.1" ] + - name: "code" + requirements: [ "0.0.1" ] +- name: "std-ja-book" + implementations: + - version: "0.0.1" + dependencies: + - name: "stdlib" + requirements: [ "0.0.1" ] + - name: "math" + requirements: [ "0.0.1" ] + - name: "annot" + requirements: [ "0.0.1" ] + - name: "code" + requirements: [ "0.0.1" ] + - name: "footnote-scheme" + requirements: [ "0.0.1" ] +- name: "std-ja-report" + implementations: + - version: "0.0.1" + dependencies: + - name: "stdlib" + requirements: [ "0.0.1" ] + - name: "math" + requirements: [ "0.0.1" ] + - name: "annot" + requirements: [ "0.0.1" ] + - name: "code" + requirements: [ "0.0.1" ] + - name: "footnote-scheme" + requirements: [ "0.0.1" ] diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 483456eb5..62e6146dc 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1567,20 +1567,25 @@ let extract_attributes_from_document_file (abspath_in : abs_path) : (DocumentAtt let solve ~(fpath_in : string) + ~(show_full_path : bool) + ~(config_paths_str_opt : string option) + ~(no_default_config : bool) = error_log_environment (fun () -> let curdir = Sys.getcwd () in - (* TODO: add options *) + let extra_config_paths = config_paths_str_opt |> Option.map (String.split_on_char ':') in + OptionState.set OptionState.{ command_state = SolveState; - extra_config_paths = None; - show_full_path = false; + extra_config_paths; + show_full_path; show_fonts = false; - no_default_config = false; + no_default_config; }; - setup_root_dirs ~no_default_config:false ~extra_config_paths:None curdir; + setup_root_dirs ~no_default_config ~extra_config_paths curdir; + let abspath_in = make_absolute_if_relative ~origin:curdir fpath_in in let solve_input = let abspathstr_in = get_abs_path_string abspath_in in @@ -1603,7 +1608,7 @@ let solve let res = let open ResultMonad in let* abspath_registry_config = - let libpath = make_lib_path "dist/package/cache/registry.yaml" in + let libpath = make_lib_path "dist/cache/registry.yaml" in Config.resolve_lib_file libpath |> Result.map_error (fun candidates -> RegistryConfigNotFoundIn(libpath, candidates)) in diff --git a/src/frontend/main.mli b/src/frontend/main.mli index 36cc6a8d2..5ccdfea2d 100644 --- a/src/frontend/main.mli +++ b/src/frontend/main.mli @@ -20,4 +20,7 @@ val build : val solve : fpath_in:string -> + show_full_path:bool -> + config_paths_str_opt:(string option) -> + no_default_config:bool -> unit diff --git a/src/frontend/packageRegistry.ml b/src/frontend/packageRegistry.ml index 20e0b1413..2d9b9ab0b 100644 --- a/src/frontend/packageRegistry.ml +++ b/src/frontend/packageRegistry.ml @@ -40,20 +40,6 @@ let registry_config_decoder : package_context ConfigDecoder.t = succeed { registry_contents } - -let ( !@ ) s = - match SemanticVersion.parse s with - | None -> assert false - | Some(semver) -> semver - - -let dependency package_name semver = - PackageDependency{ - package_name; - restrictions = [ CompatibleWith(semver) ]; - } - - let load (abspath_registry_config : abs_path) : package_context ok = let open ResultMonad in (* TODO: load this from a cache file *) @@ -67,95 +53,3 @@ let load (abspath_registry_config : abs_path) : package_context ok = close_in inc; ConfigDecoder.run registry_config_decoder s |> Result.map_error (fun e -> RegistryConfigError(abspath_registry_config, e)) -(* - let registry_contents = - List.fold_left (fun map (package_name, impls) -> - map |> PackageNameMap.add package_name impls - ) PackageNameMap.empty [ - ("stdlib", [ - { - version = !@ "0.0.1"; - requires = []; - }; - ]); - ("math", [ - { - version = !@ "0.0.1"; - requires = [ dependency "stdlib" (!@ "0.0.1") ]; - }; - ]); - ("code", [ - { - version = !@ "0.0.1"; - requires = [ dependency "stdlib" (!@ "0.0.1") ]; - }; - ]); - ("annot", [ - { - version = !@ "0.0.1"; - requires = [ dependency "stdlib" (!@ "0.0.1") ]; - }; - ]); - ("itemize", [ - { - version = !@ "0.0.1"; - requires = [ dependency "stdlib" (!@ "0.0.1") ]; - }; - ]); - ("proof", [ - { - version = !@ "0.0.1"; - requires = [ dependency "stdlib" (!@ "0.0.1") ]; - }; - ]); - ("tabular", [ - { - version = !@ "0.0.1"; - requires = [ dependency "stdlib" (!@ "0.0.1") ]; - }; - ]); - ("footnote-scheme", [ - { - version = !@ "0.0.1"; - requires = [ dependency "stdlib" (!@ "0.0.1") ]; - }; - ]); - ("std-ja", [ - { - version = !@ "0.0.1"; - requires = [ - dependency "stdlib" (!@ "0.0.1"); - dependency "math" (!@ "0.0.1"); - dependency "annot" (!@ "0.0.1"); - dependency "code" (!@ "0.0.1"); - ]; - }; - ]); - ("std-ja-book", [ - { - version = !@ "0.0.1"; - requires = [ - dependency "stdlib" (!@ "0.0.1"); - dependency "math" (!@ "0.0.1"); - dependency "annot" (!@ "0.0.1"); - dependency "code" (!@ "0.0.1"); - dependency "footnote-scheme" (!@ "0.0.1"); - ]; - }; - ]); - ("std-ja-report", [ - { - version = !@ "0.0.1"; - requires = [ - dependency "stdlib" (!@ "0.0.1"); - dependency "math" (!@ "0.0.1"); - dependency "annot" (!@ "0.0.1"); - dependency "code" (!@ "0.0.1"); - dependency "footnote-scheme" (!@ "0.0.1"); - ]; - }; - ]); - ] - in - return { registry_contents } -*) From 13e9849a34b1cdaa113ec2857861838e9bb13ffb Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 11 Nov 2022 09:01:56 +0900 Subject: [PATCH 113/288] refactor how to read files --- src/backend/fontFormat.ml | 4 +- src/frontend/lockConfig.ml | 10 +--- src/frontend/openFileDependencyResolver.ml | 2 +- src/frontend/packageConfig.ml | 10 +--- src/frontend/packageRegistry.ml | 11 +--- src/myUtil.ml | 65 +++------------------- src/myUtil.mli | 4 +- 7 files changed, 23 insertions(+), 83 deletions(-) diff --git a/src/backend/fontFormat.ml b/src/backend/fontFormat.ml index a2569ea0a..b7e7accd7 100644 --- a/src/backend/fontFormat.ml +++ b/src/backend/fontFormat.ml @@ -71,7 +71,7 @@ let extract_registration (d : D.source) = let get_main_decoder_single (abspath : abs_path) : ((D.source * font_registration) option) ok = - match string_of_file abspath with + match read_file abspath with | Ok(s) -> let open ResultMonad in begin @@ -89,7 +89,7 @@ let get_main_decoder_single (abspath : abs_path) : ((D.source * font_registratio let get_main_decoder_ttc (abspath : abs_path) (i : int) : ((D.source * font_registration) option) ok = - match string_of_file abspath with + match read_file abspath with | Ok(s) -> let open ResultMonad in begin diff --git a/src/frontend/lockConfig.ml b/src/frontend/lockConfig.ml index b22b50c0b..706cf99cc 100644 --- a/src/frontend/lockConfig.ml +++ b/src/frontend/lockConfig.ml @@ -94,14 +94,10 @@ let lock_config_encoder (lock_config : t) : Yaml.value = let load (abspath_lock_config : abs_path) : t ok = let open ResultMonad in - let* inc = - try - return (open_in_abs abspath_lock_config) - with - | Sys_error(_) -> err (LockConfigNotFound(abspath_lock_config)) + let* s = + read_file abspath_lock_config + |> Result.map_error (fun _ -> LockConfigNotFound(abspath_lock_config)) in - let s = Core.In_channel.input_all inc in - close_in inc; ConfigDecoder.run lock_config_decoder s |> Result.map_error (fun e -> LockConfigError(abspath_lock_config, e)) diff --git a/src/frontend/openFileDependencyResolver.ml b/src/frontend/openFileDependencyResolver.ml index 83195aa5b..3d81e7843 100644 --- a/src/frontend/openFileDependencyResolver.ml +++ b/src/frontend/openFileDependencyResolver.ml @@ -116,7 +116,7 @@ let register_markdown_file (setting : string) (abspath_in : abs_path) : (Package in let (cmdrcd, depends) = LoadMDSetting.main abspath in (* TODO: make this monadic *) let* utast = - match MyUtil.string_of_file abspath_in with + match read_file abspath_in with | Ok(data) -> return (DecodeMD.decode cmdrcd data) | Error(msg) -> err (CannotReadFileOwingToSystem(msg)) in diff --git a/src/frontend/packageConfig.ml b/src/frontend/packageConfig.ml index fa48585e2..c39d22a84 100644 --- a/src/frontend/packageConfig.ml +++ b/src/frontend/packageConfig.ml @@ -62,13 +62,9 @@ let load (absdir_package : abs_path) : t ok = let abspath_config = make_abs_path (Filename.concat (get_abs_path_string absdir_package) "satysfi.yaml") in - let* inc = - try - return (open_in_abs abspath_config) - with - | Sys_error(_) -> err (PackageConfigNotFound(abspath_config)) + let* s = + read_file abspath_config + |> Result.map_error (fun _ -> PackageConfigNotFound(abspath_config)) in - let s = Core.In_channel.input_all inc in - close_in inc; ConfigDecoder.run config_decoder s |> Result.map_error (fun e -> PackageConfigError(abspath_config, e)) diff --git a/src/frontend/packageRegistry.ml b/src/frontend/packageRegistry.ml index 2d9b9ab0b..84e920570 100644 --- a/src/frontend/packageRegistry.ml +++ b/src/frontend/packageRegistry.ml @@ -42,14 +42,9 @@ let registry_config_decoder : package_context ConfigDecoder.t = let load (abspath_registry_config : abs_path) : package_context ok = let open ResultMonad in - (* TODO: load this from a cache file *) - let* inc = - try - return (open_in_abs abspath_registry_config) - with - | Sys_error(_) -> err (RegistryConfigNotFound(abspath_registry_config)) + let* s = + read_file abspath_registry_config + |> Result.map_error (fun _ -> RegistryConfigNotFound(abspath_registry_config)) in - let s = Core.In_channel.input_all inc in - close_in inc; ConfigDecoder.run registry_config_decoder s |> Result.map_error (fun e -> RegistryConfigError(abspath_registry_config, e)) diff --git a/src/myUtil.ml b/src/myUtil.ml index 4bc804e13..1e1103dc3 100644 --- a/src/myUtil.ml +++ b/src/myUtil.ml @@ -190,62 +190,6 @@ let basename_abs (AbsPath(pathstr)) = Filename.basename pathstr -let string_of_file (abspath : abs_path) : (string, string) result = - try - let ic = open_in_bin_abs abspath in - let bufsize = 65536 in - let stepsize = 65536 in - let buf = Buffer.create bufsize in - let bytes = Bytes.create stepsize in - let flag = ref true in - try - while !flag do - let c = input ic bytes 0 bufsize in - if c = 0 then - flag := false - else - Buffer.add_subbytes buf bytes 0 c - done; - close_in ic; - let s = Buffer.contents buf in - Ok(s) - with - | Failure(_) -> close_in ic; assert false - with - | Sys_error(msg) -> Error(msg) - -(* -let string_of_file (srcpath : file_path) : string = - let bufsize = 65536 in (* arbitrary constant; the initial size of the buffer for loading font format file *) - let buf : Buffer.t = Buffer.create bufsize in - let byt : bytes = Bytes.create bufsize in - let ic = - try - open_in_bin srcpath - with - | Sys_error(msg) -> raise (FailToLoadFontOwingToSystem(srcpath, msg)) - in - - let rec aux () = - let c = input ic byt 0 bufsize in - if c = 0 then - begin - close_in ic; - Buffer.contents buf - end - else - begin - Buffer.add_subbytes buf byt 0 c; - aux () - end - in - try - aux () - with - | Failure(_) -> begin close_in ic; raise (FailToLoadFontOwingToSize(srcpath)) end - | Sys_error(msg) -> begin close_in ic; raise (FailToLoadFontOwingToSystem(srcpath, msg)) end -*) - let make_abs_path pathstr = AbsPath(pathstr) let make_lib_path pathstr = LibPath(pathstr) @@ -262,3 +206,12 @@ module AbsPath = struct let compare ap1 ap2 = String.compare (get_abs_path_string ap1) (get_abs_path_string ap2) end + + +let read_file (abspath : abs_path) : (string, string) result = + let open ResultMonad in + try + return @@ Core.In_channel.read_all (get_abs_path_string abspath) + with + | Sys_error(s) -> + err s diff --git a/src/myUtil.mli b/src/myUtil.mli index 55ac3c470..e8a380d96 100644 --- a/src/myUtil.mli +++ b/src/myUtil.mli @@ -68,8 +68,6 @@ val dirname_abs : abs_path -> string val basename_abs : abs_path -> string -val string_of_file : abs_path -> (string, string) result - val make_abs_path : string -> abs_path val make_lib_path : string -> lib_path @@ -85,3 +83,5 @@ module AbsPath : sig val compare : t -> t -> int end + +val read_file : abs_path -> (string, string) result From 89d242c9dba868aa4f476c887f52d63bf5fe12eb Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 11 Nov 2022 09:20:58 +0900 Subject: [PATCH 114/288] refactor Uchar-handling functions --- src/backend/horzBox.ml | 2 +- src/frontend/primitives.cppo.ml | 19 ++++++++++++++++++- src/myUtil.ml | 24 ++++-------------------- src/myUtil.mli | 10 +--------- 4 files changed, 24 insertions(+), 31 deletions(-) diff --git a/src/backend/horzBox.ml b/src/backend/horzBox.ml index 562593712..88dacace9 100644 --- a/src/backend/horzBox.ml +++ b/src/backend/horzBox.ml @@ -599,7 +599,7 @@ let get_metrics_of_intermediate_horz_box_list (imhblst : intermediate_horz_box l let rec extract_string (hblst : horz_box list) : string = let extract_one hb = match hb with - | HorzPure(PHCInnerString{ chars = uchs; _ }) -> string_of_uchlst uchs + | HorzPure(PHCInnerString{ chars = uchs; _ }) -> string_of_uchar_list uchs | HorzPure(PHCInnerMathGlyph(_)) -> "" | HorzPure(PHGRising{ contents = hbs; _ }) -> extract_string hbs | HorzPure(PHGFixedFrame{ contents = hbs; _ }) -> extract_string hbs diff --git a/src/frontend/primitives.cppo.ml b/src/frontend/primitives.cppo.ml index b4a005836..5e5f6d402 100644 --- a/src/frontend/primitives.cppo.ml +++ b/src/frontend/primitives.cppo.ml @@ -402,7 +402,24 @@ let default_radical hgt_bar t_bar dpt fontsize color = [ HorzPure(PHGFixedGraphics{ width = wid; height = hgt_bar +% t_bar; depth = nonnegdpt; graphics }) ] -let code_point cp = Uchar.of_int cp +let code_point = + Uchar.of_int + + +let uchar_of_char = + Core.Uchar.of_char + + +let ascii_capital_of_index (i : int) : Uchar.t = + Uchar.of_int ((Char.code 'A') + i) + + +let ascii_small_of_index (i : int) : Uchar.t = + Uchar.of_int ((Char.code 'a') + i) + + +let ascii_digit_of_index (i : int) : Uchar.t = + Uchar.of_int ((Char.code '0') + i) let default_math_variant_char_map : HorzBox.math_variant_char_map = diff --git a/src/myUtil.ml b/src/myUtil.ml index 1e1103dc3..035477123 100644 --- a/src/myUtil.ml +++ b/src/myUtil.ml @@ -11,26 +11,10 @@ let remains_to_be_implemented msg = raise (RemainsToBeImplemented(msg)) -let uchar_of_char ch = - Uchar.of_int (Char.code ch) - - -let ascii_capital_of_index i = - Uchar.of_int ((Char.code 'A') + i) - - -let ascii_small_of_index i = - Uchar.of_int ((Char.code 'a') + i) - - -let ascii_digit_of_index i = - Uchar.of_int ((Char.code '0') + i) - - -let string_of_uchlst uchlst = - let buffer = Buffer.create ((List.length uchlst) * 4) in - List.iter (fun u -> Uutf.Buffer.add_utf_8 buffer u) uchlst; - Buffer.contents buffer +let string_of_uchar_list (uchs : Uchar.t list) : string = + let buffer = Buffer.create ((List.length uchs) * 4) in + List.iter (fun u -> Uutf.Buffer.add_utf_8 buffer u) uchs; + Buffer.contents buffer let rec range i j = diff --git a/src/myUtil.mli b/src/myUtil.mli index e8a380d96..07edc31e9 100644 --- a/src/myUtil.mli +++ b/src/myUtil.mli @@ -8,15 +8,7 @@ type lib_path val remains_to_be_implemented : string -> 'a -val uchar_of_char : char -> Uchar.t - -val ascii_capital_of_index : int -> Uchar.t - -val ascii_small_of_index : int -> Uchar.t - -val ascii_digit_of_index : int -> Uchar.t - -val string_of_uchlst : Uchar.t list -> string +val string_of_uchar_list : Uchar.t list -> string val range : int -> int -> int list From 48f5ddaa4ccdbb962cd386afcdf89a8c63e13ac5 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 11 Nov 2022 09:26:26 +0900 Subject: [PATCH 115/288] replace 'MyUtil.list_make' with 'List.init' --- src/backend/tabular.ml | 6 +++--- src/myUtil.ml | 8 -------- src/myUtil.mli | 2 -- 3 files changed, 3 insertions(+), 13 deletions(-) diff --git a/src/backend/tabular.ml b/src/backend/tabular.ml index f06822a28..9b5d52608 100644 --- a/src/backend/tabular.ml +++ b/src/backend/tabular.ml @@ -192,7 +192,7 @@ let normalize_tabular (tabular : row list) : int * row list = in let htabular = tabular |> List.fold_left (fun acc row -> - let empties = list_make (ncols - (List.length row)) EmptyCell in + let empties = List.init (ncols - (List.length row)) (fun _ -> EmptyCell) in Alist.extend acc (List.append row empties) ) Alist.empty |> Alist.to_list in @@ -320,7 +320,7 @@ let main (tabular : row list) : intermediate_row list * length list * length lis *) let (rest, hgt, dpt) = determine_row_metrics restprev row in (rest, Alist.extend vmetracc (hgt, dpt)) - ) (list_make ncols None, Alist.empty) + ) (List.init ncols (fun _ -> None), Alist.empty) in let vmetrlst = Alist.to_list vmetracc in @@ -331,7 +331,7 @@ let main (tabular : row list) : intermediate_row list * length list * length lis *) let (rest, wid) = determine_column_width restprev col in (rest, Alist.extend widacc wid) - ) (list_make nrows None, Alist.empty) + ) (List.init nrows (fun _ -> None), Alist.empty) in let widlst = Alist.to_list widacc in diff --git a/src/myUtil.ml b/src/myUtil.ml index 035477123..ca2767669 100644 --- a/src/myUtil.ml +++ b/src/myUtil.ml @@ -22,14 +22,6 @@ let rec range i j = i :: (range (i + 1) j) -let list_make n c = - let rec aux acc n = - if n <= 0 then List.rev acc else - aux (c :: acc) (n - 1) - in - aux [] n - - let list_fold_left_index f init lst = let (_, ret) = lst |> List.fold_left (fun (i, acc) x -> (i + 1, f i acc x)) (0, init) diff --git a/src/myUtil.mli b/src/myUtil.mli index 07edc31e9..8ca4f0817 100644 --- a/src/myUtil.mli +++ b/src/myUtil.mli @@ -12,8 +12,6 @@ val string_of_uchar_list : Uchar.t list -> string val range : int -> int -> int list -val list_make : int -> 'a -> 'a list - val list_fold_left_index : (int -> 'a -> 'b -> 'a) -> 'a -> 'b list -> 'a val list_some : ('a option) list -> 'a list From b11a8665759829e94c3a48745a6bf8c2646fd2be Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 11 Nov 2022 09:28:24 +0900 Subject: [PATCH 116/288] remove 'MyUtil.list_some', which was unused --- src/myUtil.ml | 11 ----------- src/myUtil.mli | 2 -- 2 files changed, 13 deletions(-) diff --git a/src/myUtil.ml b/src/myUtil.ml index ca2767669..097676087 100644 --- a/src/myUtil.ml +++ b/src/myUtil.ml @@ -29,17 +29,6 @@ let list_fold_left_index f init lst = ret -let list_some lst = - let accres = - lst |> List.fold_left (fun acc opt -> - match opt with - | None -> acc - | Some(p) -> p :: acc - ) [] - in - List.rev accres - - let list_fold_adjacent f init lst = let rec aux leftopt init lst = match lst with diff --git a/src/myUtil.mli b/src/myUtil.mli index 8ca4f0817..dfc715838 100644 --- a/src/myUtil.mli +++ b/src/myUtil.mli @@ -14,8 +14,6 @@ val range : int -> int -> int list val list_fold_left_index : (int -> 'a -> 'b -> 'a) -> 'a -> 'b list -> 'a -val list_some : ('a option) list -> 'a list - val list_fold_adjacent : ('a -> 'b -> 'b option -> 'b option -> 'a) -> 'a -> 'b list -> 'a val pickup : 'a list -> ('a -> bool) -> 'b -> ('a, 'b) result From 65833b10976b5019d27579a1312a4ba7b8d3fc74 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 11 Nov 2022 09:36:46 +0900 Subject: [PATCH 117/288] replace 'MyUtil.list_fold_left_index' with 'Core.List.foldi' --- src/backend/tabular.ml | 9 ++++----- src/myUtil.ml | 7 ------- src/myUtil.mli | 2 -- 3 files changed, 4 insertions(+), 14 deletions(-) diff --git a/src/backend/tabular.ml b/src/backend/tabular.ml index 9b5d52608..7bc158b3d 100644 --- a/src/backend/tabular.ml +++ b/src/backend/tabular.ml @@ -1,5 +1,4 @@ -open MyUtil open LengthInterface open HorzBox @@ -248,10 +247,10 @@ let multi_cell_vertical vmetrarr indexR nr = let solidify_tabular (vmetrlst : (length * length) list) (widlst : length list) (htabular : row list) : intermediate_row list = let vmetrarr = Array.of_list vmetrlst in let widarr = Array.of_list widlst in - htabular |> list_fold_left_index (fun indexR evrowacc row -> + htabular |> Core.List.foldi ~f:(fun indexR evrowacc row -> let (hgtnmlcell, dptnmlcell) = access vmetrarr indexR in let evrow = - row |> list_fold_left_index (fun indexC evcellacc cell -> + row |> Core.List.foldi ~f:(fun indexC evcellacc cell -> let evcell = match cell with | EmptyCell -> @@ -299,11 +298,11 @@ let solidify_tabular (vmetrlst : (length * length) list) (widlst : length list) ImMultiCell(ratios, (nr, nc, widsingle, widmulti, hgtcell, dptcell), imhbs) in Alist.extend evcellacc evcell - ) Alist.empty |> Alist.to_list + ) ~init:Alist.empty |> Alist.to_list in let vlen = hgtnmlcell +% (Length.negate dptnmlcell) in Alist.extend evrowacc (vlen, evrow) - ) Alist.empty |> Alist.to_list + ) ~init:Alist.empty |> Alist.to_list let main (tabular : row list) : intermediate_row list * length list * length list * length * length * length = diff --git a/src/myUtil.ml b/src/myUtil.ml index 097676087..24e0eaaf7 100644 --- a/src/myUtil.ml +++ b/src/myUtil.ml @@ -22,13 +22,6 @@ let rec range i j = i :: (range (i + 1) j) -let list_fold_left_index f init lst = - let (_, ret) = - lst |> List.fold_left (fun (i, acc) x -> (i + 1, f i acc x)) (0, init) - in - ret - - let list_fold_adjacent f init lst = let rec aux leftopt init lst = match lst with diff --git a/src/myUtil.mli b/src/myUtil.mli index dfc715838..11075c236 100644 --- a/src/myUtil.mli +++ b/src/myUtil.mli @@ -12,8 +12,6 @@ val string_of_uchar_list : Uchar.t list -> string val range : int -> int -> int list -val list_fold_left_index : (int -> 'a -> 'b -> 'a) -> 'a -> 'b list -> 'a - val list_fold_adjacent : ('a -> 'b -> 'b option -> 'b option -> 'a) -> 'a -> 'b list -> 'a val pickup : 'a list -> ('a -> bool) -> 'b -> ('a, 'b) result From 480924cf83da82ed0670bc368647ebf4acd7eea5 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 11 Nov 2022 09:43:11 +0900 Subject: [PATCH 118/288] migrate 'pickup' --- src/backend/fontFormat.ml | 7 +++++++ src/myUtil.ml | 6 ------ src/myUtil.mli | 2 -- 3 files changed, 7 insertions(+), 8 deletions(-) diff --git a/src/backend/fontFormat.ml b/src/backend/fontFormat.ml index b7e7accd7..04ebc95df 100644 --- a/src/backend/fontFormat.ml +++ b/src/backend/fontFormat.ml @@ -27,6 +27,13 @@ let broken srcpath oerr s = raise (BrokenFont(srcpath, msg ^ "; " ^ s)) +let pickup xs predicate e = + let open ResultMonad in + match xs |> List.filter predicate with + | head :: _ -> return head + | [] -> err e + + type cid_system_info = { registry : string; ordering : string; diff --git a/src/myUtil.ml b/src/myUtil.ml index 24e0eaaf7..12f34ec5f 100644 --- a/src/myUtil.ml +++ b/src/myUtil.ml @@ -39,12 +39,6 @@ let list_fold_adjacent f init lst = aux None init lst -let pickup lst predicate e = - match lst |> List.filter predicate with - | head :: _ -> Ok(head) - | [] -> Error(e) - - module OptionMonad = struct let ( >>= ) x f = match x with diff --git a/src/myUtil.mli b/src/myUtil.mli index 11075c236..045314436 100644 --- a/src/myUtil.mli +++ b/src/myUtil.mli @@ -14,8 +14,6 @@ val range : int -> int -> int list val list_fold_adjacent : ('a -> 'b -> 'b option -> 'b option -> 'a) -> 'a -> 'b list -> 'a -val pickup : 'a list -> ('a -> bool) -> 'b -> ('a, 'b) result - module OptionMonad : sig val ( >>= ) : 'a option -> ('a -> 'b option) -> 'b option val return : 'a -> 'a option From 29455a55c1c7a345289d3cce73d18c21d13535f6 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 11 Nov 2022 09:48:19 +0900 Subject: [PATCH 119/288] replace 'MyUtil.first_some' with 'List.find_map' --- src/config.ml | 4 ++-- src/myUtil.ml | 16 ---------------- src/myUtil.mli | 2 -- 3 files changed, 2 insertions(+), 20 deletions(-) diff --git a/src/config.ml b/src/config.ml index 301307008..b8b83fa70 100644 --- a/src/config.ml +++ b/src/config.ml @@ -20,7 +20,7 @@ let resolve_lib_file (relpath : lib_path) : (abs_path, abs_path list) result = let dirs = !satysfi_root_dirs in let relpathstr = get_lib_path_string relpath in let pathcands = dirs |> List.map (fun dir -> Filename.concat dir relpathstr) in - match first_some resolve pathcands with + match pathcands |> List.find_map resolve with | None -> err (pathcands |> List.map make_abs_path) | Some(pathstr) -> return @@ make_abs_path pathstr @@ -29,6 +29,6 @@ let resolve_local ~(extensions : string list) ~origin:(dir : string) ~relative:( let open ResultMonad in let path_without_ext = Filename.concat dir s in let pathcands = extensions |> List.map (fun ext -> path_without_ext ^ ext) in - match first_some resolve pathcands with + match pathcands |> List.find_map resolve with | None -> err (pathcands |> List.map make_abs_path) | Some(pathstr) -> return @@ make_abs_path pathstr diff --git a/src/myUtil.ml b/src/myUtil.ml index 12f34ec5f..dbcb7c501 100644 --- a/src/myUtil.ml +++ b/src/myUtil.ml @@ -106,22 +106,6 @@ let ( @|> ) = ( |> ) ---- *) -let first_some f lst = - let rec aux = function - | [] -> - None - - | x :: xs -> - let opt = f x in - begin - match opt with - | Some(_) -> opt - | None -> aux xs - end - in - aux lst - - let open_in_abs (AbsPath(pathstr)) = open_in pathstr diff --git a/src/myUtil.mli b/src/myUtil.mli index 045314436..ea5fdee4f 100644 --- a/src/myUtil.mli +++ b/src/myUtil.mli @@ -40,8 +40,6 @@ val ( += ) : int ref -> int -> unit val ( @|> ) : 'a -> ('a -> 'b) -> 'b -val first_some : ('a -> 'b option) -> 'a list -> 'b option - val open_in_abs : abs_path -> in_channel val open_in_bin_abs : abs_path -> in_channel From 61cb903fdbfd7591ae792e30304793b129489c71 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 11 Nov 2022 09:57:49 +0900 Subject: [PATCH 120/288] remove 'MyUtil.(+=)' --- src/backend/fontFormat.ml | 28 ++++++++++++++-------------- src/myUtil.ml | 4 ---- src/myUtil.mli | 2 -- 3 files changed, 14 insertions(+), 20 deletions(-) diff --git a/src/backend/fontFormat.ml b/src/backend/fontFormat.ml index 04ebc95df..3cdff0b02 100644 --- a/src/backend/fontFormat.ml +++ b/src/backend/fontFormat.ml @@ -1240,26 +1240,26 @@ let to_flate_pdf_bytes (data : string) : string * Pdfio.bytes = let src_len = String.length data in let write_byte_as_input buf = let src_offset = !src_offset_ref in - if src_offset >= src_len then 0 else - begin - let len = - if src_len - src_offset < 1024 then src_len - src_offset else 1024 - in - src_offset_ref += len; - Bytes.blit_string data src_offset buf 0 len; - len - end + if src_offset >= src_len then + 0 + else begin + let len = if src_len - src_offset < 1024 then src_len - src_offset else 1024 in + src_offset_ref := src_offset + len; + Bytes.blit_string data src_offset buf 0 len; + len + end in let out_offset_ref = ref 0 in let bufout = Bytes.create (2 * src_len) in (* In the worst case, the output size is 1.003 times as large as the input size. *) let write_byte_as_output bufret len = let out_offset = !out_offset_ref in - if len <= 0 then () else - begin - out_offset_ref += len; - Bytes.blit bufret 0 bufout out_offset len - end + if len <= 0 then + () + else begin + out_offset_ref := out_offset + len; + Bytes.blit bufret 0 bufout out_offset len + end in Pdfflate.compress ~level:9 write_byte_as_input write_byte_as_output; let out_len = !out_offset_ref in diff --git a/src/myUtil.ml b/src/myUtil.ml index dbcb7c501..4cff113ac 100644 --- a/src/myUtil.ml +++ b/src/myUtil.ml @@ -95,10 +95,6 @@ module EscapeMonad = struct end -let ( += ) r n = - r := !r + n - - let ( @|> ) = ( |> ) (* ---- right-associative version; diff --git a/src/myUtil.mli b/src/myUtil.mli index ea5fdee4f..672c03c6e 100644 --- a/src/myUtil.mli +++ b/src/myUtil.mli @@ -36,8 +36,6 @@ module EscapeMonad : sig val force : [< `Escape of 'a ] -> 'a end -val ( += ) : int ref -> int -> unit - val ( @|> ) : 'a -> ('a -> 'b) -> 'b val open_in_abs : abs_path -> in_channel From ee130ff0c3c248390a2a917571d823758ba966a9 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 11 Nov 2022 11:01:59 +0900 Subject: [PATCH 121/288] separate '{Option,Result,Escape}Monad' from 'MyUtil' --- src/escapeMonad.ml | 12 +++++++ src/escapeMonad.mli | 4 +++ src/frontend/documentAttribute.ml | 1 - src/frontend/evaluator.cppo.ml | 1 - src/frontend/hashTree.ml | 4 +-- src/frontend/manualTypeDecoder.ml | 1 - src/frontend/moduleTypechecker.ml | 1 - src/frontend/signatureSubtyping.ml | 1 - src/frontend/syntaxBase.ml | 3 -- src/frontend/tupleList.ml | 3 -- src/frontend/typecheckUtil.ml | 1 - src/frontend/typechecker.ml | 1 - src/frontend/unification.ml | 1 - src/frontend/yamlDecoder.ml | 3 -- src/myUtil.ml | 56 ------------------------------ src/myUtil.mli | 22 ------------ src/optionMonad.ml | 6 ++++ src/optionMonad.mli | 2 ++ src/resultMonad.ml | 27 ++++++++++++++ src/resultMonad.mli | 7 ++++ 20 files changed, 59 insertions(+), 98 deletions(-) create mode 100644 src/escapeMonad.ml create mode 100644 src/escapeMonad.mli create mode 100644 src/optionMonad.ml create mode 100644 src/optionMonad.mli create mode 100644 src/resultMonad.ml create mode 100644 src/resultMonad.mli diff --git a/src/escapeMonad.ml b/src/escapeMonad.ml new file mode 100644 index 000000000..bd9bd52db --- /dev/null +++ b/src/escapeMonad.ml @@ -0,0 +1,12 @@ +let ( >>= ) x f = + match x with + | `Continue(v) -> f v + | `Escape(_) as e -> e + +let continue v = `Continue(v) + +let escape e = `Escape(e) + +let force x = + match x with + | `Escape(e) -> e diff --git a/src/escapeMonad.mli b/src/escapeMonad.mli new file mode 100644 index 000000000..ecb94305d --- /dev/null +++ b/src/escapeMonad.mli @@ -0,0 +1,4 @@ +val ( >>= ) : [< `Continue of 'a | `Escape of 'b ] -> ('a -> ([> `Escape of 'b ] as 'c)) -> 'c +val continue : 'a -> [> `Continue of 'a ] +val escape : 'a -> [> `Escape of 'a ] +val force : [< `Escape of 'a ] -> 'a diff --git a/src/frontend/documentAttribute.ml b/src/frontend/documentAttribute.ml index b68fe54a2..fb656c602 100644 --- a/src/frontend/documentAttribute.ml +++ b/src/frontend/documentAttribute.ml @@ -1,5 +1,4 @@ -open MyUtil open Types open PackageSystemBase diff --git a/src/frontend/evaluator.cppo.ml b/src/frontend/evaluator.cppo.ml index e67d6ff59..9b6eabe90 100644 --- a/src/frontend/evaluator.cppo.ml +++ b/src/frontend/evaluator.cppo.ml @@ -1,5 +1,4 @@ -open MyUtil open LengthInterface open GraphicBase open SyntaxBase diff --git a/src/frontend/hashTree.ml b/src/frontend/hashTree.ml index 1135f97c2..2c79ae0a4 100644 --- a/src/frontend/hashTree.ml +++ b/src/frontend/hashTree.ml @@ -1,6 +1,4 @@ -open MyUtil - module type S = sig type key @@ -124,6 +122,6 @@ module Make (Key : Map.OrderedType) = match result with | None -> acc | Some(x) -> x - + end diff --git a/src/frontend/manualTypeDecoder.ml b/src/frontend/manualTypeDecoder.ml index e17a3ba54..ad35700c7 100644 --- a/src/frontend/manualTypeDecoder.ml +++ b/src/frontend/manualTypeDecoder.ml @@ -2,7 +2,6 @@ open SyntaxBase open Types open StaticEnv -open MyUtil open TypeError open TypecheckUtil diff --git a/src/frontend/moduleTypechecker.ml b/src/frontend/moduleTypechecker.ml index 3ba9b0c7c..5a728b84e 100644 --- a/src/frontend/moduleTypechecker.ml +++ b/src/frontend/moduleTypechecker.ml @@ -2,7 +2,6 @@ open SyntaxBase open Types open StaticEnv -open MyUtil open TypeError open TypecheckUtil diff --git a/src/frontend/signatureSubtyping.ml b/src/frontend/signatureSubtyping.ml index 278048a87..d3463cdfc 100644 --- a/src/frontend/signatureSubtyping.ml +++ b/src/frontend/signatureSubtyping.ml @@ -1,7 +1,6 @@ open SyntaxBase open Types -open MyUtil open StaticEnv open TypeError open TypecheckUtil diff --git a/src/frontend/syntaxBase.ml b/src/frontend/syntaxBase.ml index c4e149262..8bbe5235d 100644 --- a/src/frontend/syntaxBase.ml +++ b/src/frontend/syntaxBase.ml @@ -1,7 +1,4 @@ -open MyUtil - - let pp_set fold pp_elem ppf set = Format.fprintf ppf "@[{"; fold (fun k is_first -> diff --git a/src/frontend/tupleList.ml b/src/frontend/tupleList.ml index ae4509a87..c96f75e9c 100644 --- a/src/frontend/tupleList.ml +++ b/src/frontend/tupleList.ml @@ -1,7 +1,4 @@ -open MyUtil - - type 'a t = 'a * 'a * 'a list diff --git a/src/frontend/typecheckUtil.ml b/src/frontend/typecheckUtil.ml index 0337b0e7e..3bb4eb364 100644 --- a/src/frontend/typecheckUtil.ml +++ b/src/frontend/typecheckUtil.ml @@ -2,7 +2,6 @@ open SyntaxBase open StaticEnv open Types -open MyUtil open TypeError diff --git a/src/frontend/typechecker.ml b/src/frontend/typechecker.ml index 5300d3059..5aaf6e2e2 100644 --- a/src/frontend/typechecker.ml +++ b/src/frontend/typechecker.ml @@ -2,7 +2,6 @@ open SyntaxBase open Types open StaticEnv -open MyUtil open TypeError open TypecheckUtil diff --git a/src/frontend/unification.ml b/src/frontend/unification.ml index 842fb1900..0e111aa95 100644 --- a/src/frontend/unification.ml +++ b/src/frontend/unification.ml @@ -1,7 +1,6 @@ open SyntaxBase open Types -open MyUtil open TypeError diff --git a/src/frontend/yamlDecoder.ml b/src/frontend/yamlDecoder.ml index a93d2d82f..995b745ff 100644 --- a/src/frontend/yamlDecoder.ml +++ b/src/frontend/yamlDecoder.ml @@ -1,7 +1,4 @@ -open MyUtil - - type context_element = | Field of string | Index of int diff --git a/src/myUtil.ml b/src/myUtil.ml index 4cff113ac..75fd7baee 100644 --- a/src/myUtil.ml +++ b/src/myUtil.ml @@ -39,62 +39,6 @@ let list_fold_adjacent f init lst = aux None init lst -module OptionMonad = struct - let ( >>= ) x f = - match x with - | None as n -> n - | Some(v) -> f v - - let return v = Some(v) -end - -module ResultMonad = struct - let ( >>= ) x f = - match x with - | Ok(v) -> f v - | Error(_) as e -> e - - let return v = Ok(v) - - let err e = Error(e) - - let ( let* ) = ( >>= ) - - let foldM f acc vs = - vs |> List.fold_left (fun res v -> - res >>= fun acc -> - f acc v - ) (return acc) - - let mapM f vs = - vs |> foldM (fun acc v -> - f v >>= fun y -> - return @@ Alist.extend acc y - ) Alist.empty >>= fun acc -> - return (Alist.to_list acc) - - let optionM f = function - | None -> return None - | Some(v) -> f v >>= fun y -> return @@ Some(y) - -end - -module EscapeMonad = struct - let ( >>= ) x f = - match x with - | `Continue(v) -> f v - | `Escape(_) as e -> e - - let continue v = `Continue(v) - - let escape e = `Escape(e) - - let force x = - match x with - | `Escape(e) -> e -end - - let ( @|> ) = ( |> ) (* ---- right-associative version; diff --git a/src/myUtil.mli b/src/myUtil.mli index 672c03c6e..1257aaa03 100644 --- a/src/myUtil.mli +++ b/src/myUtil.mli @@ -14,28 +14,6 @@ val range : int -> int -> int list val list_fold_adjacent : ('a -> 'b -> 'b option -> 'b option -> 'a) -> 'a -> 'b list -> 'a -module OptionMonad : sig - val ( >>= ) : 'a option -> ('a -> 'b option) -> 'b option - val return : 'a -> 'a option -end - -module ResultMonad : sig - val ( >>= ) : ('a, 'e) result -> ('a -> ('b, 'e) result) -> ('b, 'e) result - val return : 'a -> ('a, 'e) result - val err : 'e -> ('a, 'e) result - val ( let* ) : ('a, 'e) result -> ('a -> ('b, 'e) result) -> ('b, 'e) result - val foldM : ('a -> 'b -> ('a, 'e) result) -> 'a -> 'b list -> ('a, 'e) result - val mapM : ('a -> ('b, 'e) result) -> 'a list -> ('b list, 'e) result - val optionM : ('a -> ('b, 'e) result) -> 'a option -> ('b option, 'e) result -end - -module EscapeMonad : sig - val ( >>= ) : [< `Continue of 'a | `Escape of 'b ] -> ('a -> ([> `Escape of 'b ] as 'c)) -> 'c - val continue : 'a -> [> `Continue of 'a ] - val escape : 'a -> [> `Escape of 'a ] - val force : [< `Escape of 'a ] -> 'a -end - val ( @|> ) : 'a -> ('a -> 'b) -> 'b val open_in_abs : abs_path -> in_channel diff --git a/src/optionMonad.ml b/src/optionMonad.ml new file mode 100644 index 000000000..4e4cc2246 --- /dev/null +++ b/src/optionMonad.ml @@ -0,0 +1,6 @@ +let ( >>= ) x f = + match x with + | None as n -> n + | Some(v) -> f v + +let return v = Some(v) diff --git a/src/optionMonad.mli b/src/optionMonad.mli new file mode 100644 index 000000000..df45628a8 --- /dev/null +++ b/src/optionMonad.mli @@ -0,0 +1,2 @@ +val ( >>= ) : 'a option -> ('a -> 'b option) -> 'b option +val return : 'a -> 'a option diff --git a/src/resultMonad.ml b/src/resultMonad.ml new file mode 100644 index 000000000..de1b8b2ad --- /dev/null +++ b/src/resultMonad.ml @@ -0,0 +1,27 @@ +let ( >>= ) x f = + match x with + | Ok(v) -> f v + | Error(_) as e -> e + +let return v = Ok(v) + +let err e = Error(e) + +let ( let* ) = ( >>= ) + +let foldM f acc vs = + vs |> List.fold_left (fun res v -> + res >>= fun acc -> + f acc v + ) (return acc) + +let mapM f vs = + vs |> foldM (fun acc v -> + f v >>= fun y -> + return @@ Alist.extend acc y + ) Alist.empty >>= fun acc -> + return (Alist.to_list acc) + +let optionM f = function + | None -> return None + | Some(v) -> f v >>= fun y -> return @@ Some(y) diff --git a/src/resultMonad.mli b/src/resultMonad.mli new file mode 100644 index 000000000..7150a90ec --- /dev/null +++ b/src/resultMonad.mli @@ -0,0 +1,7 @@ +val ( >>= ) : ('a, 'e) result -> ('a -> ('b, 'e) result) -> ('b, 'e) result +val return : 'a -> ('a, 'e) result +val err : 'e -> ('a, 'e) result +val ( let* ) : ('a, 'e) result -> ('a -> ('b, 'e) result) -> ('b, 'e) result +val foldM : ('a -> 'b -> ('a, 'e) result) -> 'a -> 'b list -> ('a, 'e) result +val mapM : ('a -> ('b, 'e) result) -> 'a list -> ('b list, 'e) result +val optionM : ('a -> ('b, 'e) result) -> 'a option -> ('b option, 'e) result From 617d51c404459f980cca9cd2bb3b2a96cbb3886c Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 11 Nov 2022 11:04:20 +0900 Subject: [PATCH 122/288] remove sources that are no longer used --- src/frontend/files.ml | 27 ------- src/frontend/hashTree.ml | 127 -------------------------------- src/frontend/hashTree.mli | 24 ------ src/frontend/toplevel.ocamlinit | 81 -------------------- 4 files changed, 259 deletions(-) delete mode 100644 src/frontend/files.ml delete mode 100644 src/frontend/hashTree.ml delete mode 100644 src/frontend/hashTree.mli delete mode 100644 src/frontend/toplevel.ocamlinit diff --git a/src/frontend/files.ml b/src/frontend/files.ml deleted file mode 100644 index ae7c1f303..000000000 --- a/src/frontend/files.ml +++ /dev/null @@ -1,27 +0,0 @@ - -(* string -> string *) -let string_of_file_in file_name_in = - let str_in = ref "" in - let chnl_in = open_in file_name_in in - let cat_sub () = - while true do - str_in := !str_in ^ (String.make 1 (input_char chnl_in)) - done - in - try - ( cat_sub () ; "" ) - with - End_of_file -> ( close_in chnl_in ; !str_in ) - -let rec string_of_file_in_list file_name_in_list = - match file_name_in_list with - [] -> "" - | head :: tail -> - let str_in = string_of_file_in head in - str_in ^ (string_of_file_in_list tail) - -(* string -> string -> unit *) -let file_out_of_string file_name_out content_out = - let chnl_out = open_out file_name_out in - output_string chnl_out content_out ; - close_out chnl_out diff --git a/src/frontend/hashTree.ml b/src/frontend/hashTree.ml deleted file mode 100644 index 2c79ae0a4..000000000 --- a/src/frontend/hashTree.ml +++ /dev/null @@ -1,127 +0,0 @@ - -module type S = - sig - type key - type 'a t - val empty : 'a -> 'a t - val to_string : (key -> string) -> ('a -> string) -> 'a t -> string - val find_stage : 'a t -> key list -> 'a option - val update : 'a t -> key list -> ('a -> 'a) -> ('a t) option - val add_stage : 'a t -> key list -> key -> 'a -> ('a t) option - val search_backward : 'a t -> key list -> key list -> ('a -> 'b option) -> 'b option - val fold_backward : 'a t -> key list -> key list -> ('b -> 'a -> 'b) -> 'b -> 'b - end - - -module Make (Key : Map.OrderedType) = - struct - - module InternalMap = Map.Make(Key) - - type key = Key.t - - type 'a t = - | Stage of 'a * ('a t) InternalMap.t - - - let empty (vroot : 'a) : 'a t = - Stage(vroot, InternalMap.empty) - - - let rec to_string (strk : key -> string) (strf : 'a -> string) (Stage(x, imap) : 'a t) : string = - (strf x) ^ ", { " ^ (InternalMap.fold (fun k hshtr s -> (strk k) ^ ": " ^ (to_string strk strf hshtr) ^ " " ^ s) imap "") ^ "}" - - - (* -- 'find_stage hshtr addr' returns the stage at 'addr/' if it exists, - and returns 'None' otherwise. -- *) - let rec find_stage (Stage(x, imap) : 'a t) (addr : key list) : 'a option = - let open OptionMonad in - match addr with - | [] -> - return x - - | k :: tail -> - InternalMap.find_opt k imap >>= fun hshtr -> - find_stage hshtr tail - - - (* -- 'update hshtr addr f' returns the hash tree that updates 'hshtr' by 'f' as to the stage at 'addr'. - Returns 'None' if 'hshtr' does NOT have a stage at 'addr/'. -- *) - let update (hshtr : 'a t) (addr : key list) (f : 'a -> 'a) : ('a t) option = - let open OptionMonad in - let rec aux (Stage(x, imap) : 'a t) (addr : key list) = - match addr with - | [] -> - return (Stage(f x, imap)) - - | k :: tail -> - InternalMap.find_opt k imap >>= fun hshtrnext -> - aux hshtrnext tail >>= fun res -> - return (Stage(x, InternalMap.add k res imap)) - in - aux hshtr addr - - - (* -- 'add_stage hshtr addr knew vnew' returns the hash tree to which 'vnew' is inserted at the address 'addr/knew/' . - Returns 'None' if 'hshtr' does NOT have a stage at the address 'addr'. -- *) - let add_stage (hshtr : 'a t) (addr : key list) (knew : key) (vnew : 'a) : ('a t) option = - let open OptionMonad in - let rec aux (Stage(x, imap) : 'a t) (addr : key list) = - match addr with - | [] -> - return (Stage(x, InternalMap.add knew (Stage(vnew, InternalMap.empty)) imap)) - - | k :: tail -> - InternalMap.find_opt k imap >>= fun hshtrnext -> - aux hshtrnext tail >>= fun res -> - let imapnew = InternalMap.add k res imap in - return (Stage(x, imapnew)) - in - aux hshtr addr - - - (* -- 'search_backward hshtr addr addrlast findf' lookups stages - from the address 'd_1/.../d_n/addrlast', 'd_1/.../d_(n-1)/addrlast' down to 'addrlast'. - Returns 'None' if every candidate stage does NOT exist or answers 'None' for 'findf'. -- *) - let rec search_backward (Stage(_, imap) as hshtr : 'a t) (addr : key list) (addrlast : key list) (findf : 'a -> 'b option) : 'b option = - let open OptionMonad in - match addr with - | [] -> - find_stage hshtr addrlast >>= fun xsub -> - findf xsub - - | k :: tail -> - InternalMap.find_opt k imap >>= fun hshtrnext -> - let res = search_backward hshtrnext tail addrlast findf in - begin - match res with - | Some(_) -> - res - - | None -> - find_stage hshtr addrlast >>= fun xsub -> - findf xsub - end - - - let rec fold_backward (Stage(_, imap) as hshtr : 'a t) (addr : key list) (addrlast : key list) (foldf : 'b -> 'a -> 'b) (acc : 'b) : 'b = - let open OptionMonad in - let result = - match addr with - | [] -> - find_stage hshtr addrlast >>= fun xsub -> - return (foldf acc xsub) - - | k :: tail -> - InternalMap.find_opt k imap >>= fun hshtrnext -> - let res = fold_backward hshtrnext tail addrlast foldf acc in - match find_stage hshtr addrlast with - | Some(xsub) -> return (foldf res xsub) - | None -> return (res) - in - match result with - | None -> acc - | Some(x) -> x - - - end diff --git a/src/frontend/hashTree.mli b/src/frontend/hashTree.mli deleted file mode 100644 index 2b8e15d75..000000000 --- a/src/frontend/hashTree.mli +++ /dev/null @@ -1,24 +0,0 @@ - -module type S = - sig - type key - - type 'a t - - val empty : 'a -> 'a t - - val to_string : (key -> string) -> ('a -> string) -> 'a t -> string - - val find_stage : 'a t -> key list -> 'a option - - val update : 'a t -> key list -> ('a -> 'a) -> ('a t) option - - val add_stage : 'a t -> key list -> key -> 'a -> ('a t) option - - val search_backward : 'a t -> key list -> key list -> ('a -> 'b option) -> 'b option - - val fold_backward : 'a t -> key list -> key list -> ('b -> 'a -> 'b) -> 'b -> 'b - end - - -module Make (Key : Map.OrderedType) : S with type key = Key.t diff --git a/src/frontend/toplevel.ocamlinit b/src/frontend/toplevel.ocamlinit deleted file mode 100644 index 64358efae..000000000 --- a/src/frontend/toplevel.ocamlinit +++ /dev/null @@ -1,81 +0,0 @@ -#load "assoc.cmo";; -#load "stacklist.cmo";; -#load "range.cmo";; -#load "types.cmo";; -#load "hashTree.cmo";; -#load "directedGraph.cmo";; -#load "typeenv.cmo";; -#load "display.cmo";; -#load "parser.cmo";; -#load "lexer.cmo";; -#load "typechecker.cmo";; -#load "out.cmo";; -#load "evaluator.cmo";; -#load "primitives.cmo";; -#load "files.cmo";; -#load "main.cmo";; -let init () = Lexer.reset_to_numexpr ();; -Types.Tyvarid.initialize () ;; -let tyenv = Primitives.make_type_environment ();; -let env = Primitives.make_environment ();; -init ();; - - -let parse s = - let p = ref (Range.dummy "init", Types.UTNumericConstant(0)) in - begin - Main.error_log_environment (fun () -> - begin - init () ; - p := Parser.main Lexer.cut_token (Lexing.from_string s) - end - ) ; - !p - end -;; - -let parsestr s = Display.string_of_utast (parse s);; - -let tcraw s = - init () ; - let (tyres, _, _) = (Typechecker.main tyenv (parse s)) in tyres -;; - -let tc s mdlnmlst varnm = - Main.error_log_environment (fun () -> - begin - init () ; - let (tyres, tyenvres, _) = (Typechecker.main tyenv (parse s)) in - try - let pty = Typeenv.find tyenvres mdlnmlst varnm in - begin - print_endline ("TYPE = " ^ (Display.string_of_poly_type tyenvres pty)) ; - print_endline ("TYPE = " ^ (Types.string_of_poly_type_basic pty)) ; - end - with - | Not_found -> print_endline ("! [Error at TOPLEVEL] '" ^ varnm ^ "' not found.") - end - );; - -let tcb s varnm = - Main.error_log_environment (fun () -> - begin - init () ; - let (tyres, tyenvres, _) = (Typechecker.main tyenv (parse s)) in - try - let pty = Typeenv.find tyenvres [] varnm in - print_endline ("TYPE = " ^ (Types.string_of_poly_type_basic pty)) - with - | Not_found -> print_endline ("! [Error at TOPLEVEL] '" ^ varnm ^ "' not found.") - end - );; - -let eval s = - init () ; - let (_, _, ast) = (Typechecker.main tyenv (parse s)) in - Evaluator.interpret env ast -;; - -let evalstr s = Display.string_of_ast (eval s);; - -let out s = init () ; Out.main (eval s);; From 6efda641ac06e01acadc4be58fc823aaa590895f Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 11 Nov 2022 11:09:32 +0900 Subject: [PATCH 123/288] remove from 'MyUtil' functions that are no longer used --- src/myUtil.ml | 10 ---------- src/myUtil.mli | 6 ------ 2 files changed, 16 deletions(-) diff --git a/src/myUtil.ml b/src/myUtil.ml index 75fd7baee..421c8249e 100644 --- a/src/myUtil.ml +++ b/src/myUtil.ml @@ -50,18 +50,10 @@ let open_in_abs (AbsPath(pathstr)) = open_in pathstr -let open_in_bin_abs (AbsPath(pathstr)) = - open_in_bin pathstr - - let open_out_abs (AbsPath(pathstr)) = open_out pathstr -let dirname_abs (AbsPath(pathstr)) = - Filename.dirname pathstr - - let basename_abs (AbsPath(pathstr)) = Filename.basename pathstr @@ -74,8 +66,6 @@ let get_abs_path_string (AbsPath(pathstr)) = pathstr let get_lib_path_string (LibPath(pathstr)) = pathstr -let get_abs_path_extension (AbsPath(pathstr)) = Filename.extension pathstr - module AbsPath = struct type t = abs_path diff --git a/src/myUtil.mli b/src/myUtil.mli index 1257aaa03..2145e0435 100644 --- a/src/myUtil.mli +++ b/src/myUtil.mli @@ -18,12 +18,8 @@ val ( @|> ) : 'a -> ('a -> 'b) -> 'b val open_in_abs : abs_path -> in_channel -val open_in_bin_abs : abs_path -> in_channel - val open_out_abs : abs_path -> out_channel -val dirname_abs : abs_path -> string - val basename_abs : abs_path -> string val make_abs_path : string -> abs_path @@ -34,8 +30,6 @@ val get_abs_path_string : abs_path -> string val get_lib_path_string : lib_path -> string -val get_abs_path_extension : abs_path -> string - module AbsPath : sig type t = abs_path From 72caea14170cc044ccc3133ee7e395a45ac7bfca Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 11 Nov 2022 11:13:52 +0900 Subject: [PATCH 124/288] remove 'open_out_abs' by using 'Core.Out_channel.write_all' --- src/frontend/main.ml | 6 ++---- src/myUtil.ml | 15 ++++++--------- src/myUtil.mli | 2 -- 3 files changed, 8 insertions(+), 15 deletions(-) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 62e6146dc..3ecc68608 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -78,10 +78,8 @@ let output_pdf (pdfret : HandlePdf.t) : unit = HandlePdf.write_to_file pdfret -let output_text (abspath_out : abs_path) (s : string) : unit = - let outc = open_out_abs abspath_out in - output_string outc s; - close_out outc +let output_text (abspath_out : abs_path) (data : string) : unit = + Core.Out_channel.write_all (get_abs_path_string abspath_out) ~data let eval_library_file (env : environment) (abspath : abs_path) (binds : binding list) : environment = diff --git a/src/myUtil.ml b/src/myUtil.ml index 421c8249e..895209496 100644 --- a/src/myUtil.ml +++ b/src/myUtil.ml @@ -1,11 +1,6 @@ exception RemainsToBeImplemented of string -type abs_path = AbsPath of string -[@@deriving show { with_path = false }] - -type lib_path = LibPath of string - let remains_to_be_implemented msg = raise (RemainsToBeImplemented(msg)) @@ -46,12 +41,14 @@ let ( @|> ) = ( |> ) ---- *) -let open_in_abs (AbsPath(pathstr)) = - open_in pathstr +type abs_path = AbsPath of string +[@@deriving show { with_path = false }] + +type lib_path = LibPath of string -let open_out_abs (AbsPath(pathstr)) = - open_out pathstr +let open_in_abs (AbsPath(pathstr)) = + open_in pathstr let basename_abs (AbsPath(pathstr)) = diff --git a/src/myUtil.mli b/src/myUtil.mli index 2145e0435..8071ace9f 100644 --- a/src/myUtil.mli +++ b/src/myUtil.mli @@ -18,8 +18,6 @@ val ( @|> ) : 'a -> ('a -> 'b) -> 'b val open_in_abs : abs_path -> in_channel -val open_out_abs : abs_path -> out_channel - val basename_abs : abs_path -> string val make_abs_path : string -> abs_path From bdf84aa798bc599806485de31b7bbc473c6f0a73 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 11 Nov 2022 11:15:14 +0900 Subject: [PATCH 125/288] fix tests about migration of modules --- test/misc/dependencyGraphTest.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/misc/dependencyGraphTest.ml b/test/misc/dependencyGraphTest.ml index cec0e5b21..8d4a89887 100644 --- a/test/misc/dependencyGraphTest.ml +++ b/test/misc/dependencyGraphTest.ml @@ -1,6 +1,6 @@ -open Main__MyUtil open Main__Types +module ResultMonad = Main__ResultMonad module TupleList = Main__TupleList From 66a62f5326fc8810b87ca8a7676cbc13e1b62f97 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 12 Nov 2022 04:42:36 +0900 Subject: [PATCH 126/288] make 'Makefile' generate lock files and compare them to the corresponding expected lock files --- demo/.gitignore | 1 + demo/Makefile | 26 ++++++++++++++++--- ...atysfi-lock => demo.satysfi-lock-expected} | 0 3 files changed, 23 insertions(+), 4 deletions(-) create mode 100644 demo/.gitignore rename demo/{demo.satysfi-lock => demo.satysfi-lock-expected} (100%) diff --git a/demo/.gitignore b/demo/.gitignore new file mode 100644 index 000000000..28e8ef900 --- /dev/null +++ b/demo/.gitignore @@ -0,0 +1 @@ +*.satysfi-lock diff --git a/demo/Makefile b/demo/Makefile index e3c1eb488..638552d88 100644 --- a/demo/Makefile +++ b/demo/Makefile @@ -1,16 +1,34 @@ TARGETS = \ demo.pdf \ +EXPECTED_LOCKS=$(TARGETS:.pdf=.satysfi-lock-expected) + SATYSFI ?= satysfi -.PHONY: all clean +.PHONY: all promote clean + +.SUFFIXES: .saty .pdf .satysfi-lock .satysfi-lock-expected + +# Keeps intermediate results: +.PRECIOUS: %.satysfi-lock -.SUFFIXES: .saty .pdf +# Generates a lock file from a document and checks that it is as expected: +.saty.satysfi-lock: + $(SATYSFI) solve $< + diff $(<:.saty=.satysfi-lock) $(<:.saty=.satysfi-lock-expected) -.saty.pdf: +# Typesets a document: +%.pdf: %.saty %.satysfi-lock $(SATYSFI) build $< -o $@ +# Promote a lock file to the corresponding expected lock file: +%.satysfi-lock-expected: %.satysfi-lock + cp $*.satysfi-lock $*.satysfi-lock-expected + +# Entrypoint: all:: $(TARGETS) +promote:: $(EXPECTED_LOCKS) + clean: - rm -f *.pdf *.satysfi-aux + rm -f *.pdf *.satysfi-aux *.satysfi-lock diff --git a/demo/demo.satysfi-lock b/demo/demo.satysfi-lock-expected similarity index 100% rename from demo/demo.satysfi-lock rename to demo/demo.satysfi-lock-expected From d8866f5f3f47d1205872a75f6a20c83233b14384 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 12 Nov 2022 05:13:31 +0900 Subject: [PATCH 127/288] make 'doc/Makefile' generate lock files and compare them to the corresponding expected lock files --- demo/Makefile | 3 +- doc/.gitignore | 1 + doc/Makefile | 27 ++++++++-- ...fi-lock => doc-lang.satysfi-lock-expected} | 0 ...k => doc-primitives.satysfi-lock-expected} | 0 doc/math1.saty | 7 +++ doc/math1.satysfi-lock | 50 ------------------- doc/math1.satysfi-lock-expected | 45 +++++++++++++++++ 8 files changed, 78 insertions(+), 55 deletions(-) create mode 100644 doc/.gitignore rename doc/{doc-lang.satysfi-lock => doc-lang.satysfi-lock-expected} (100%) rename doc/{doc-primitives.satysfi-lock => doc-primitives.satysfi-lock-expected} (100%) delete mode 100644 doc/math1.satysfi-lock create mode 100644 doc/math1.satysfi-lock-expected diff --git a/demo/Makefile b/demo/Makefile index 638552d88..bc3d2b8b1 100644 --- a/demo/Makefile +++ b/demo/Makefile @@ -25,9 +25,10 @@ SATYSFI ?= satysfi %.satysfi-lock-expected: %.satysfi-lock cp $*.satysfi-lock $*.satysfi-lock-expected -# Entrypoint: +# Entrypoint for typesetting documents: all:: $(TARGETS) +# Entrypoint for promoting lock files: promote:: $(EXPECTED_LOCKS) clean: diff --git a/doc/.gitignore b/doc/.gitignore new file mode 100644 index 000000000..28e8ef900 --- /dev/null +++ b/doc/.gitignore @@ -0,0 +1 @@ +*.satysfi-lock diff --git a/doc/Makefile b/doc/Makefile index af8ebf383..2d2c2478b 100644 --- a/doc/Makefile +++ b/doc/Makefile @@ -3,19 +3,38 @@ TARGETS = \ doc-lang.pdf \ math1.pdf \ +EXPECTED_LOCKS=$(TARGETS:.pdf=.satysfi-lock-expected) + SATYSFI ?= satysfi -.PHONY: all clean +.PHONY: all promote clean + +.SUFFIXES: .saty .pdf .satysfi-lock .satysfi-lock-expected + +# Keeps intermediate results: +.PRECIOUS: %.satysfi-lock -.SUFFIXES: .saty .pdf +# Generates a lock file from a document and checks that it is as expected: +.saty.satysfi-lock: + $(SATYSFI) solve $< + diff $(<:.saty=.satysfi-lock) $(<:.saty=.satysfi-lock-expected) -.saty.pdf: +# Typesets a document: +%.pdf: %.saty %.satysfi-lock $(SATYSFI) build $< -o $@ +# Promote a lock file to the corresponding expected lock file: +%.satysfi-lock-expected: %.satysfi-lock + cp $*.satysfi-lock $*.satysfi-lock-expected + +# Entrypoint for typesetting documents: all:: $(TARGETS) +# Entrypoint for promoting lock files: +promote:: $(EXPECTED_LOCKS) + clean: - rm -f *.pdf *.satysfi-aux + rm -f *.pdf *.satysfi-aux *.satysfi-lock doc-primitives.pdf: local-math.satyh local.satyh paren.satyh doc-lang.pdf: local-math.satyh diff --git a/doc/doc-lang.satysfi-lock b/doc/doc-lang.satysfi-lock-expected similarity index 100% rename from doc/doc-lang.satysfi-lock rename to doc/doc-lang.satysfi-lock-expected diff --git a/doc/doc-primitives.satysfi-lock b/doc/doc-primitives.satysfi-lock-expected similarity index 100% rename from doc/doc-primitives.satysfi-lock rename to doc/doc-primitives.satysfi-lock-expected diff --git a/doc/math1.saty b/doc/math1.saty index 9958c04eb..90bf068fd 100644 --- a/doc/math1.saty +++ b/doc/math1.saty @@ -1,3 +1,10 @@ +#[dependencies [ + (`stdlib`, `0.0.1`), + (`math`, `0.0.1`), + (`proof`, `0.0.1`), + (`tabular`, `0.0.1`), + (`std-ja`, `0.0.1`), +]] use package open Stdlib use package open Math use package open Proof diff --git a/doc/math1.satysfi-lock b/doc/math1.satysfi-lock deleted file mode 100644 index fc76567be..000000000 --- a/doc/math1.satysfi-lock +++ /dev/null @@ -1,50 +0,0 @@ -locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" - - - name: "math.0.0.1" - location: - type: "global" - path: "./dist/packages/math/math.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "proof.0.0.1" - location: - type: "global" - path: "./dist/packages/proof/proof.0.0.1" - dependencies: - - "stdlib.0.0.1" - - - name: "tabular.0.0.1" - location: - type: "global" - path: "./dist/packages/tabular/tabular.0.0.1" - dependencies: - - "stdlib.0.0.1" - - - name: "std-ja.0.0.1" - dependencies: - - "stdlib.0.0.1" - - "math.0.0.1" - - "annot.0.0.1" - - "code.0.0.1" - location: - type: "global" - path: "./dist/packages/std-ja/std-ja.0.0.1/" - - - name: "annot.0.0.1" - location: - type: "global" - path: "./dist/packages/annot/annot.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "code.0.0.1" - location: - type: "global" - path: "./dist/packages/code/code.0.0.1/" - dependencies: - - "stdlib.0.0.1" diff --git a/doc/math1.satysfi-lock-expected b/doc/math1.satysfi-lock-expected new file mode 100644 index 000000000..5c26d4071 --- /dev/null +++ b/doc/math1.satysfi-lock-expected @@ -0,0 +1,45 @@ +locks: +- name: annot.0.0.1 + location: + type: global + path: ./dist/packages/annot/annot.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: code.0.0.1 + location: + type: global + path: ./dist/packages/code/code.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: math.0.0.1 + location: + type: global + path: ./dist/packages/math/math.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: proof.0.0.1 + location: + type: global + path: ./dist/packages/proof/proof.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: std-ja.0.0.1 + location: + type: global + path: ./dist/packages/std-ja/std-ja.0.0.1/ + dependencies: + - stdlib.0.0.1 + - math.0.0.1 + - annot.0.0.1 + - code.0.0.1 +- name: stdlib.0.0.1 + location: + type: global + path: ./dist/packages/stdlib/stdlib.0.0.1/ + dependencies: [] +- name: tabular.0.0.1 + location: + type: global + path: ./dist/packages/tabular/tabular.0.0.1/ + dependencies: + - stdlib.0.0.1 From 5df59acb59db4e1fa03c8c219c67c3d2240246c3 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 12 Nov 2022 05:52:52 +0900 Subject: [PATCH 128/288] make 'tests/**/Makefile' generate lock files and compare them to the corresponding expected lock files (except for Markdown) --- tests/.gitignore | 1 + tests/Makefile | 30 +++++++++++++++++-- ...atysfi-lock => clip.satysfi-lock-expected} | 0 ...tysfi-lock => glue1.satysfi-lock-expected} | 0 tests/images/Makefile | 27 ++++++++++++++--- ...atysfi-lock => test.satysfi-lock-expected} | 0 ...ysfi-lock => macro1.satysfi-lock-expected} | 0 ...k => math-typefaces.satysfi-lock-expected} | 0 tests/math2.satysfi-lock | 12 -------- ...tysfi-lock => math2.satysfi-lock-expected} | 0 tests/refactor1.satysfi-lock-expected | 12 ++++++++ tests/refactor2.satysfi-lock | 12 -------- ...i-lock => refactor2.satysfi-lock-expected} | 0 tests/refactor3.satysfi-lock | 12 -------- tests/refactor3.satysfi-lock-expected | 1 + tests/refactor5.satysfi-lock | 12 -------- tests/refactor5.satysfi-lock-expected | 1 + ...sfi-lock => staged1.satysfi-lock-expected} | 0 tests/text_mode/Makefile | 29 +++++++++++++++--- tests/text_mode/test.satysfi-lock-expected | 1 + 20 files changed, 92 insertions(+), 58 deletions(-) create mode 100644 tests/.gitignore rename tests/{clip.satysfi-lock => clip.satysfi-lock-expected} (100%) rename tests/{glue1.satysfi-lock => glue1.satysfi-lock-expected} (100%) rename tests/images/{test.satysfi-lock => test.satysfi-lock-expected} (100%) rename tests/{macro1.satysfi-lock => macro1.satysfi-lock-expected} (100%) rename tests/{math-typefaces.satysfi-lock => math-typefaces.satysfi-lock-expected} (100%) delete mode 100644 tests/math2.satysfi-lock rename tests/{refactor1.satysfi-lock => math2.satysfi-lock-expected} (100%) create mode 100644 tests/refactor1.satysfi-lock-expected delete mode 100644 tests/refactor2.satysfi-lock rename tests/{text_mode/test.satysfi-lock => refactor2.satysfi-lock-expected} (100%) delete mode 100644 tests/refactor3.satysfi-lock create mode 100644 tests/refactor3.satysfi-lock-expected delete mode 100644 tests/refactor5.satysfi-lock create mode 100644 tests/refactor5.satysfi-lock-expected rename tests/{staged1.satysfi-lock => staged1.satysfi-lock-expected} (100%) create mode 100644 tests/text_mode/test.satysfi-lock-expected diff --git a/tests/.gitignore b/tests/.gitignore new file mode 100644 index 000000000..28e8ef900 --- /dev/null +++ b/tests/.gitignore @@ -0,0 +1 @@ +*.satysfi-lock diff --git a/tests/Makefile b/tests/Makefile index a10dd3960..6b5c66fde 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -14,15 +14,33 @@ TARGETS = \ # refactor4.pdf \ # refactor6.pdf \ +EXPECTED_LOCKS=$(TARGETS:.pdf=.satysfi-lock-expected) + SATYSFI ?= satysfi -.PHONY: all clean +.PHONY: all promote clean .SUFFIXES: .saty .pdf -.saty.pdf: +.SUFFIXES: .saty .pdf .satysfi-lock .satysfi-lock-expected + +# Keeps intermediate results: +.PRECIOUS: %.satysfi-lock + +# Generates a lock file from a document and checks that it is as expected: +.saty.satysfi-lock: + $(SATYSFI) solve $< + diff $(<:.saty=.satysfi-lock) $(<:.saty=.satysfi-lock-expected) + +# Typesets a document: +%.pdf: %.saty %.satysfi-lock $(SATYSFI) build $< -o $@ +# Promote a lock file to the corresponding expected lock file: +%.satysfi-lock-expected: %.satysfi-lock + cp $*.satysfi-lock $*.satysfi-lock-expected + +# Entrypoint for typesetting documents: all:: $(TARGETS) all:: @@ -30,6 +48,14 @@ all:: (cd text_mode; make) (cd md; make) +# Entrypoint for promoting lock files: +# TODO: add `(cd md; make promote)` here +promote:: $(EXPECTED_LOCKS) + +promote:: + (cd images; make promote) + (cd text_mode; make promote) + clean:: rm -f *.pdf *.satysfi-aux diff --git a/tests/clip.satysfi-lock b/tests/clip.satysfi-lock-expected similarity index 100% rename from tests/clip.satysfi-lock rename to tests/clip.satysfi-lock-expected diff --git a/tests/glue1.satysfi-lock b/tests/glue1.satysfi-lock-expected similarity index 100% rename from tests/glue1.satysfi-lock rename to tests/glue1.satysfi-lock-expected diff --git a/tests/images/Makefile b/tests/images/Makefile index e7f988ac2..05cbd0219 100644 --- a/tests/images/Makefile +++ b/tests/images/Makefile @@ -1,16 +1,35 @@ TARGETS = \ test.pdf \ +EXPECTED_LOCKS=$(TARGETS:.pdf=.satysfi-lock-expected) + SATYSFI ?= satysfi -.PHONY: all clean +.PHONY: all promote clean + +.SUFFIXES: .saty .pdf .satysfi-lock .satysfi-lock-expected + +# Keeps intermediate results: +.PRECIOUS: %.satysfi-lock -.SUFFIXES: .saty .pdf +# Generates a lock file from a document and checks that it is as expected: +.saty.satysfi-lock: + $(SATYSFI) solve $< + diff $(<:.saty=.satysfi-lock) $(<:.saty=.satysfi-lock-expected) -.saty.pdf: +# Typesets a document: +%.pdf: %.saty %.satysfi-lock $(SATYSFI) build $< -o $@ +# Promote a lock file to the corresponding expected lock file: +%.satysfi-lock-expected: %.satysfi-lock + cp $*.satysfi-lock $*.satysfi-lock-expected + +# Entrypoint for typesetting documents: all:: $(TARGETS) +# Entrypoint for promoting lock files: +promote:: $(EXPECTED_LOCKS) + clean: - rm -f *.pdf *.satysfi-aux + rm -f *.pdf *.satysfi-aux *.satysfi-lock diff --git a/tests/images/test.satysfi-lock b/tests/images/test.satysfi-lock-expected similarity index 100% rename from tests/images/test.satysfi-lock rename to tests/images/test.satysfi-lock-expected diff --git a/tests/macro1.satysfi-lock b/tests/macro1.satysfi-lock-expected similarity index 100% rename from tests/macro1.satysfi-lock rename to tests/macro1.satysfi-lock-expected diff --git a/tests/math-typefaces.satysfi-lock b/tests/math-typefaces.satysfi-lock-expected similarity index 100% rename from tests/math-typefaces.satysfi-lock rename to tests/math-typefaces.satysfi-lock-expected diff --git a/tests/math2.satysfi-lock b/tests/math2.satysfi-lock deleted file mode 100644 index 002661c22..000000000 --- a/tests/math2.satysfi-lock +++ /dev/null @@ -1,12 +0,0 @@ -locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" - - - name: "math.0.0.1" - location: - type: "global" - path: "./dist/packages/math/math.0.0.1/" - dependencies: - - "stdlib.0.0.1" diff --git a/tests/refactor1.satysfi-lock b/tests/math2.satysfi-lock-expected similarity index 100% rename from tests/refactor1.satysfi-lock rename to tests/math2.satysfi-lock-expected diff --git a/tests/refactor1.satysfi-lock-expected b/tests/refactor1.satysfi-lock-expected new file mode 100644 index 000000000..460d82536 --- /dev/null +++ b/tests/refactor1.satysfi-lock-expected @@ -0,0 +1,12 @@ +locks: +- name: math.0.0.1 + location: + type: global + path: ./dist/packages/math/math.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: stdlib.0.0.1 + location: + type: global + path: ./dist/packages/stdlib/stdlib.0.0.1/ + dependencies: [] diff --git a/tests/refactor2.satysfi-lock b/tests/refactor2.satysfi-lock deleted file mode 100644 index 002661c22..000000000 --- a/tests/refactor2.satysfi-lock +++ /dev/null @@ -1,12 +0,0 @@ -locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" - - - name: "math.0.0.1" - location: - type: "global" - path: "./dist/packages/math/math.0.0.1/" - dependencies: - - "stdlib.0.0.1" diff --git a/tests/text_mode/test.satysfi-lock b/tests/refactor2.satysfi-lock-expected similarity index 100% rename from tests/text_mode/test.satysfi-lock rename to tests/refactor2.satysfi-lock-expected diff --git a/tests/refactor3.satysfi-lock b/tests/refactor3.satysfi-lock deleted file mode 100644 index 002661c22..000000000 --- a/tests/refactor3.satysfi-lock +++ /dev/null @@ -1,12 +0,0 @@ -locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" - - - name: "math.0.0.1" - location: - type: "global" - path: "./dist/packages/math/math.0.0.1/" - dependencies: - - "stdlib.0.0.1" diff --git a/tests/refactor3.satysfi-lock-expected b/tests/refactor3.satysfi-lock-expected new file mode 100644 index 000000000..a2e98fa3c --- /dev/null +++ b/tests/refactor3.satysfi-lock-expected @@ -0,0 +1 @@ +locks: [] diff --git a/tests/refactor5.satysfi-lock b/tests/refactor5.satysfi-lock deleted file mode 100644 index 002661c22..000000000 --- a/tests/refactor5.satysfi-lock +++ /dev/null @@ -1,12 +0,0 @@ -locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" - - - name: "math.0.0.1" - location: - type: "global" - path: "./dist/packages/math/math.0.0.1/" - dependencies: - - "stdlib.0.0.1" diff --git a/tests/refactor5.satysfi-lock-expected b/tests/refactor5.satysfi-lock-expected new file mode 100644 index 000000000..a2e98fa3c --- /dev/null +++ b/tests/refactor5.satysfi-lock-expected @@ -0,0 +1 @@ +locks: [] diff --git a/tests/staged1.satysfi-lock b/tests/staged1.satysfi-lock-expected similarity index 100% rename from tests/staged1.satysfi-lock rename to tests/staged1.satysfi-lock-expected diff --git a/tests/text_mode/Makefile b/tests/text_mode/Makefile index 77615806e..1be4b1e3e 100644 --- a/tests/text_mode/Makefile +++ b/tests/text_mode/Makefile @@ -1,16 +1,37 @@ TARGETS = \ test.tex \ +EXPECTED_LOCKS=$(TARGETS:.tex=.satysfi-lock-expected) + SATYSFI ?= satysfi -.PHONY: all clean +.PHONY: all promote clean + +.SUFFIXES: .saty .tex .satysfi-lock .satysfi-lock-expected + +# Keeps intermediate results: +.PRECIOUS: %.satysfi-lock -.SUFFIXES: .saty .tex +# Generates a lock file from a document and checks that it is as expected: +.saty.satysfi-lock: + $(SATYSFI) solve $< + diff $(<:.saty=.satysfi-lock) $(<:.saty=.satysfi-lock-expected) -.saty.tex: +# Outputs a text file: +%.tex: %.saty %.satysfi-lock $(SATYSFI) build $< --text-mode "latex" -o $@ +# Promote a lock file to the corresponding expected lock file: +%.satysfi-lock-expected: %.satysfi-lock + cp $*.satysfi-lock $*.satysfi-lock-expected + +# Entrypoint for typesetting documents: all:: $(TARGETS) +# Entrypoint for promoting lock files: +promote:: $(EXPECTED_LOCKS) + clean: - rm -f *.pdf *.dvi *.log *.fls *.fdb_latexmk *.synctex.gz *.tex *.satysfi-aux + rm -f *.pdf *.dvi *.log *.fls *.fdb_latexmk *.synctex.gz *.tex *.satysfi-aux *.satysfi-lock + +test.saty: head.satyh-latex diff --git a/tests/text_mode/test.satysfi-lock-expected b/tests/text_mode/test.satysfi-lock-expected new file mode 100644 index 000000000..a2e98fa3c --- /dev/null +++ b/tests/text_mode/test.satysfi-lock-expected @@ -0,0 +1 @@ +locks: [] From 2299b43760998c470555d7ff39555d827d30dc7f Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 12 Nov 2022 15:35:14 +0900 Subject: [PATCH 129/288] begin to develop the notion of font packages --- src/frontend/main.ml | 10 +++++++- src/frontend/packageChecker.ml | 17 ++++++++++--- src/frontend/packageConfig.ml | 44 ++++++++++++++++++++++++++++++++++ src/frontend/packageConfig.mli | 9 +++++++ src/frontend/packageReader.ml | 15 +++++++++++- src/frontend/types.cppo.ml | 18 ++++++++++---- 6 files changed, 104 insertions(+), 9 deletions(-) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 3ecc68608..f8537f3d3 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1331,7 +1331,11 @@ let check_depended_packages ~(lock_config_dir : abs_path) ~(extensions : string (* Typecheck every locked package: *) let (genv, libacc) = sorted_packages |> List.fold_left (fun (genv, libacc) (_lock_name, package) -> - let main_module_name = package.main_module_name in + let main_module_name = + match package with + | UTLibraryPackage{ main_module_name; _ } -> main_module_name + | UTFontPackage{ main_module_name; _ } -> main_module_name + in let (ssig, libs) = match PackageChecker.main tyenv_prim genv package with | Ok(pair) -> pair @@ -1621,6 +1625,10 @@ let solve match config.package_contents with | PackageConfig.Library{ dependencies; _ } -> return (dependencies, abspath_lock_config) + + | PackageConfig.Font(_) -> + let dependencies = [] in + return (dependencies, abspath_lock_config) end | DocumentSolveInput{ diff --git a/src/frontend/packageChecker.ml b/src/frontend/packageChecker.ml index 167cd0a3e..f67e385f4 100644 --- a/src/frontend/packageChecker.ml +++ b/src/frontend/packageChecker.ml @@ -80,10 +80,8 @@ let typecheck_document_file (tyenv : Typeenv.t) (abspath_in : abs_path) (utast : err (NotADocumentFile(abspath_in, ty)) -let main (tyenv_prim : Typeenv.t) (genv : global_type_environment) (package : untyped_package) : (StructSig.t * (abs_path * binding list) list) ok = +let check_library_package (tyenv_prim : Typeenv.t) (genv : global_type_environment) (main_module_name : module_name) (utlibs : (abs_path * untyped_library_file) list) = let open ResultMonad in - let main_module_name = package.main_module_name in - let utlibs = package.modules in (* Resolve dependency among the source files in the package: *) let* sorted_utlibs = ClosedFileDependencyResolver.main utlibs in @@ -116,6 +114,19 @@ let main (tyenv_prim : Typeenv.t) (genv : global_type_environment) (package : un | None -> err @@ NoMainModule(main_module_name) +let check_font_package (_main_module_name : module_name) (_font_files : (abs_path * font_file_contents) list) = + failwith "TODO: check_font_package" + + +let main (tyenv_prim : Typeenv.t) (genv : global_type_environment) (package : untyped_package) : (StructSig.t * (abs_path * binding list) list) ok = + match package with + | UTLibraryPackage{ main_module_name; modules = utlibs } -> + check_library_package tyenv_prim genv main_module_name utlibs + + | UTFontPackage{ main_module_name; font_files } -> + check_font_package main_module_name font_files + + let main_document (tyenv_prim : Typeenv.t) (genv : global_type_environment) (sorted_locals : (abs_path * untyped_library_file) list) (abspath_and_utdoc : abs_path * untyped_document_file) : ((abs_path * binding list) list * abstract_tree) ok = let open ResultMonad in let* (genv, libacc) = diff --git a/src/frontend/packageConfig.ml b/src/frontend/packageConfig.ml index c39d22a84..d7744cf55 100644 --- a/src/frontend/packageConfig.ml +++ b/src/frontend/packageConfig.ml @@ -10,18 +10,54 @@ type 'a ok = ('a, config_error) result type relative_path = string +type font_file_description = { + font_file_path : relative_path; + font_file_contents : font_file_contents; +} + type package_contents = | Library of { main_module_name : module_name; source_directories : relative_path list; dependencies : package_dependency list; } + | Font of { + main_module_name : module_name; + font_file_descriptions : font_file_description list; + } type t = { package_contents : package_contents; } +let font_file_contents_decoder : font_file_contents ConfigDecoder.t = + let open ConfigDecoder in + branch "type" [ + "opentype_single" ==> begin + get "name" string >>= fun name -> + succeed @@ OpentypeSingle(name) + end; + "opentype_collection" ==> begin + get "names" (list string) >>= fun names -> + succeed @@ OpentypeCollection(names) + end; + ] + ~other:(fun tag -> + failure (fun context -> UnexpectedTag(context, tag)) + ) + + +let font_file_description_decoder : font_file_description ConfigDecoder.t = + let open ConfigDecoder in + get "path" string >>= fun font_file_path -> + get "contents" font_file_contents_decoder >>= fun font_file_contents -> + succeed @@ { + font_file_path; + font_file_contents; + } + + let contents_decoder : package_contents ConfigDecoder.t = let open ConfigDecoder in branch "type" [ @@ -35,6 +71,14 @@ let contents_decoder : package_contents ConfigDecoder.t = dependencies; } end; + "font" ==> begin + get "main_module" string >>= fun main_module_name -> + get "elements" (list font_file_description_decoder) >>= fun font_file_descriptions -> + succeed @@ Font { + main_module_name; + font_file_descriptions; + } + end; ] ~other:(fun tag -> failure (fun context -> UnexpectedTag(context, tag)) diff --git a/src/frontend/packageConfig.mli b/src/frontend/packageConfig.mli index 22817e095..93a20db50 100644 --- a/src/frontend/packageConfig.mli +++ b/src/frontend/packageConfig.mli @@ -6,12 +6,21 @@ open PackageSystemBase type relative_path = string +type font_file_description = { + font_file_path : relative_path; + font_file_contents : font_file_contents; +} + type package_contents = | Library of { main_module_name : module_name; source_directories : relative_path list; dependencies : package_dependency list; } + | Font of { + main_module_name : module_name; + font_file_descriptions : font_file_description list; + } type t = { package_contents : package_contents; diff --git a/src/frontend/packageReader.ml b/src/frontend/packageReader.ml index 51c484ae6..37b552bb0 100644 --- a/src/frontend/packageReader.ml +++ b/src/frontend/packageReader.ml @@ -45,9 +45,22 @@ let main ~(extensions : string list) (absdir_package : abs_path) : untyped_packa ) Alist.empty in let modules = Alist.to_list acc in - return { + return @@ UTLibraryPackage{ main_module_name; modules; } + + | PackageConfig.Font{ main_module_name; font_file_descriptions } -> + let font_files = + font_file_descriptions |> List.map (fun font_file_description -> + let PackageConfig.{ font_file_path; font_file_contents } = font_file_description in + let abspath = make_abs_path (Filename.concat (get_abs_path_string absdir_package) font_file_path) in + (abspath, font_file_contents) + ) + in + return @@ UTFontPackage{ + main_module_name; + font_files; + } in return package diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index 200507462..d8b8e293e 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -599,10 +599,20 @@ type untyped_source_file = | UTDocumentFile of untyped_document_file [@@deriving show { with_path = false; }] -type untyped_package = { - main_module_name : module_name; - modules : (abs_path * untyped_library_file) list; -} +type font_file_contents = + | OpentypeSingle of var_name + | OpentypeCollection of var_name list +[@@deriving show { with_path = false }] + +type untyped_package = + | UTLibraryPackage of { + main_module_name : module_name; + modules : (abs_path * untyped_library_file) list; + } + | UTFontPackage of { + main_module_name : module_name; + font_files : (abs_path * font_file_contents) list; + } [@@deriving show { with_path = false }] type lock_info = { From 50ad7f80d07aebc9dc7b92fd6005a2561c4e96b8 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 12 Nov 2022 16:06:46 +0900 Subject: [PATCH 130/288] add 'Load{Single,Collection}Font', 'FontType', etc. --- src/frontend/bytecomp/ir.cppo.ml | 12 ++++++++++ src/frontend/display.ml | 1 + src/frontend/evaluator.cppo.ml | 12 ++++++++++ src/frontend/packageChecker.ml | 40 ++++++++++++++++++++++++++++++-- src/frontend/types.cppo.ml | 5 ++++ 5 files changed, 68 insertions(+), 2 deletions(-) diff --git a/src/frontend/bytecomp/ir.cppo.ml b/src/frontend/bytecomp/ir.cppo.ml index 48b5966e5..d3fbb503b 100644 --- a/src/frontend/bytecomp/ir.cppo.ml +++ b/src/frontend/bytecomp/ir.cppo.ml @@ -571,6 +571,12 @@ and transform_1 (env : frame) (ast : abstract_tree) : ir * frame = | ASTCodeSymbol(_symb) -> report_bug_ir "transform_1: ASTCodeSymbol at stage 1" + | LoadSingleFont(_) -> + failwith "TODO: LoadSingleFont" + + | LoadCollectionFont(_, _) -> + failwith "TODO: LoadCollectionFont" + #include "__ir_1.gen.ml" @@ -756,4 +762,10 @@ and transform_0 (env : frame) (ast : abstract_tree) : ir * frame = | ASTCodeSymbol(symb) -> return (IRConstant(CodeSymbol(symb))) + | LoadSingleFont(_) -> + failwith "TODO: LoadSingleFont" + + | LoadCollectionFont(_, _) -> + failwith "TODO: LoadCollectionFont" + #include "__ir_0.gen.ml" diff --git a/src/frontend/display.ml b/src/frontend/display.ml index a926bc983..3c4ca8e88 100644 --- a/src/frontend/display.ml +++ b/src/frontend/display.ml @@ -220,6 +220,7 @@ let show_base_type = function | PathType -> "path" | GraphicsType -> "graphics" | ImageType -> "image" + | FontType -> "font" | DocumentType -> "document" | RegExpType -> "regexp" | TextInfoType -> "text-info" diff --git a/src/frontend/evaluator.cppo.ml b/src/frontend/evaluator.cppo.ml index 9b6eabe90..5e15bb27f 100644 --- a/src/frontend/evaluator.cppo.ml +++ b/src/frontend/evaluator.cppo.ml @@ -413,6 +413,12 @@ and interpret_0 (env : environment) (ast : abstract_tree) : syntactic_value = | ASTCodeSymbol(_symb) -> report_bug_ast "ASTCodeSymbol(_) at stage 0" ast + | LoadSingleFont(_abspath_font) -> + failwith "TODO: LoadSingleFont" + + | LoadCollectionFont(_abspath_font, _index) -> + failwith "TODO: LoadCollectionFont" + #include "__evaluator_0.gen.ml" @@ -586,6 +592,12 @@ and interpret_1 (env : environment) (ast : abstract_tree) : code_value = | ASTCodeSymbol(symb) -> CdContentOf(Range.dummy "ASTCodeSymbol", symb) + | LoadSingleFont(_abspath_font) -> + failwith "TODO: LoadSingleFont" + + | LoadCollectionFont(_abspath_font, _index) -> + failwith "TODO: LoadCollectionFont" + #include "__evaluator_1.gen.ml" diff --git a/src/frontend/packageChecker.ml b/src/frontend/packageChecker.ml index f67e385f4..fbe2ae363 100644 --- a/src/frontend/packageChecker.ml +++ b/src/frontend/packageChecker.ml @@ -114,8 +114,44 @@ let check_library_package (tyenv_prim : Typeenv.t) (genv : global_type_environme | None -> err @@ NoMainModule(main_module_name) -let check_font_package (_main_module_name : module_name) (_font_files : (abs_path * font_file_contents) list) = - failwith "TODO: check_font_package" +let check_font_package (_main_module_name : module_name) (font_files : (abs_path * font_file_contents) list) = + let open ResultMonad in + let stage = Persistent0 in + let (ssig, libacc) = + font_files |> List.fold_left (fun (ssig, libacc) (abspath_font, font_file_contents) -> + match font_file_contents with + | OpentypeSingle(varnm) -> + let evid = EvalVarID.fresh (Range.dummy "font-package 1", varnm) in + let bind = Bind(stage, NonRec(evid, LoadSingleFont(abspath_font))) in + let ventry = + { + val_name = Some(evid); + val_type = Poly(Range.dummy "font-package 2", BaseType(FontType)); + val_stage = stage; + } + in + (ssig |> StructSig.add_value varnm ventry, Alist.extend libacc (abspath_font, [ bind ])) + + | OpentypeCollection(varnms) -> + let (ssig, bindacc, _) = + varnms |> List.fold_left (fun (ssig, bindacc, index) varnm -> + let evid = EvalVarID.fresh (Range.dummy "font-package 3", varnm) in + let bind = Bind(stage, NonRec(evid, LoadCollectionFont(abspath_font, index))) in + let ventry = + { + val_name = Some(evid); + val_type = Poly(Range.dummy "font-package 4", BaseType(FontType)); + val_stage = stage; + } + in + (ssig |> StructSig.add_value varnm ventry, Alist.extend bindacc bind, index + 1) + ) (ssig, Alist.empty, 0) + in + (ssig, Alist.extend libacc (abspath_font, Alist.to_list bindacc)) + + ) (StructSig.empty, Alist.empty) + in + return (ssig, Alist.to_list libacc) let main (tyenv_prim : Typeenv.t) (genv : global_type_environment) (package : untyped_package) : (StructSig.t * (abs_path * binding list) list) ok = diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index d8b8e293e..68e552eb3 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -128,6 +128,7 @@ type base_type = | PathType | GraphicsType | ImageType + | FontType | DocumentType | RegExpType | TextInfoType @@ -182,6 +183,7 @@ let base_type_map : base_type TypeNameMap.t = ("path" , PathType); ("graphics" , GraphicsType); ("image" , ImageType); + ("font" , FontType); ("document" , DocumentType); ("regexp" , RegExpType); ("text-info" , TextInfoType); @@ -1031,6 +1033,9 @@ and abstract_tree = | Persistent of Range.t * EvalVarID.t | Lift of abstract_tree | ASTCodeSymbol of CodeSymbol.t +(* Fonts: *) + | LoadSingleFont of abs_path + | LoadCollectionFont of abs_path * int (* Primitive applications: *) #include "__attype.gen.ml" From 6391f316d7f51c904af0184bb11cb40367bcd25b Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 12 Nov 2022 17:13:08 +0900 Subject: [PATCH 131/288] replace 'font_abbrev' with 'FontKey.t' --- src/backend/fontKey.ml | 22 ++++ src/backend/fontKey.mli | 11 ++ src/backend/horzBox.ml | 9 +- src/backend/setDefaultFont.ml | 23 ++-- src/backend/setDefaultFont.mli | 3 +- src/frontend/configError.ml | 5 +- src/frontend/evalUtil.ml | 10 +- src/frontend/evaluator.cppo.ml | 18 +-- src/frontend/fontInfo.ml | 214 +++++++++++++++++--------------- src/frontend/fontInfo.mli | 9 +- src/frontend/main.ml | 17 +-- src/frontend/primitives.cppo.ml | 3 +- src/frontend/types.cppo.ml | 6 + tools/gencode/type.ml | 2 +- tools/gencode/type.mli | 2 +- tools/gencode/vminst.ml | 10 +- 16 files changed, 207 insertions(+), 157 deletions(-) create mode 100644 src/backend/fontKey.ml create mode 100644 src/backend/fontKey.mli diff --git a/src/backend/fontKey.ml b/src/backend/fontKey.ml new file mode 100644 index 000000000..9621c4374 --- /dev/null +++ b/src/backend/fontKey.ml @@ -0,0 +1,22 @@ + +type t = int +[@@deriving show] + +let current_key_number = ref 0 + + +let initialize () = + current_key_number := 0 + + +let generate () = + incr current_key_number; + !current_key_number + + +let equal = + Int.equal + + +let hash = + Hashtbl.hash diff --git a/src/backend/fontKey.mli b/src/backend/fontKey.mli new file mode 100644 index 000000000..6503b00d1 --- /dev/null +++ b/src/backend/fontKey.mli @@ -0,0 +1,11 @@ + +type t = private int +[@@deriving show] + +val initialize : unit -> unit + +val generate : unit -> t + +val equal : t -> t -> bool + +val hash : t -> int diff --git a/src/backend/horzBox.ml b/src/backend/horzBox.ml index 88dacace9..9274f1d4c 100644 --- a/src/backend/horzBox.ml +++ b/src/backend/horzBox.ml @@ -26,18 +26,15 @@ type reachability = | Reachable of ratios [@@deriving show] -type font_abbrev = string -[@@deriving show] - type math_font_abbrev = string [@@deriving show] type file_path = string -type font_with_size = font_abbrev * Length.t +type font_with_size = FontKey.t * Length.t [@@deriving show] -type font_with_ratio = font_abbrev * float * float +type font_with_ratio = FontKey.t * float * float [@@deriving show] type page_content_scheme = { @@ -66,7 +63,7 @@ type paddings = { type horz_string_info = { - font_abbrev : font_abbrev; + font_abbrev : FontKey.t; text_font_size : length; text_color : color; rising : length; diff --git a/src/backend/setDefaultFont.ml b/src/backend/setDefaultFont.ml index a83d84c16..396e54e96 100644 --- a/src/backend/setDefaultFont.ml +++ b/src/backend/setDefaultFont.ml @@ -1,19 +1,19 @@ open MyUtil +(* +open HorzBox +*) open CharBasis - +(* module YS = Yojson.SafePos module MYU = MyYojsonUtil - - -type font_abbrev = string - - +*) +(* let read_single_assoc assoc = - let abbrev = assoc |> MYU.find "font-name" |> YS.Util.to_string in + let name = assoc |> MYU.find "font-name" |> YS.Util.to_string in let ratio = assoc |> MYU.find "ratio" |> YS.Util.to_float in let rising = assoc |> MYU.find "rising" |> YS.Util.to_float in - (abbrev, ratio, rising) + (StringFontAbbrev(name), ratio, rising) let read_assoc (assoc : MYU.assoc) = @@ -27,9 +27,11 @@ let read_assoc (assoc : MYU.assoc) = ("kana" , HiraganaOrKatakana); ("other-script" , OtherScript); ] +*) - -let main (abspath : abs_path) : (font_abbrev * float * float) ScriptSchemeMap.t = +let main (_abspath : abs_path) : (FontKey.t * float * float) ScriptSchemeMap.t = + ScriptSchemeMap.empty +(* let pathstr = get_abs_path_string abspath in try let json = YS.from_file ~fname:pathstr pathstr in @@ -38,3 +40,4 @@ let main (abspath : abs_path) : (font_abbrev * float * float) ScriptSchemeMap.t read_assoc assoc with | Yojson.Json_error(msg) -> MYU.syntax_error pathstr msg +*) diff --git a/src/backend/setDefaultFont.mli b/src/backend/setDefaultFont.mli index 0a48b0528..5aea3cb9b 100644 --- a/src/backend/setDefaultFont.mli +++ b/src/backend/setDefaultFont.mli @@ -1,6 +1,5 @@ open MyUtil -open HorzBox open CharBasis -val main : abs_path -> (font_abbrev * float * float) ScriptSchemeMap.t +val main : abs_path -> (FontKey.t * float * float) ScriptSchemeMap.t diff --git a/src/frontend/configError.ml b/src/frontend/configError.ml index c2f85e4a1..14a70a9cd 100644 --- a/src/frontend/configError.ml +++ b/src/frontend/configError.ml @@ -75,10 +75,9 @@ type config_error = | DocumentAttributeError of DocumentAttribute.error type font_error = - | InvalidFontAbbrev of font_abbrev | InvalidMathFontAbbrev of math_font_abbrev - | NotASingleFont of font_abbrev * abs_path - | NotATTCElement of font_abbrev * abs_path * int + | NotASingleFont of abs_path + | NotATTCElement of abs_path * int | NotASingleMathFont of math_font_abbrev * abs_path | NotATTCMathFont of math_font_abbrev * abs_path * int | CannotFindLibraryFileAsToFont of lib_path * abs_path list diff --git a/src/frontend/evalUtil.ml b/src/frontend/evalUtil.ml index 58ae17d96..ce0b33ae3 100644 --- a/src/frontend/evalUtil.ml +++ b/src/frontend/evalUtil.ml @@ -168,22 +168,22 @@ let get_decoset (value : syntactic_value) = report_bug_value "interpret_decoset" value -let get_font (value : syntactic_value) : HorzBox.font_with_ratio = +let get_font_with_ratio (value : syntactic_value) : HorzBox.font_with_ratio = match value with | Tuple([ - BaseConstant(BCString(abbrev)); + BaseConstant(BCFontKey(fontkey)); BaseConstant(BCFloat(sizer)); BaseConstant(BCFloat(risingr)); ]) -> - (abbrev, sizer, risingr) + (fontkey, sizer, risingr) | _ -> report_bug_value "interpret_font" value -let make_font_value (abbrev, sizer, risingr) = +let make_font_with_ratio_value ((fontkey, sizer, risingr) : HorzBox.font_with_ratio) = Tuple([ - BaseConstant(BCString(abbrev)); + BaseConstant(BCFontKey(fontkey)); BaseConstant(BCFloat(sizer)); BaseConstant(BCFloat(risingr)); ]) diff --git a/src/frontend/evaluator.cppo.ml b/src/frontend/evaluator.cppo.ml index 5e15bb27f..be7939733 100644 --- a/src/frontend/evaluator.cppo.ml +++ b/src/frontend/evaluator.cppo.ml @@ -413,11 +413,13 @@ and interpret_0 (env : environment) (ast : abstract_tree) : syntactic_value = | ASTCodeSymbol(_symb) -> report_bug_ast "ASTCodeSymbol(_) at stage 0" ast - | LoadSingleFont(_abspath_font) -> - failwith "TODO: LoadSingleFont" + | LoadSingleFont(abspath_font) -> + let fontkey = FontInfo.add_single abspath_font in + BaseConstant(BCFontKey(fontkey)) - | LoadCollectionFont(_abspath_font, _index) -> - failwith "TODO: LoadCollectionFont" + | LoadCollectionFont(abspath_font, index) -> + let fontkey = FontInfo.add_ttc abspath_font index in + BaseConstant(BCFontKey(fontkey)) #include "__evaluator_0.gen.ml" @@ -592,11 +594,11 @@ and interpret_1 (env : environment) (ast : abstract_tree) : code_value = | ASTCodeSymbol(symb) -> CdContentOf(Range.dummy "ASTCodeSymbol", symb) - | LoadSingleFont(_abspath_font) -> - failwith "TODO: LoadSingleFont" + | LoadSingleFont(abspath_font) -> + CdLoadSingleFont(abspath_font) - | LoadCollectionFont(_abspath_font, _index) -> - failwith "TODO: LoadCollectionFont" + | LoadCollectionFont(abspath_font, index) -> + CdLoadCollectionFont(abspath_font, index) #include "__evaluator_1.gen.ml" diff --git a/src/frontend/fontInfo.ml b/src/frontend/fontInfo.ml index 3c9dd5a99..111d8af71 100644 --- a/src/frontend/fontInfo.ml +++ b/src/frontend/fontInfo.ml @@ -12,6 +12,8 @@ type 'a ok = ('a, font_error) result type tag = string +type key = FontKey.t + type font_definition = { font_tag : tag; font : FontFormat.font; @@ -24,124 +26,126 @@ let resolve_lib_file (relpath : lib_path) = |> Result.map_error (fun candidates -> CannotFindLibraryFileAsToFont(relpath, candidates)) -module FontAbbrevHashTable : sig +module FontHashTable : sig val initialize : unit -> unit - val add_single : font_abbrev -> lib_path -> unit - val add_ttc : font_abbrev -> lib_path -> int -> unit - val fold : (font_abbrev -> font_definition -> 'a -> 'a) -> 'a -> 'a - val find : font_abbrev -> font_definition ok + val add_single : abs_path -> key + val add_ttc : abs_path -> int -> key + val fold : (key -> font_definition -> 'a -> 'a) -> 'a -> 'a + val find : key -> font_definition ok end = struct - type font_store = - | UnusedSingle - | UnusedTTC of int - | Loaded of font_definition - - module Ht = Hashtbl.Make - (struct - type t = font_abbrev - let equal = (=) - let hash = Hashtbl.hash - end) - - - let abbrev_to_definition_hash_table : (lib_path * font_store ref) Ht.t = Ht.create 32 - - let current_tag_number = ref 0 - - - let initialize () = - Ht.clear abbrev_to_definition_hash_table; - current_tag_number := 0 - + type font_store = + | UnusedSingle + | UnusedTTC of int + | Loaded of font_definition - let generate_tag () = - incr current_tag_number; - "/F" ^ (string_of_int !current_tag_number) - - - let add_single abbrev relpath = - match abbrev |> Ht.find_opt abbrev_to_definition_hash_table with - | Some((relpath, _)) -> - Logging.warn_duplicate_font_hash abbrev relpath + module Ht = Hashtbl.Make(FontKey) - | None -> - let storeref = ref UnusedSingle in - Ht.add abbrev_to_definition_hash_table abbrev (relpath, storeref) + let abbrev_to_definition_hash_table : (abs_path * font_store ref) Ht.t = Ht.create 32 - let add_ttc abbrev relpath i = - if abbrev |> Ht.mem abbrev_to_definition_hash_table then - Logging.warn_duplicate_font_hash abbrev relpath - else - let storeref = ref (UnusedTTC(i)) in - Ht.add abbrev_to_definition_hash_table abbrev (relpath, storeref) + let current_tag_number = ref 0 - let fold (f : font_abbrev -> font_definition -> 'a -> 'a) init = - Ht.fold (fun abbrev (_, storeref) acc -> - match !storeref with - | UnusedSingle -> acc (* Ignores unused fonts *) - | UnusedTTC(_) -> acc (* Ignores unused fonts *) - | Loaded(dfn) -> f abbrev dfn acc - ) abbrev_to_definition_hash_table init + let initialize () = + Ht.clear abbrev_to_definition_hash_table; + FontKey.initialize (); + current_tag_number := 0 - let find (abbrev : font_abbrev) : font_definition ok = - let open ResultMonad in - match Ht.find_opt abbrev_to_definition_hash_table abbrev with - | None -> - err @@ InvalidFontAbbrev(abbrev) + let generate_tag () = + incr current_tag_number; + "/F" ^ (string_of_int !current_tag_number) - | Some((relpath, storeref)) -> - begin - match !storeref with - | Loaded(dfn) -> - return dfn - | UnusedSingle -> - (* If this is the first access to the single font: *) - let* abspath = resolve_lib_file relpath in - begin - match FontFormat.get_decoder_single (abbrev ^ "-Composite") (* temporary *) abspath with - | None -> - (* If the font file is a TrueType collection: *) - err @@ NotASingleFont(abbrev, abspath) + (* TODO: check duplicate registration *) + let add_single (abspath : abs_path) : key = + let key = FontKey.generate () in + let storeref = ref UnusedSingle in + Ht.add abbrev_to_definition_hash_table key (abspath, storeref); + key - | Some((dcdr, font)) -> - let tag = generate_tag () in - let dfn = { font_tag = tag; font = font; decoder = dcdr; } in - storeref := Loaded(dfn); - return dfn - end - | UnusedTTC(i) -> - (* If this is the first access to the TrueType collection: *) - let* abspath = resolve_lib_file relpath in - begin - match FontFormat.get_decoder_ttc (abbrev ^ "-Composite") (* temporary *) abspath i with - | None -> - err @@ NotATTCElement(abbrev, abspath, i) + (* TODO: check duplicate registration *) + let add_ttc (abspath : abs_path) (index : int) : key = + let key = FontKey.generate () in + let storeref = ref (UnusedTTC(index)) in + Ht.add abbrev_to_definition_hash_table key (abspath, storeref); + key - | Some((dcdr, font)) -> - let tag = generate_tag () in - let dfn = { font_tag = tag; font = font; decoder = dcdr; } in - storeref := Loaded(dfn); - return dfn - end - end - end + let fold (f : key -> font_definition -> 'a -> 'a) (init : 'a) = + Ht.fold (fun key (_, storeref) acc -> + match !storeref with + | UnusedSingle -> acc (* Ignores unused fonts *) + | UnusedTTC(_) -> acc (* Ignores unused fonts *) + | Loaded(dfn) -> f key dfn acc + ) abbrev_to_definition_hash_table init -let get_font_definition_exn (abbrev : font_abbrev) = - match FontAbbrevHashTable.find abbrev with + let find (key : key) : font_definition ok = + let open ResultMonad in + match Ht.find_opt abbrev_to_definition_hash_table key with + | None -> + assert false + + | Some((abspath, storeref)) -> + begin + match !storeref with + | Loaded(dfn) -> + return dfn + + | UnusedSingle -> + (* If this is the first access to the single font: *) + let fontname = Printf.sprintf "id-%s-Composite" (FontKey.show key) in (* TODO: fix this *) + begin + match FontFormat.get_decoder_single fontname abspath with + | None -> + (* If the font file is a TrueType collection: *) + err @@ NotASingleFont(abspath) + + | Some((dcdr, font)) -> + let tag = generate_tag () in + let dfn = { font_tag = tag; font = font; decoder = dcdr; } in + storeref := Loaded(dfn); + return dfn + end + + | UnusedTTC(i) -> + (* If this is the first access to the TrueType collection: *) + let fontname = Printf.sprintf "id-%s-Composite" (FontKey.show key) in (* TODO: fix this *) + begin + match FontFormat.get_decoder_ttc fontname abspath i with + | None -> + err @@ NotATTCElement(abspath, i) + + | Some((dcdr, font)) -> + let tag = generate_tag () in + let dfn = { font_tag = tag; font = font; decoder = dcdr; } in + storeref := Loaded(dfn); + return dfn + end + end + +end + + +let add_single (abspath : abs_path) : key = + FontHashTable.add_single abspath + + +let add_ttc (abspath : abs_path) (index : int) : key = + FontHashTable.add_ttc abspath index + + +let get_font_definition_exn (key : key) : font_definition = + match FontHashTable.find key with | Ok(dfn) -> dfn | Error(e) -> raise (FontInfoError(e)) -let get_font_tag (abbrev : font_abbrev) : tag = - let dfn = get_font_definition_exn abbrev in +let get_font_tag (key : key) : tag = + let dfn = get_font_definition_exn key in dfn.font_tag @@ -182,10 +186,13 @@ let convert_gid_list (metricsf : FontFormat.glyph_id -> FontFormat.metrics) (dcd (gsynlst |> List.map (fun (gid, _) -> gid) (* temporary *), otxt, (FontFormat.PerMille(rawwid), FontFormat.PerMille(rawhgt), FontFormat.PerMille(rawdpt))) -let get_glyph_id font_abbrev dcdr uch = +let get_glyph_id dcdr uch = match FontFormat.get_glyph_id dcdr uch with | None -> + (* TODO: fix this *) +(* Logging.warn_no_glyph font_abbrev uch; +*) FontFormat.notdef | Some(gid) -> @@ -199,8 +206,8 @@ let get_metrics_of_word (hsinfo : horz_string_info) (uchseglst : uchar_segment l let dcdr = dfn.decoder in let gseglst = uchseglst |> List.map (fun (ubase, umarks) -> - let gbase = get_glyph_id font_abbrev dcdr ubase in - let gmarks = List.map (get_glyph_id font_abbrev dcdr) umarks in + let gbase = get_glyph_id dcdr ubase in + let gmarks = List.map (get_glyph_id dcdr) umarks in (gbase, gmarks) ) in @@ -237,7 +244,7 @@ module MathFontAbbrevHashTable module Ht = Hashtbl.Make (struct - type t = font_abbrev + type t = math_font_abbrev let equal = (=) let hash = Hashtbl.hash end) @@ -414,7 +421,7 @@ let get_math_char_info (mfabbrev : math_font_abbrev) ~(is_in_base_level : bool) let get_font_dictionary (pdf : Pdf.t) : Pdf.pdfobject = let keyval = - [] |> FontAbbrevHashTable.fold (fun _ dfn acc -> + [] |> FontHashTable.fold (fun _ dfn acc -> let tag = dfn.font_tag in let font = dfn.font in let dcdr = dfn.decoder in @@ -434,7 +441,7 @@ let get_font_dictionary (pdf : Pdf.t) : Pdf.pdfobject = let initialize () = let res = let open ResultMonad in - FontAbbrevHashTable.initialize (); + FontHashTable.initialize (); MathFontAbbrevHashTable.initialize (); let* abspath_S = resolve_lib_file (make_lib_path "dist/unidata/Scripts.txt") in let* abspath_EAW = resolve_lib_file (make_lib_path "dist/unidata/EastAsianWidth.txt") in @@ -450,11 +457,14 @@ let initialize () = let font_hash_dist = LoadFont.main abspath_fonts in let font_hash = List.append font_hash_local font_hash_dist in if OptionState.does_show_fonts () then Logging.show_fonts font_hash; - font_hash |> List.iter (fun (abbrev, data) -> +(* + font_hash |> List.iter (fun (name, data) -> + let abbrev = StringFontAbbrev(name) in match data with | FontAccess.Single(relpath) -> FontAbbrevHashTable.add_single abbrev relpath | FontAccess.Collection(relpath, i) -> FontAbbrevHashTable.add_ttc abbrev relpath i ); +*) let math_font_hash_local = match Config.resolve_lib_file (make_lib_path "local/hash/mathfonts.satysfi-hash") with | Error(_) -> [] diff --git a/src/frontend/fontInfo.mli b/src/frontend/fontInfo.mli index 97e8bf4ee..c6802ecc5 100644 --- a/src/frontend/fontInfo.mli +++ b/src/frontend/fontInfo.mli @@ -1,4 +1,5 @@ +open MyUtil open ConfigError open LengthInterface open HorzBox @@ -6,15 +7,21 @@ open CharBasis exception FontInfoError of font_error +type key = FontKey.t + type tag = string val initialize : unit -> unit +val add_single : abs_path -> key + +val add_ttc : abs_path -> int -> key + val get_metrics_of_word : horz_string_info -> uchar_segment list -> OutputText.t * length * length * length val get_math_char_info : math_font_abbrev -> is_in_base_level:bool -> is_in_display:bool -> is_big:bool -> font_size:length -> Uchar.t list -> OutputText.t * length * length * length * length * FontFormat.math_kern_info option -val get_font_tag : font_abbrev -> tag +val get_font_tag : key -> tag val get_math_tag : math_font_abbrev -> tag diff --git a/src/frontend/main.ml b/src/frontend/main.ml index f8537f3d3..ae5a96953 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1060,30 +1060,21 @@ let report_config_error : config_error -> unit = function let report_font_error : font_error -> unit = function - | InvalidFontAbbrev(abbrev) -> - report_error Interface [ - NormalLine (Printf.sprintf "cannot find a font named '%s'." abbrev); - ] - | InvalidMathFontAbbrev(mfabbrev) -> report_error Interface [ NormalLine(Printf.sprintf "cannot find a math font named '%s'." mfabbrev); ] - | NotASingleFont(abbrev, abspath) -> + | NotASingleFont(abspath) -> let fname = convert_abs_path_to_show abspath in report_error Interface [ - NormalLine(Printf.sprintf "the font file '%s'," fname); - NormalLine(Printf.sprintf "which is associated with the font name '%s'," abbrev); - NormalLine("is not a single font file."); + NormalLine(Printf.sprintf "the font file '%s' is not a single font file." fname); ] - | NotATTCElement(abbrev, abspath, i) -> + | NotATTCElement(abspath, index) -> let fname = convert_abs_path_to_show abspath in report_error Interface [ - NormalLine(Printf.sprintf "the font file '%s'," fname); - NormalLine(Printf.sprintf "which is associated with the font name '%s' and index %d," abbrev i); - NormalLine("is not a TrueType collection."); + NormalLine(Printf.sprintf "the font file '%s' (used with index %d) is not a collection." fname index); ] | NotASingleMathFont(mfabbrev, abspath) -> diff --git a/src/frontend/primitives.cppo.ml b/src/frontend/primitives.cppo.ml index 5e5f6d402..df2c692ee 100644 --- a/src/frontend/primitives.cppo.ml +++ b/src/frontend/primitives.cppo.ml @@ -43,6 +43,7 @@ let tPRP = (~! "pre-path" , BaseType(PrePathType)) let tPATH = (~! "path" , BaseType(PathType)) let tGR = (~! "graphics" , BaseType(GraphicsType)) let tIMG = (~! "image" , BaseType(ImageType)) +let tFONTKEY = (~! "font" , BaseType(FontType)) let tDOC = (~! "document" , BaseType(DocumentType)) let tRE = (~! "regexp" , BaseType(RegExpType)) let tTCTX = (~! "text-info" , BaseType(TextInfoType)) @@ -69,7 +70,7 @@ let tMCCLS = (~! "mccls" , variant [] vid_mccls ) let tCELL = (~! "cell" , variant [] vid_cell ) (* -- predefined alias types -- *) -let tFONT = tPROD [tS; tFL; tFL] +let tFONTWR = tPROD [tFONTKEY; tFL; tFL] let tPT = tPROD [tLN; tLN] let tDASH = tPROD [tLN; tLN; tLN] let tPADS = tPROD [tLN; tLN; tLN; tLN] diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index 68e552eb3..ef25156a8 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -689,6 +689,7 @@ type base_constant = [@printer (fun fmt _ -> Format.fprintf fmt "")] | BCImageKey of ImageInfo.key [@printer (fun fmt _ -> Format.fprintf fmt "")] + | BCFontKey of FontKey.t | BCInlineBoxes of HorzBox.horz_box list | BCBlockBoxes of HorzBox.vert_box list | BCGraphics of (HorzBox.intermediate_horz_box list) GraphicD.t @@ -1206,6 +1207,8 @@ and code_value = | CdPatternMatch of Range.t * code_value * code_pattern_branch list | CdConstructor of constructor_name * code_value | CdTuple of code_value TupleList.t + | CdLoadSingleFont of abs_path + | CdLoadCollectionFont of abs_path * int #include "__codetype.gen.ml" and code_inline_text_element = @@ -1448,6 +1451,9 @@ let rec unlift_code (code : code_value) : abstract_tree = | CdPatternMatch(rng, code1, cdpatbrs) -> PatternMatch(rng, aux code1, List.map unlift_pattern_branch cdpatbrs) | CdConstructor(constrnm, code1) -> NonValueConstructor(constrnm, aux code1) | CdTuple(codes) -> PrimitiveTuple(TupleList.map aux codes) + + | CdLoadSingleFont(abspath) -> LoadSingleFont(abspath) + | CdLoadCollectionFont(abspath, index) -> LoadCollectionFont(abspath, index) #include "__unliftcode.gen.ml" in aux code diff --git a/tools/gencode/type.ml b/tools/gencode/type.ml index 4bebe88e5..8adbdc03d 100644 --- a/tools/gencode/type.ml +++ b/tools/gencode/type.ml @@ -133,7 +133,7 @@ let tPAGEPARTS = tycon0 "tPAGEPARTS" "page-parts" let tPT = tycon0 "tPT" "point" let tPADS = tycon0 "tPADS" "paddings" let tDECOSET = tycon0 "tDECOSET" "deco-set" -let tFONT = tycon0 "tFONT" "font" +let tFONTWR = tycon0 "tFONTWR" "font-with-ratio" let tDECO = tycon0 "tDECO" "deco" let tIGR = tycon0 "tIGR" "inline-graphics" let tIGRO = tycon0 "tIGRO" "inline-graphics-outer" diff --git a/tools/gencode/type.mli b/tools/gencode/type.mli index 9ec577565..442613d6a 100644 --- a/tools/gencode/type.mli +++ b/tools/gencode/type.mli @@ -56,7 +56,7 @@ val tPAGECONTF : t val tPAGEPARTSF : t val tPADS : t val tDECOSET : t -val tFONT : t +val tFONTWR : t val tDECO : t val tIGR : t val tIGRO : t diff --git a/tools/gencode/vminst.ml b/tools/gencode/vminst.ml index d8e5472a9..523ab3365 100644 --- a/tools/gencode/vminst.ml +++ b/tools/gencode/vminst.ml @@ -937,6 +937,7 @@ make_text_mode_context (tctx, tctxsub) let width = ctx.HorzBox.paragraph_width in make_inline_boxes [ HorzEmbeddedVertBreakable{ width; contents } ] |} +(* ; inst "PrimitiveFont" ~fields:[ ] @@ -949,6 +950,7 @@ make_inline_boxes [ HorzEmbeddedVertBreakable{ width; contents } ] ~code:{| make_font_value (abbrev, size_ratio, rising_ratio) |} +*) ; inst "PrimitiveLineBreak" ~name:"line-break" ~type_:Type.(tB @-> tB @-> tCTX @-> tIB @-> tBB) @@ -1377,12 +1379,12 @@ make_length (ctx.HorzBox.font_size) |} ; inst "PrimitiveSetFont" ~name:"set-font" - ~type_:Type.(tSCR @-> tFONT @-> tCTX @-> tCTX) + ~type_:Type.(tSCR @-> tFONTWR @-> tCTX @-> tCTX) ~fields:[ ] ~params:[ param "script" ~type_:"script"; - param "font_info" ~type_:"font"; + param "font_info" ~type_:"font_with_ratio"; param "(ctx, ctxsub)" ~type_:"context"; ] ~is_pdf_mode_primitive:true @@ -1392,7 +1394,7 @@ Context(HorzBox.({ ctx with font_scheme = font_scheme_new; }), ctxsub) |} ; inst "PrimitiveGetFont" ~name:"get-font" - ~type_:Type.(tSCR @-> tCTX @-> tFONT) + ~type_:Type.(tSCR @-> tCTX @-> tFONTWR) ~fields:[ ] ~params:[ @@ -1402,7 +1404,7 @@ Context(HorzBox.({ ctx with font_scheme = font_scheme_new; }), ctxsub) ~is_pdf_mode_primitive:true ~code:{| let fontwr = HorzBox.get_font_with_ratio ctx script in -make_font_value fontwr +make_font_with_ratio_value fontwr |} ; inst "PrimitiveSetMathFont" ~name:"set-math-font" From a1b2fc821ed39319697abaa82d6e205635495ccd Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 12 Nov 2022 18:03:52 +0900 Subject: [PATCH 132/288] FIRST SUCCESS in typesetting 'demo.pdf' by using font packages --- download-fonts.sh | 8 ++-- lib-satysfi/dist/cache/registry.yaml | 20 ++++++++++ .../packages/code/code.0.0.1/satysfi.yaml | 3 ++ .../packages/code/code.0.0.1/src/code.satyh | 8 ++-- .../font-ipa-ex.0.0.1/fonts/.gitkeep | 0 .../font-ipa-ex.0.0.1/satysfi.yaml | 13 +++++++ .../font-junicode.0.0.1/fonts/.gitkeep | 0 .../font-junicode.0.0.1/satysfi.yaml | 21 +++++++++++ .../font-latin-modern.0.0.1/fonts/.gitkeep | 0 .../font-latin-modern.0.0.1/satysfi.yaml | 13 +++++++ .../std-ja-book.0.0.1/satysfi.yaml | 12 ++++++ .../std-ja-book.0.0.1/src/std-ja-book.satyh | 37 +++++++++++-------- src/backend/horzBox.ml | 5 ++- src/frontend/evalUtil.ml | 2 +- src/frontend/fontInfo.ml | 4 ++ src/frontend/main.ml | 3 +- 16 files changed, 123 insertions(+), 26 deletions(-) create mode 100644 lib-satysfi/dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/fonts/.gitkeep create mode 100644 lib-satysfi/dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/satysfi.yaml create mode 100644 lib-satysfi/dist/packages/font-junicode/font-junicode.0.0.1/fonts/.gitkeep create mode 100644 lib-satysfi/dist/packages/font-junicode/font-junicode.0.0.1/satysfi.yaml create mode 100644 lib-satysfi/dist/packages/font-latin-modern/font-latin-modern.0.0.1/fonts/.gitkeep create mode 100644 lib-satysfi/dist/packages/font-latin-modern/font-latin-modern.0.0.1/satysfi.yaml diff --git a/download-fonts.sh b/download-fonts.sh index 9435212bf..1429b35dc 100755 --- a/download-fonts.sh +++ b/download-fonts.sh @@ -47,7 +47,7 @@ download_file () { # Latin Modern NAME=lm2.004otf download_file "$NAME.zip" "http://www.gust.org.pl/projects/e-foundry/latin-modern/download/lm2.004otf.zip" -unzip -o "$CACHE/$NAME.zip" "*.otf" -d lib-satysfi/dist/fonts/ +unzip -o "$CACHE/$NAME.zip" "*.otf" -d lib-satysfi/dist/packages/font-latin-modern/font-latin-modern.0.0.1/fonts/ # Latin Modern Math NAME=latinmodern-math-1959 @@ -58,12 +58,12 @@ cp "$CACHE"/latinmodern-math-1959/otf/latinmodern-math.otf lib-satysfi/dist/font # Junicode NAME=junicode-1.002 download_file "$NAME.zip" "http://downloads.sourceforge.net/project/junicode/junicode/junicode-1.002/junicode-1.002.zip" -unzip -o "$CACHE/$NAME.zip" "*.ttf" -d lib-satysfi/dist/fonts/ +unzip -o "$CACHE/$NAME.zip" "*.ttf" -d lib-satysfi/dist/packages/font-junicode/font-junicode.0.0.1/fonts/ # IPAexfont NAME=IPAexfont00401 download_file "$NAME.zip" "https://moji.or.jp/wp-content/ipafont/IPAexfont/IPAexfont00401.zip" unzip -o "$CACHE/$NAME.zip" "*.ttf" -d "$CACHE/" -cp "$CACHE"/IPAexfont00401/ipaexg.ttf lib-satysfi/dist/fonts/ -cp "$CACHE"/IPAexfont00401/ipaexm.ttf lib-satysfi/dist/fonts/ +cp "$CACHE"/IPAexfont00401/ipaexg.ttf lib-satysfi/dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/fonts/ +cp "$CACHE"/IPAexfont00401/ipaexm.ttf lib-satysfi/dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/fonts/ show_message "end." diff --git a/lib-satysfi/dist/cache/registry.yaml b/lib-satysfi/dist/cache/registry.yaml index 2d39b28d5..dec7f8a33 100644 --- a/lib-satysfi/dist/cache/registry.yaml +++ b/lib-satysfi/dist/cache/registry.yaml @@ -15,6 +15,8 @@ packages: dependencies: - name: "stdlib" requirements: [ "0.0.1" ] + - name: "font-latin-modern" + requirements: [ "0.0.1" ] - name: "annot" implementations: - version: "0.0.1" @@ -71,6 +73,12 @@ packages: requirements: [ "0.0.1" ] - name: "footnote-scheme" requirements: [ "0.0.1" ] + - name: "font-junicode" + requirements: [ "0.0.1" ] + - name: "font-latin-modern" + requirements: [ "0.0.1" ] + - name: "font-ipa-ex" + requirements: [ "0.0.1" ] - name: "std-ja-report" implementations: - version: "0.0.1" @@ -85,3 +93,15 @@ packages: requirements: [ "0.0.1" ] - name: "footnote-scheme" requirements: [ "0.0.1" ] +- name: "font-latin-modern" + implementations: + - version: "0.0.1" + dependencies: [] +- name: "font-junicode" + implementations: + - version: "0.0.1" + dependencies: [] +- name: "font-ipa-ex" + implementations: + - version: "0.0.1" + dependencies: [] diff --git a/lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml index a3ff270db..b2ad01a6d 100644 --- a/lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml @@ -8,3 +8,6 @@ contents: - name: "stdlib" requirements: - "0.0.1" + - name: "latin-modern" + requirements: + - "0.0.1" diff --git a/lib-satysfi/dist/packages/code/code.0.0.1/src/code.satyh b/lib-satysfi/dist/packages/code/code.0.0.1/src/code.satyh index 17d9b11d4..910188696 100644 --- a/lib-satysfi/dist/packages/code/code.0.0.1/src/code.satyh +++ b/lib-satysfi/dist/packages/code/code.0.0.1/src/code.satyh @@ -1,5 +1,7 @@ use package open Stdlib +use package FontLatinModern + module Code % :> sig % @@ -16,7 +18,7 @@ module Code = struct signature S = sig - val font-family : string + val font-family : font val text-color : color val fill-color : color val stroke-color : color @@ -110,7 +112,7 @@ module Code module DefaultSettings = struct - val font-family = `lmmono` + val font-family = FontLatinModern.mono val text-color = Gray(0.) val fill-color = Gray(0.875) val stroke-color = Gray(0.625) @@ -122,7 +124,7 @@ module Code module ConsoleSettings = struct - val font-family = `lmmono` + val font-family = FontLatinModern.mono val text-color = Gray(1.) val fill-color = Gray(0.25) val stroke-color = Gray(0.25) diff --git a/lib-satysfi/dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/fonts/.gitkeep b/lib-satysfi/dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/fonts/.gitkeep new file mode 100644 index 000000000..e69de29bb diff --git a/lib-satysfi/dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/satysfi.yaml new file mode 100644 index 000000000..6ba386a2d --- /dev/null +++ b/lib-satysfi/dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/satysfi.yaml @@ -0,0 +1,13 @@ +language: "0.1.0" +contents: + type: "font" + main_module: "FontIpaEx" + elements: + - path: "./fonts/ipaexm.ttf" + contents: + type: "opentype_single" + name: "mincho" + - path: "./fonts/ipaexg.ttf" + contents: + type: "opentype_single" + name: "gothic" diff --git a/lib-satysfi/dist/packages/font-junicode/font-junicode.0.0.1/fonts/.gitkeep b/lib-satysfi/dist/packages/font-junicode/font-junicode.0.0.1/fonts/.gitkeep new file mode 100644 index 000000000..e69de29bb diff --git a/lib-satysfi/dist/packages/font-junicode/font-junicode.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/font-junicode/font-junicode.0.0.1/satysfi.yaml new file mode 100644 index 000000000..3dd2457e5 --- /dev/null +++ b/lib-satysfi/dist/packages/font-junicode/font-junicode.0.0.1/satysfi.yaml @@ -0,0 +1,21 @@ +language: "0.1.0" +contents: + type: "font" + main_module: "FontJunicode" + elements: + - path: "./fonts/Junicode.ttf" + contents: + type: "opentype_single" + name: "normal" + - path: "./fonts/Junicode-Bold.ttf" + contents: + type: "opentype_single" + name: "bold" + - path: "./fonts/Junicode-Italic.ttf" + contents: + type: "opentype_single" + name: "italic" + - path: "./fonts/Junicode-BoldItalic.ttf" + contents: + type: "opentype_single" + name: "bold-italic" diff --git a/lib-satysfi/dist/packages/font-latin-modern/font-latin-modern.0.0.1/fonts/.gitkeep b/lib-satysfi/dist/packages/font-latin-modern/font-latin-modern.0.0.1/fonts/.gitkeep new file mode 100644 index 000000000..e69de29bb diff --git a/lib-satysfi/dist/packages/font-latin-modern/font-latin-modern.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/font-latin-modern/font-latin-modern.0.0.1/satysfi.yaml new file mode 100644 index 000000000..f5f926eff --- /dev/null +++ b/lib-satysfi/dist/packages/font-latin-modern/font-latin-modern.0.0.1/satysfi.yaml @@ -0,0 +1,13 @@ +language: "0.1.0" +contents: + type: "font" + main_module: "FontLatinModern" + elements: + - path: "./fonts/lmmono10-regular.otf" + contents: + type: "opentype_single" + name: "mono" + - path: "./fonts/lmsans10-regular.otf" + contents: + type: "opentype_single" + name: "sans" diff --git a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml index eb98e44f6..44f68f351 100644 --- a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml @@ -24,3 +24,15 @@ contents: - name: "footnote-scheme" requirements: - "0.0.1" + + - name: "font-junicode" + requirements: + - "0.0.1" + + - name: "font-latin-modern" + requirements: + - "0.0.1" + + - name: "font-ipa-ex" + requirements: + - "0.0.1" diff --git a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh index a35017e6c..266b2ff56 100644 --- a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh +++ b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh @@ -4,6 +4,10 @@ use package Annot use package Code use package FootnoteScheme +use package FontJunicode +use package FontIpaEx +use package FontLatinModern + module StdJaBook :> sig @@ -25,15 +29,15 @@ module StdJaBook :> sig author : inline-text, |) -> block-text -> document - val font-latin-roman : string * float * float - val font-latin-bold : string * float * float - val font-latin-italic : string * float * float - val font-latin-sans : string * float * float - val font-latin-mono : string * float * float - val font-cjk-mincho : string * float * float - val font-cjk-gothic : string * float * float - val set-latin-font : (string * float * float) -> context -> context - val set-cjk-font : (string * float * float) -> context -> context + val font-latin-roman : font * float * float + val font-latin-bold : font * float * float + val font-latin-italic : font * float * float + val font-latin-sans : font * float * float + val font-latin-mono : font * float * float + val font-cjk-mincho : font * float * float + val font-cjk-gothic : font * float * float + val set-latin-font : (font * float * float) -> context -> context + val set-cjk-font : (font * float * float) -> context -> context val \ref : inline [string] val \ref-page : inline [string] @@ -107,13 +111,13 @@ end = struct val font-ratio-latin = 1. val font-ratio-cjk = 0.88 - val font-latin-roman = (`Junicode` , font-ratio-latin, 0.) - val font-latin-bold = (`Junicode-b` , font-ratio-latin, 0.) - val font-latin-italic = (`Junicode-it`, font-ratio-latin, 0.) - val font-latin-sans = (`lmsans` , font-ratio-latin, 0.) - val font-latin-mono = (`lmmono` , font-ratio-latin, 0.) - val font-cjk-mincho = (`ipaexm` , font-ratio-cjk , 0.) - val font-cjk-gothic = (`ipaexg` , font-ratio-cjk , 0.) + val font-latin-roman = (FontJunicode.normal , font-ratio-latin, 0.) + val font-latin-bold = (FontJunicode.bold , font-ratio-latin, 0.) + val font-latin-italic = (FontJunicode.italic , font-ratio-latin, 0.) + val font-latin-sans = (FontLatinModern.sans, font-ratio-latin, 0.) + val font-latin-mono = (FontLatinModern.mono, font-ratio-latin, 0.) + val font-cjk-mincho = (FontIpaEx.mincho , font-ratio-cjk , 0.) + val font-cjk-gothic = (FontIpaEx.gothic , font-ratio-cjk , 0.) val set-latin-font font ctx = @@ -136,6 +140,7 @@ end = struct |> set-font Kana font-cjk-mincho |> set-font HanIdeographic font-cjk-mincho |> set-font Latin font-latin-roman + |> set-font OtherScript font-cjk-mincho |> set-math-font `lmodern` |> set-hyphen-penalty 100 diff --git a/src/backend/horzBox.ml b/src/backend/horzBox.ml index 9274f1d4c..8e85bfe18 100644 --- a/src/backend/horzBox.ml +++ b/src/backend/horzBox.ml @@ -4,6 +4,9 @@ open LengthInterface open GraphicBase +exception NoFontIsSet of CharBasis.script * CharBasis.script + + type pure_badness = int [@@deriving show] @@ -518,7 +521,7 @@ let normalize_script ctx script_raw = let get_font_with_ratio ctx script_raw = let script = normalize_script ctx script_raw in match ctx.font_scheme |> CharBasis.ScriptSchemeMap.find_opt script with - | None -> failwith "get_font_with_ratio" + | None -> raise (NoFontIsSet(script_raw, script)) | Some(fontsch) -> fontsch diff --git a/src/frontend/evalUtil.ml b/src/frontend/evalUtil.ml index ce0b33ae3..a13ac13dc 100644 --- a/src/frontend/evalUtil.ml +++ b/src/frontend/evalUtil.ml @@ -178,7 +178,7 @@ let get_font_with_ratio (value : syntactic_value) : HorzBox.font_with_ratio = (fontkey, sizer, risingr) | _ -> - report_bug_value "interpret_font" value + report_bug_value "get_font_with_ratio" value let make_font_with_ratio_value ((fontkey, sizer, risingr) : HorzBox.font_with_ratio) = diff --git a/src/frontend/fontInfo.ml b/src/frontend/fontInfo.ml index 111d8af71..d0479ceb6 100644 --- a/src/frontend/fontInfo.ml +++ b/src/frontend/fontInfo.ml @@ -48,6 +48,7 @@ end = struct let initialize () = + Printf.printf "**** INITIALIZE\n"; (* TODO: remove this *) Ht.clear abbrev_to_definition_hash_table; FontKey.initialize (); current_tag_number := 0 @@ -63,6 +64,7 @@ end = struct let key = FontKey.generate () in let storeref = ref UnusedSingle in Ht.add abbrev_to_definition_hash_table key (abspath, storeref); + Printf.printf "**** %s = SINGLE %s\n" (FontKey.show key) (get_abs_path_string abspath); (* TODO: remove this *) key @@ -71,6 +73,7 @@ end = struct let key = FontKey.generate () in let storeref = ref (UnusedTTC(index)) in Ht.add abbrev_to_definition_hash_table key (abspath, storeref); + Printf.printf "**** %s = TTC %s, %d\n" (FontKey.show key) (get_abs_path_string abspath) index; (* TODO: remove this *) key @@ -87,6 +90,7 @@ end = struct let open ResultMonad in match Ht.find_opt abbrev_to_definition_hash_table key with | None -> + Printf.printf "**** FIND %s\n" (FontKey.show key); assert false | Some((abspath, storeref)) -> diff --git a/src/frontend/main.ml b/src/frontend/main.ml index ae5a96953..ae2d01f63 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -18,7 +18,6 @@ let reset () = if OptionState.is_text_mode () then return () else begin - FontInfo.initialize (); ImageInfo.initialize (); NamedDest.initialize (); return () @@ -31,6 +30,7 @@ let initialize () : Typeenv.t * environment = BoundID.initialize (); EvalVarID.initialize (); StoreID.initialize (); + FontInfo.initialize (); let res = if OptionState.is_text_mode () then Primitives.make_text_mode_environments () @@ -184,6 +184,7 @@ let preprocess_and_evaluate (env : environment) (libs : (abs_path * binding list regardless of whether `--bytecomp` was specified. *) let (env, codebindacc) = libs |> List.fold_left (fun (env, codebindacc) (abspath, binds) -> + Logging.begin_to_preprocess_file abspath; let (env, cd_rec_or_nonrecs) = Evaluator.interpret_bindings_0 env binds in (env, Alist.extend codebindacc (abspath, cd_rec_or_nonrecs)) ) (env, Alist.empty) From 61edbf98755fec55a2864f5a5123cabfeb4b0748 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 12 Nov 2022 18:21:01 +0900 Subject: [PATCH 133/288] slight refactoring --- src/backend/handlePdf.ml | 4 ++-- src/backend/horzBox.ml | 6 +++--- src/frontend/fontInfo.ml | 18 +++++++++--------- 3 files changed, 14 insertions(+), 14 deletions(-) diff --git a/src/backend/handlePdf.ml b/src/backend/handlePdf.ml index c8ffedb83..64abc0beb 100644 --- a/src/backend/handlePdf.ml +++ b/src/backend/handlePdf.ml @@ -23,8 +23,8 @@ type 'o op_funcs = { } -let pdfops_of_text hsinfo pt otxt = - let tag = FontInfo.get_font_tag hsinfo.font_abbrev in +let pdfops_of_text (hsinfo : horz_string_info) pt otxt = + let tag = FontInfo.get_font_tag hsinfo.font_key in GraphicD.pdfops_of_text pt tag hsinfo.text_font_size hsinfo.text_color otxt diff --git a/src/backend/horzBox.ml b/src/backend/horzBox.ml index 8e85bfe18..1bc9abb01 100644 --- a/src/backend/horzBox.ml +++ b/src/backend/horzBox.ml @@ -66,7 +66,7 @@ type paddings = { type horz_string_info = { - font_abbrev : FontKey.t; + font_key : FontKey.t; text_font_size : length; text_color : color; rising : length; @@ -533,9 +533,9 @@ let get_language_system ctx script_raw = let get_string_info ctx script_raw = - let (font_abbrev, ratio, rising_ratio) = get_font_with_ratio ctx script_raw in + let (fontkey, ratio, rising_ratio) = get_font_with_ratio ctx script_raw in { - font_abbrev = font_abbrev; + font_key = fontkey; text_font_size = ctx.font_size *% ratio; text_color = ctx.text_color; rising = ctx.manual_rising +% ctx.font_size *% rising_ratio; diff --git a/src/frontend/fontInfo.ml b/src/frontend/fontInfo.ml index d0479ceb6..a3d71207f 100644 --- a/src/frontend/fontInfo.ml +++ b/src/frontend/fontInfo.ml @@ -42,14 +42,14 @@ end = struct module Ht = Hashtbl.Make(FontKey) - let abbrev_to_definition_hash_table : (abs_path * font_store ref) Ht.t = Ht.create 32 + let key_to_definition_hash_table : (abs_path * font_store ref) Ht.t = Ht.create 32 let current_tag_number = ref 0 let initialize () = Printf.printf "**** INITIALIZE\n"; (* TODO: remove this *) - Ht.clear abbrev_to_definition_hash_table; + Ht.clear key_to_definition_hash_table; FontKey.initialize (); current_tag_number := 0 @@ -63,7 +63,7 @@ end = struct let add_single (abspath : abs_path) : key = let key = FontKey.generate () in let storeref = ref UnusedSingle in - Ht.add abbrev_to_definition_hash_table key (abspath, storeref); + Ht.add key_to_definition_hash_table key (abspath, storeref); Printf.printf "**** %s = SINGLE %s\n" (FontKey.show key) (get_abs_path_string abspath); (* TODO: remove this *) key @@ -72,7 +72,7 @@ end = struct let add_ttc (abspath : abs_path) (index : int) : key = let key = FontKey.generate () in let storeref = ref (UnusedTTC(index)) in - Ht.add abbrev_to_definition_hash_table key (abspath, storeref); + Ht.add key_to_definition_hash_table key (abspath, storeref); Printf.printf "**** %s = TTC %s, %d\n" (FontKey.show key) (get_abs_path_string abspath) index; (* TODO: remove this *) key @@ -83,14 +83,14 @@ end = struct | UnusedSingle -> acc (* Ignores unused fonts *) | UnusedTTC(_) -> acc (* Ignores unused fonts *) | Loaded(dfn) -> f key dfn acc - ) abbrev_to_definition_hash_table init + ) key_to_definition_hash_table init let find (key : key) : font_definition ok = let open ResultMonad in - match Ht.find_opt abbrev_to_definition_hash_table key with + match Ht.find_opt key_to_definition_hash_table key with | None -> - Printf.printf "**** FIND %s\n" (FontKey.show key); + Printf.printf "**** FIND %s\n" (FontKey.show key); (* TODO: remove this *) assert false | Some((abspath, storeref)) -> @@ -204,9 +204,9 @@ let get_glyph_id dcdr uch = let get_metrics_of_word (hsinfo : horz_string_info) (uchseglst : uchar_segment list) : OutputText.t * length * length * length = - let font_abbrev = hsinfo.font_abbrev in + let fontkey = hsinfo.font_key in let f_skip = raw_length_to_skip_length hsinfo.text_font_size in - let dfn = get_font_definition_exn font_abbrev in + let dfn = get_font_definition_exn fontkey in let dcdr = dfn.decoder in let gseglst = uchseglst |> List.map (fun (ubase, umarks) -> From 0849d2da2302958edd775519a7a9cea4f448276e Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 12 Nov 2022 19:14:12 +0900 Subject: [PATCH 134/288] replace 'math_font_abbrev' with 'FontKey.t' --- download-fonts.sh | 2 +- lib-satysfi/dist/cache/registry.yaml | 6 + .../fonts/.gitkeep | 0 .../font-latin-modern-math.0.0.1/satysfi.yaml | 10 + .../std-ja-book.0.0.1/satysfi.yaml | 4 + .../std-ja-book.0.0.1/src/std-ja-book.satyh | 3 +- src/backend/handlePdf.ml | 2 +- src/backend/horzBox.ml | 11 +- src/frontend/bytecomp/ir.cppo.ml | 4 +- src/frontend/configError.ml | 6 +- src/frontend/context.ml | 22 +- src/frontend/context.mli | 2 +- src/frontend/evalUtil.ml | 6 + src/frontend/evaluator.cppo.ml | 26 +- src/frontend/fontInfo.ml | 262 +++++++++--------- src/frontend/fontInfo.mli | 14 +- src/frontend/main.ml | 17 +- src/frontend/math.ml | 4 +- src/frontend/mathKernScheme.ml | 4 +- src/frontend/packageChecker.ml | 19 +- src/frontend/packageConfig.ml | 3 + src/frontend/packageConfig.mli | 1 + src/frontend/packageReader.ml | 8 +- src/frontend/primitives.cppo.ml | 2 +- src/frontend/types.cppo.ml | 39 ++- tools/gencode/type.ml | 1 + tools/gencode/type.mli | 1 + tools/gencode/vminst.ml | 10 +- 28 files changed, 285 insertions(+), 204 deletions(-) create mode 100644 lib-satysfi/dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/fonts/.gitkeep create mode 100644 lib-satysfi/dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/satysfi.yaml diff --git a/download-fonts.sh b/download-fonts.sh index 1429b35dc..ae3174ce7 100755 --- a/download-fonts.sh +++ b/download-fonts.sh @@ -53,7 +53,7 @@ unzip -o "$CACHE/$NAME.zip" "*.otf" -d lib-satysfi/dist/packages/font-latin-mode NAME=latinmodern-math-1959 download_file "$NAME.zip" "http://www.gust.org.pl/projects/e-foundry/lm-math/download/latinmodern-math-1959.zip" unzip -o "$CACHE/$NAME.zip" "*.otf" -d "$CACHE/" -cp "$CACHE"/latinmodern-math-1959/otf/latinmodern-math.otf lib-satysfi/dist/fonts/ +cp "$CACHE"/latinmodern-math-1959/otf/latinmodern-math.otf lib-satysfi/dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/fonts/ # Junicode NAME=junicode-1.002 diff --git a/lib-satysfi/dist/cache/registry.yaml b/lib-satysfi/dist/cache/registry.yaml index dec7f8a33..7ad24ea4e 100644 --- a/lib-satysfi/dist/cache/registry.yaml +++ b/lib-satysfi/dist/cache/registry.yaml @@ -79,6 +79,8 @@ packages: requirements: [ "0.0.1" ] - name: "font-ipa-ex" requirements: [ "0.0.1" ] + - name: "font-latin-modern-math" + requirements: [ "0.0.1" ] - name: "std-ja-report" implementations: - version: "0.0.1" @@ -105,3 +107,7 @@ packages: implementations: - version: "0.0.1" dependencies: [] +- name: "font-latin-modern-math" + implementations: + - version: "0.0.1" + dependencies: [] diff --git a/lib-satysfi/dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/fonts/.gitkeep b/lib-satysfi/dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/fonts/.gitkeep new file mode 100644 index 000000000..e69de29bb diff --git a/lib-satysfi/dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/satysfi.yaml new file mode 100644 index 000000000..ce2d09482 --- /dev/null +++ b/lib-satysfi/dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/satysfi.yaml @@ -0,0 +1,10 @@ +language: "0.1.0" +contents: + type: "font" + main_module: "FontLatinModernMath" + elements: + - path: "./fonts/latinmodern-math.otf" + math: true + contents: + type: "opentype_single" + name: "main" diff --git a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml index 44f68f351..02517dafd 100644 --- a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml @@ -36,3 +36,7 @@ contents: - name: "font-ipa-ex" requirements: - "0.0.1" + + - name: "font-latin-modern-math" + requirements: + - "0.0.1" diff --git a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh index 266b2ff56..5e5986901 100644 --- a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh +++ b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh @@ -7,6 +7,7 @@ use package FootnoteScheme use package FontJunicode use package FontIpaEx use package FontLatinModern +use package FontLatinModernMath module StdJaBook :> sig @@ -141,7 +142,7 @@ end = struct |> set-font HanIdeographic font-cjk-mincho |> set-font Latin font-latin-roman |> set-font OtherScript font-cjk-mincho - |> set-math-font `lmodern` + |> set-math-font FontLatinModernMath.main |> set-hyphen-penalty 100 diff --git a/src/backend/handlePdf.ml b/src/backend/handlePdf.ml index 64abc0beb..bfeaf83a8 100644 --- a/src/backend/handlePdf.ml +++ b/src/backend/handlePdf.ml @@ -29,7 +29,7 @@ let pdfops_of_text (hsinfo : horz_string_info) pt otxt = let pdfops_of_math (msinfo : math_string_info) pt otxt = - let tag = FontInfo.get_math_tag msinfo.info_math_font_abbrev in + let tag = FontInfo.get_math_tag msinfo.info_math_font_key in GraphicD.pdfops_of_text pt tag msinfo.info_math_font_size msinfo.info_math_color otxt diff --git a/src/backend/horzBox.ml b/src/backend/horzBox.ml index 1bc9abb01..5e7262ee8 100644 --- a/src/backend/horzBox.ml +++ b/src/backend/horzBox.ml @@ -29,9 +29,6 @@ type reachability = | Reachable of ratios [@@deriving show] -type math_font_abbrev = string -[@@deriving show] - type file_path = string type font_with_size = FontKey.t * Length.t @@ -74,9 +71,9 @@ type horz_string_info = { [@@deriving show { with_path = false }] type math_string_info = { - info_math_font_abbrev : math_font_abbrev; - info_math_font_size : length; - info_math_color : color; + info_math_font_key : FontKey.t; + info_math_font_size : length; + info_math_color : color; } [@@deriving show { with_path = false }] @@ -187,7 +184,7 @@ type context_main = { space_math_prefix : float * float * float; left_hyphen_min : int; right_hyphen_min : int; - math_font_abbrev : math_font_abbrev; + math_font_key : FontKey.t option; math_script_level : math_script_level; } diff --git a/src/frontend/bytecomp/ir.cppo.ml b/src/frontend/bytecomp/ir.cppo.ml index d3fbb503b..cdecf425d 100644 --- a/src/frontend/bytecomp/ir.cppo.ml +++ b/src/frontend/bytecomp/ir.cppo.ml @@ -574,7 +574,7 @@ and transform_1 (env : frame) (ast : abstract_tree) : ir * frame = | LoadSingleFont(_) -> failwith "TODO: LoadSingleFont" - | LoadCollectionFont(_, _) -> + | LoadCollectionFont(_) -> failwith "TODO: LoadCollectionFont" #include "__ir_1.gen.ml" @@ -765,7 +765,7 @@ and transform_0 (env : frame) (ast : abstract_tree) : ir * frame = | LoadSingleFont(_) -> failwith "TODO: LoadSingleFont" - | LoadCollectionFont(_, _) -> + | LoadCollectionFont(_) -> failwith "TODO: LoadCollectionFont" #include "__ir_0.gen.ml" diff --git a/src/frontend/configError.ml b/src/frontend/configError.ml index 14a70a9cd..8a9e4d2b5 100644 --- a/src/frontend/configError.ml +++ b/src/frontend/configError.ml @@ -1,7 +1,6 @@ open MyUtil open Types -open HorzBox type yaml_error = @@ -75,9 +74,8 @@ type config_error = | DocumentAttributeError of DocumentAttribute.error type font_error = - | InvalidMathFontAbbrev of math_font_abbrev | NotASingleFont of abs_path | NotATTCElement of abs_path * int - | NotASingleMathFont of math_font_abbrev * abs_path - | NotATTCMathFont of math_font_abbrev * abs_path * int + | NotASingleMathFont of abs_path + | NotATTCMathFont of abs_path * int | CannotFindLibraryFileAsToFont of lib_path * abs_path list diff --git a/src/frontend/context.ml b/src/frontend/context.ml index e03405a39..0c49177ce 100644 --- a/src/frontend/context.ml +++ b/src/frontend/context.ml @@ -3,6 +3,8 @@ open Types open LengthInterface +exception MathFontIsNotSet + type t = input_context @@ -40,18 +42,20 @@ let font_size ((ctx, _) : t) = ctx.font_size -let math_font_abbrev ((ctx, _) : t) = - ctx.math_font_abbrev +let math_font_key_exn ((ctx, _) : t) = + match ctx.math_font_key with + | None -> raise MathFontIsNotSet + | Some(mathkey) -> mathkey let get_math_constants (ictx : input_context) = - let mfabbrev = math_font_abbrev ictx in - FontInfo.get_math_constants mfabbrev + let mathkey = math_font_key_exn ictx in + FontInfo.get_math_constants mathkey let enter_script (ictx : t) : t = - let mfabbrev = math_font_abbrev ictx in - let mc = FontInfo.get_math_constants mfabbrev in + let mathkey = math_font_key_exn ictx in + let mc = FontInfo.get_math_constants mathkey in let (ctx, ctxsub) = ictx in let size = ctx.font_size in let ctx = @@ -82,7 +86,7 @@ let is_in_base_level ((ctx, _) : t) = let get_math_string_info (ictx : t) : HorzBox.math_string_info = { - info_math_font_abbrev = math_font_abbrev ictx; - info_math_font_size = font_size ictx; - info_math_color = color ictx; + info_math_font_key = math_font_key_exn ictx; + info_math_font_size = font_size ictx; + info_math_color = color ictx; } diff --git a/src/frontend/context.mli b/src/frontend/context.mli index 0bc990980..4c832391b 100644 --- a/src/frontend/context.mli +++ b/src/frontend/context.mli @@ -19,7 +19,7 @@ val is_in_base_level : t -> bool val font_size : t -> length -val math_font_abbrev : t -> HorzBox.math_font_abbrev +val math_font_key_exn : t -> FontKey.t val get_math_constants : t -> FontFormat.math_constants diff --git a/src/frontend/evalUtil.ml b/src/frontend/evalUtil.ml index a13ac13dc..cefca8bf8 100644 --- a/src/frontend/evalUtil.ml +++ b/src/frontend/evalUtil.ml @@ -168,6 +168,12 @@ let get_decoset (value : syntactic_value) = report_bug_value "interpret_decoset" value +let get_font_key (value : syntactic_value) : FontKey.t = + match value with + | BaseConstant(BCFontKey(fontkey)) -> fontkey + | _ -> report_bug_value "get_font_key" value + + let get_font_with_ratio (value : syntactic_value) : HorzBox.font_with_ratio = match value with | Tuple([ diff --git a/src/frontend/evaluator.cppo.ml b/src/frontend/evaluator.cppo.ml index be7939733..090ba3e65 100644 --- a/src/frontend/evaluator.cppo.ml +++ b/src/frontend/evaluator.cppo.ml @@ -413,12 +413,22 @@ and interpret_0 (env : environment) (ast : abstract_tree) : syntactic_value = | ASTCodeSymbol(_symb) -> report_bug_ast "ASTCodeSymbol(_) at stage 0" ast - | LoadSingleFont(abspath_font) -> - let fontkey = FontInfo.add_single abspath_font in + | LoadSingleFont{ path; used_as_math_font } -> + let fontkey = + if used_as_math_font then + FontInfo.add_math_single path + else + FontInfo.add_single path + in BaseConstant(BCFontKey(fontkey)) - | LoadCollectionFont(abspath_font, index) -> - let fontkey = FontInfo.add_ttc abspath_font index in + | LoadCollectionFont{ path; index; used_as_math_font } -> + let fontkey = + if used_as_math_font then + FontInfo.add_math_ttc path index + else + FontInfo.add_ttc path index + in BaseConstant(BCFontKey(fontkey)) #include "__evaluator_0.gen.ml" @@ -594,11 +604,11 @@ and interpret_1 (env : environment) (ast : abstract_tree) : code_value = | ASTCodeSymbol(symb) -> CdContentOf(Range.dummy "ASTCodeSymbol", symb) - | LoadSingleFont(abspath_font) -> - CdLoadSingleFont(abspath_font) + | LoadSingleFont{ path; used_as_math_font } -> + CdLoadSingleFont{ path; used_as_math_font } - | LoadCollectionFont(abspath_font, index) -> - CdLoadCollectionFont(abspath_font, index) + | LoadCollectionFont{ path; index; used_as_math_font } -> + CdLoadCollectionFont{ path; index; used_as_math_font } #include "__evaluator_1.gen.ml" diff --git a/src/frontend/fontInfo.ml b/src/frontend/fontInfo.ml index a3d71207f..3d3b55bdf 100644 --- a/src/frontend/fontInfo.ml +++ b/src/frontend/fontInfo.ml @@ -14,6 +14,8 @@ type tag = string type key = FontKey.t +type math_key = FontKey.t + type font_definition = { font_tag : tag; font : FontFormat.font; @@ -231,154 +233,157 @@ type math_font_definition = { } -module MathFontAbbrevHashTable -: sig - val initialize : unit -> unit - val add_single : math_font_abbrev -> lib_path -> unit - val add_ttc : math_font_abbrev -> lib_path -> int -> unit - val fold : (math_font_abbrev -> math_font_definition -> 'a -> 'a) -> 'a -> 'a - val find : math_font_abbrev -> math_font_definition ok - end -= struct - - type math_font_store = - | UnusedMathSingle - | UnusedMathTTC of int - | LoadedMath of math_font_definition - - module Ht = Hashtbl.Make - (struct - type t = math_font_abbrev - let equal = (=) - let hash = Hashtbl.hash - end) - - let abbrev_to_definition_hash_table : (lib_path * math_font_store ref) Ht.t = Ht.create 32 - - let current_tag_number = ref 0 - - - let initialize () = - Ht.clear abbrev_to_definition_hash_table; - current_tag_number := 0 - - - let generate_tag () = - incr current_tag_number; - "/M" ^ (string_of_int !current_tag_number) - - - let add_single mfabbrev relpath = - match mfabbrev |> Ht.find_opt abbrev_to_definition_hash_table with - | Some((relpath, _)) -> - Logging.warn_duplicate_math_font_hash mfabbrev relpath - - | None -> - let storeref = ref UnusedMathSingle in - Ht.add abbrev_to_definition_hash_table mfabbrev (relpath, storeref) - - - let add_ttc mfabbrev relpath i = - if mfabbrev |> Ht.mem abbrev_to_definition_hash_table then - Logging.warn_duplicate_font_hash mfabbrev relpath - else - let storeref = ref (UnusedMathTTC(i)) in - Ht.add abbrev_to_definition_hash_table mfabbrev (relpath, storeref) - - - let fold f init = - Ht.fold (fun mfabbrev (_, storeref) acc -> - match !storeref with - | UnusedMathSingle -> acc (* Ignores unused math fonts *) - | UnusedMathTTC(_) -> acc (* Ignores unused math fonts *) - | LoadedMath(mfdfn) -> f mfabbrev mfdfn acc - ) abbrev_to_definition_hash_table init - - - let find (mfabbrev : math_font_abbrev) : math_font_definition ok = - let open ResultMonad in - match Ht.find_opt abbrev_to_definition_hash_table mfabbrev with - | None -> - err @@ InvalidMathFontAbbrev(mfabbrev) - - | Some((relpath, storeref)) -> - begin - match !storeref with - | UnusedMathSingle -> - (* If this is the first access to the single math font: *) - let* abspath = resolve_lib_file relpath in - begin - match FontFormat.get_math_decoder_single (mfabbrev ^ "-Composite-Math") (* temporary *) abspath with - | None -> - (* If the font file does not have a MATH table or is a TrueType collection: *) - err @@ NotASingleMathFont(mfabbrev, abspath) - - | Some((md, font)) -> - let tag = generate_tag () in - let mfdfn = { math_font_tag = tag; math_font = font; math_decoder = md; } in - storeref := LoadedMath(mfdfn); - return mfdfn - end - - | UnusedMathTTC(i) -> - (* If this is the first access to the collection math font: *) - let* abspath = resolve_lib_file relpath in - begin - match FontFormat.get_math_decoder_ttc (mfabbrev ^ "-Composite-Math") (* temporary *) abspath i with - | None -> - (* If the font does not have a MATH table or is a single font file: *) - err @@ NotATTCMathFont(mfabbrev, abspath, i) - - | Some((md, font)) -> - let tag = generate_tag () in - let mfdfn = { math_font_tag = tag; math_font = font; math_decoder = md; } in - storeref := LoadedMath(mfdfn); - return mfdfn - end - - | LoadedMath(mfdfn) -> - return mfdfn - end - - end - - -let find_math_font_definition_exn (mfabbrev : math_font_abbrev) = - match MathFontAbbrevHashTable.find mfabbrev with +module MathFontHashTable : sig + val initialize : unit -> unit + val add_single : abs_path -> math_key + val add_ttc : abs_path -> int -> math_key + val fold : (math_key -> math_font_definition -> 'a -> 'a) -> 'a -> 'a + val find : math_key -> math_font_definition ok +end = struct + + type math_font_store = + | UnusedMathSingle + | UnusedMathTTC of int + | LoadedMath of math_font_definition + + module Ht = Hashtbl.Make(FontKey) + + let key_to_definition_hash_table : (abs_path * math_font_store ref) Ht.t = Ht.create 32 + + let current_tag_number = ref 0 + + + let initialize () = + Printf.printf "**** INITIALIZE MATH\n"; (* TODO: remove this *) + Ht.clear key_to_definition_hash_table; + current_tag_number := 0 + + + let generate_tag () = + incr current_tag_number; + "/M" ^ (string_of_int !current_tag_number) + + + let add_single (abspath : abs_path) : math_key = + let mathkey = FontKey.generate () in + let storeref = ref UnusedMathSingle in + Ht.add key_to_definition_hash_table mathkey (abspath, storeref); + Printf.printf "**** %s = MATH SINGLE %s\n" (FontKey.show mathkey) (get_abs_path_string abspath); (* TODO: remove this *) + mathkey + + + let add_ttc (abspath : abs_path) (index : int) : math_key = + let mathkey = FontKey.generate () in + let storeref = ref (UnusedMathTTC(index)) in + Ht.add key_to_definition_hash_table mathkey (abspath, storeref); + Printf.printf "**** %s = MATH TTC %s, %d\n" (FontKey.show mathkey) (get_abs_path_string abspath) index; (* TODO: remove this *) + mathkey + + + let fold f init = + Ht.fold (fun mathkey (_, storeref) acc -> + match !storeref with + | UnusedMathSingle -> acc (* Ignores unused math fonts *) + | UnusedMathTTC(_) -> acc (* Ignores unused math fonts *) + | LoadedMath(mfdfn) -> f mathkey mfdfn acc + ) key_to_definition_hash_table init + + + let find (mathkey : math_key) : math_font_definition ok = + let open ResultMonad in + match Ht.find_opt key_to_definition_hash_table mathkey with + | None -> + Printf.printf "**** FIND MATH %s\n" (FontKey.show mathkey); (* TODO: remove this *) + assert false + + | Some((abspath, storeref)) -> + begin + match !storeref with + | UnusedMathSingle -> + (* If this is the first access to the single math font: *) + let fontname = Printf.sprintf "id-%s-Composite-Math" (FontKey.show mathkey) in (* TODO: fix this *) + begin + match FontFormat.get_math_decoder_single fontname abspath with + | None -> + (* If the font file does not have a MATH table or is a TrueType collection: *) + err @@ NotASingleMathFont(abspath) + + | Some((md, font)) -> + let tag = generate_tag () in + let mfdfn = { math_font_tag = tag; math_font = font; math_decoder = md; } in + storeref := LoadedMath(mfdfn); + return mfdfn + end + + | UnusedMathTTC(i) -> + (* If this is the first access to the collection math font: *) + let fontname = Printf.sprintf "id-%s-Composite-Math" (FontKey.show mathkey) in (* TODO: fix this *) + begin + match FontFormat.get_math_decoder_ttc fontname abspath i with + | None -> + (* If the font does not have a MATH table or is a single font file: *) + err @@ NotATTCMathFont(abspath, i) + + | Some((md, font)) -> + let tag = generate_tag () in + let mfdfn = { math_font_tag = tag; math_font = font; math_decoder = md; } in + storeref := LoadedMath(mfdfn); + return mfdfn + end + + | LoadedMath(mfdfn) -> + return mfdfn + end + +end + + +let add_math_single (abspath : abs_path) : math_key = + MathFontHashTable.add_single abspath + + +let add_math_ttc (abspath : abs_path) (index : int) : math_key = + MathFontHashTable.add_ttc abspath index + + +let find_math_font_definition_exn (mathkey : math_key) = + match MathFontHashTable.find mathkey with | Ok(mfdfn) -> mfdfn | Error(e) -> raise (FontInfoError(e)) -let find_math_decoder_exn (mfabbrev : math_font_abbrev) = - let mfdfn = find_math_font_definition_exn mfabbrev in +let find_math_decoder_exn (mathkey : math_key) = + let mfdfn = find_math_font_definition_exn mathkey in mfdfn.math_decoder -let get_math_tag (mfabbrev : math_font_abbrev) = - let mfdfn = find_math_font_definition_exn mfabbrev in +let get_math_tag (mathkey : math_key) = + let mfdfn = find_math_font_definition_exn mathkey in mfdfn.math_font_tag -let get_math_constants (mfabbrev : math_font_abbrev) : FontFormat.math_constants = - let md = find_math_decoder_exn mfabbrev in +let get_math_constants (mathkey : math_key) : FontFormat.math_constants = + let md = find_math_decoder_exn mathkey in FontFormat.get_math_constants md -let get_math_kern_ratio (mfabbrev : math_font_abbrev) (mkern : FontFormat.math_kern) (r : float) : float = - let mfdfn = find_math_font_definition_exn mfabbrev in +let get_math_kern_ratio (mathkey : math_key) (mkern : FontFormat.math_kern) (r : float) : float = + let mfdfn = find_math_font_definition_exn mathkey in let md = mfdfn.math_decoder in FontFormat.find_kern_ratio md mkern r -let get_math_char_info (mfabbrev : math_font_abbrev) ~(is_in_base_level : bool) ~(is_in_display : bool) ~(is_big : bool) ~(font_size : length) (uchlst : Uchar.t list) : OutputText.t * length * length * length * length * FontFormat.math_kern_info option = - let mfdfn = find_math_font_definition_exn mfabbrev in +let get_math_char_info (mathkey : math_key) ~(is_in_base_level : bool) ~(is_in_display : bool) ~(is_big : bool) ~(font_size : length) (uchlst : Uchar.t list) : OutputText.t * length * length * length * length * FontFormat.math_kern_info option = + let mfdfn = find_math_font_definition_exn mathkey in let md = mfdfn.math_decoder in let gidlst = uchlst |> List.map (fun uch -> let gidraw = match FontFormat.get_math_glyph_id md uch with | None -> - Logging.warn_no_math_glyph mfabbrev uch; +(* + Logging.warn_no_math_glyph mfabbrev uch; (* TODO: fix this *) +*) FontFormat.notdef | Some(gid) -> @@ -431,7 +436,7 @@ let get_font_dictionary (pdf : Pdf.t) : Pdf.pdfobject = let dcdr = dfn.decoder in let obj = FontFormat.make_dictionary pdf font dcdr in (tag, obj) :: acc - ) |> MathFontAbbrevHashTable.fold (fun _ mfdfn acc -> + ) |> MathFontHashTable.fold (fun _ mfdfn acc -> let tag = mfdfn.math_font_tag in let font = mfdfn.math_font in let md = mfdfn.math_decoder in @@ -446,7 +451,7 @@ let initialize () = let res = let open ResultMonad in FontHashTable.initialize (); - MathFontAbbrevHashTable.initialize (); + MathFontHashTable.initialize (); let* abspath_S = resolve_lib_file (make_lib_path "dist/unidata/Scripts.txt") in let* abspath_EAW = resolve_lib_file (make_lib_path "dist/unidata/EastAsianWidth.txt") in ScriptDataMap.set_from_file abspath_S abspath_EAW; @@ -463,7 +468,6 @@ let initialize () = if OptionState.does_show_fonts () then Logging.show_fonts font_hash; (* font_hash |> List.iter (fun (name, data) -> - let abbrev = StringFontAbbrev(name) in match data with | FontAccess.Single(relpath) -> FontAbbrevHashTable.add_single abbrev relpath | FontAccess.Collection(relpath, i) -> FontAbbrevHashTable.add_ttc abbrev relpath i @@ -478,11 +482,13 @@ let initialize () = let math_font_hash_dist = LoadFont.main abspath_mathfonts in let math_font_hash = List.append math_font_hash_local math_font_hash_dist in if OptionState.does_show_fonts () then Logging.show_math_fonts math_font_hash; +(* math_font_hash |> List.iter (fun (mfabbrev, data) -> match data with | FontAccess.Single(srcpath) -> MathFontAbbrevHashTable.add_single mfabbrev srcpath | FontAccess.Collection(srcpath, i) -> MathFontAbbrevHashTable.add_ttc mfabbrev srcpath i ); +*) return () in match res with diff --git a/src/frontend/fontInfo.mli b/src/frontend/fontInfo.mli index c6802ecc5..5db052312 100644 --- a/src/frontend/fontInfo.mli +++ b/src/frontend/fontInfo.mli @@ -9,6 +9,8 @@ exception FontInfoError of font_error type key = FontKey.t +type math_key = FontKey.t + type tag = string val initialize : unit -> unit @@ -17,16 +19,20 @@ val add_single : abs_path -> key val add_ttc : abs_path -> int -> key +val add_math_single : abs_path -> key + +val add_math_ttc : abs_path -> int -> key + val get_metrics_of_word : horz_string_info -> uchar_segment list -> OutputText.t * length * length * length -val get_math_char_info : math_font_abbrev -> is_in_base_level:bool -> is_in_display:bool -> is_big:bool -> font_size:length -> Uchar.t list -> OutputText.t * length * length * length * length * FontFormat.math_kern_info option +val get_math_char_info : math_key -> is_in_base_level:bool -> is_in_display:bool -> is_big:bool -> font_size:length -> Uchar.t list -> OutputText.t * length * length * length * length * FontFormat.math_kern_info option val get_font_tag : key -> tag -val get_math_tag : math_font_abbrev -> tag +val get_math_tag : math_key -> tag -val get_math_constants : math_font_abbrev -> FontFormat.math_constants +val get_math_constants : math_key -> FontFormat.math_constants -val get_math_kern_ratio : math_font_abbrev -> FontFormat.math_kern -> float -> float +val get_math_kern_ratio : math_key -> FontFormat.math_kern -> float -> float val get_font_dictionary : Pdf.t -> Pdf.pdfobject diff --git a/src/frontend/main.ml b/src/frontend/main.ml index ae2d01f63..3e843cc45 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1061,11 +1061,6 @@ let report_config_error : config_error -> unit = function let report_font_error : font_error -> unit = function - | InvalidMathFontAbbrev(mfabbrev) -> - report_error Interface [ - NormalLine(Printf.sprintf "cannot find a math font named '%s'." mfabbrev); - ] - | NotASingleFont(abspath) -> let fname = convert_abs_path_to_show abspath in report_error Interface [ @@ -1078,20 +1073,16 @@ let report_font_error : font_error -> unit = function NormalLine(Printf.sprintf "the font file '%s' (used with index %d) is not a collection." fname index); ] - | NotASingleMathFont(mfabbrev, abspath) -> + | NotASingleMathFont(abspath) -> let fname = convert_abs_path_to_show abspath in report_error Interface [ - NormalLine(Printf.sprintf "the font file '%s'," fname); - NormalLine(Printf.sprintf "which is associated with the math font name '%s'," mfabbrev); - NormalLine("is not a single font file or does not have a MATH table."); + NormalLine(Printf.sprintf "the font file '%s' is not a single font file or does not have a MATH table." fname); ] - | NotATTCMathFont(mfabbrev, abspath, i) -> + | NotATTCMathFont(abspath, index) -> let fname = convert_abs_path_to_show abspath in report_error Interface [ - NormalLine(Printf.sprintf "the font file '%s'," fname); - NormalLine(Printf.sprintf "which is associated with the math font name '%s' and index %d," mfabbrev i); - NormalLine("is not a TrueType collection or does not have a MATH table."); + NormalLine(Printf.sprintf "the font file '%s' (used with index %d) is not a collection or does not have a MATH table." fname index); ] | CannotFindLibraryFileAsToFont(libpath, candidates) -> diff --git a/src/frontend/math.ml b/src/frontend/math.ml index 5f346cc03..99da39d38 100644 --- a/src/frontend/math.ml +++ b/src/frontend/math.ml @@ -654,8 +654,8 @@ let convert_math_char (ictx : input_context) ~(kern : (math_char_kern_func * mat let is_in_base_level = Context.is_in_base_level ictx in let is_in_display = true (* temporary *) in let (otxt, wid, hgt, dpt, mic, mkiopt) = - let mfabbrev = Context.math_font_abbrev ictx in - FontInfo.get_math_char_info mfabbrev ~is_in_base_level ~is_in_display ~is_big ~font_size uchlst + let mathkey = Context.math_font_key_exn ictx in + FontInfo.get_math_char_info mathkey ~is_in_base_level ~is_in_display ~is_big ~font_size uchlst in let mkspec = match kern with diff --git a/src/frontend/mathKernScheme.ml b/src/frontend/mathKernScheme.ml index b69c0b706..11fc1f332 100644 --- a/src/frontend/mathKernScheme.ml +++ b/src/frontend/mathKernScheme.ml @@ -23,13 +23,13 @@ let make_dense (kernf : HorzBox.math_kern_func) : t = let calculate (ictx : input_context) (math_kern_scheme : t) (corrhgt : length) : length = let fontsize = Context.font_size ictx in - let mfabbrev = Context.math_font_abbrev ictx in + let mathkey = Context.math_font_key_exn ictx in match math_kern_scheme with | NoMathKern -> Length.zero | DiscreteMathKern(mkern) -> - let ratiok = FontInfo.get_math_kern_ratio mfabbrev mkern (corrhgt /% fontsize) in + let ratiok = FontInfo.get_math_kern_ratio mathkey mkern (corrhgt /% fontsize) in fontsize *% ratiok | DenseMathKern(kernf) -> diff --git a/src/frontend/packageChecker.ml b/src/frontend/packageChecker.ml index fbe2ae363..d4513c7d3 100644 --- a/src/frontend/packageChecker.ml +++ b/src/frontend/packageChecker.ml @@ -114,15 +114,22 @@ let check_library_package (tyenv_prim : Typeenv.t) (genv : global_type_environme | None -> err @@ NoMainModule(main_module_name) -let check_font_package (_main_module_name : module_name) (font_files : (abs_path * font_file_contents) list) = +let check_font_package (_main_module_name : module_name) (font_files : font_file_record list) = let open ResultMonad in let stage = Persistent0 in let (ssig, libacc) = - font_files |> List.fold_left (fun (ssig, libacc) (abspath_font, font_file_contents) -> + font_files |> List.fold_left (fun (ssig, libacc) r -> + let + { + r_font_file_path = path; + r_font_file_contents = font_file_contents; + r_used_as_math_font = used_as_math_font; + } = r + in match font_file_contents with | OpentypeSingle(varnm) -> let evid = EvalVarID.fresh (Range.dummy "font-package 1", varnm) in - let bind = Bind(stage, NonRec(evid, LoadSingleFont(abspath_font))) in + let bind = Bind(stage, NonRec(evid, LoadSingleFont{ path; used_as_math_font })) in let ventry = { val_name = Some(evid); @@ -130,13 +137,13 @@ let check_font_package (_main_module_name : module_name) (font_files : (abs_path val_stage = stage; } in - (ssig |> StructSig.add_value varnm ventry, Alist.extend libacc (abspath_font, [ bind ])) + (ssig |> StructSig.add_value varnm ventry, Alist.extend libacc (path, [ bind ])) | OpentypeCollection(varnms) -> let (ssig, bindacc, _) = varnms |> List.fold_left (fun (ssig, bindacc, index) varnm -> let evid = EvalVarID.fresh (Range.dummy "font-package 3", varnm) in - let bind = Bind(stage, NonRec(evid, LoadCollectionFont(abspath_font, index))) in + let bind = Bind(stage, NonRec(evid, LoadCollectionFont{ path; index; used_as_math_font })) in let ventry = { val_name = Some(evid); @@ -147,7 +154,7 @@ let check_font_package (_main_module_name : module_name) (font_files : (abs_path (ssig |> StructSig.add_value varnm ventry, Alist.extend bindacc bind, index + 1) ) (ssig, Alist.empty, 0) in - (ssig, Alist.extend libacc (abspath_font, Alist.to_list bindacc)) + (ssig, Alist.extend libacc (path, Alist.to_list bindacc)) ) (StructSig.empty, Alist.empty) in diff --git a/src/frontend/packageConfig.ml b/src/frontend/packageConfig.ml index d7744cf55..7bf143efa 100644 --- a/src/frontend/packageConfig.ml +++ b/src/frontend/packageConfig.ml @@ -13,6 +13,7 @@ type relative_path = string type font_file_description = { font_file_path : relative_path; font_file_contents : font_file_contents; + used_as_math_font : bool; } type package_contents = @@ -51,10 +52,12 @@ let font_file_contents_decoder : font_file_contents ConfigDecoder.t = let font_file_description_decoder : font_file_description ConfigDecoder.t = let open ConfigDecoder in get "path" string >>= fun font_file_path -> + get_or_else "math" bool false >>= fun used_as_math_font -> get "contents" font_file_contents_decoder >>= fun font_file_contents -> succeed @@ { font_file_path; font_file_contents; + used_as_math_font; } diff --git a/src/frontend/packageConfig.mli b/src/frontend/packageConfig.mli index 93a20db50..7c2ce2df6 100644 --- a/src/frontend/packageConfig.mli +++ b/src/frontend/packageConfig.mli @@ -9,6 +9,7 @@ type relative_path = string type font_file_description = { font_file_path : relative_path; font_file_contents : font_file_contents; + used_as_math_font : bool; } type package_contents = diff --git a/src/frontend/packageReader.ml b/src/frontend/packageReader.ml index 37b552bb0..68c954da9 100644 --- a/src/frontend/packageReader.ml +++ b/src/frontend/packageReader.ml @@ -53,9 +53,13 @@ let main ~(extensions : string list) (absdir_package : abs_path) : untyped_packa | PackageConfig.Font{ main_module_name; font_file_descriptions } -> let font_files = font_file_descriptions |> List.map (fun font_file_description -> - let PackageConfig.{ font_file_path; font_file_contents } = font_file_description in + let PackageConfig.{ font_file_path; font_file_contents; used_as_math_font } = font_file_description in let abspath = make_abs_path (Filename.concat (get_abs_path_string absdir_package) font_file_path) in - (abspath, font_file_contents) + { + r_font_file_path = abspath; + r_font_file_contents = font_file_contents; + r_used_as_math_font = used_as_math_font; + } ) in return @@ UTFontPackage{ diff --git a/src/frontend/primitives.cppo.ml b/src/frontend/primitives.cppo.ml index df2c692ee..9f1f7279b 100644 --- a/src/frontend/primitives.cppo.ml +++ b/src/frontend/primitives.cppo.ml @@ -681,7 +681,7 @@ let get_pdf_mode_initial_context wid = space_math_prefix = (0.125, 0.04, 0.08); left_hyphen_min = 3; right_hyphen_min = 2; - math_font_abbrev = "lmodern"; (* TEMPORARY *) + math_font_key = None; math_script_level = HorzBox.BaseLevel; } diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index ef25156a8..a1af3c928 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -606,6 +606,13 @@ type font_file_contents = | OpentypeCollection of var_name list [@@deriving show { with_path = false }] +type font_file_record = { + r_font_file_path : abs_path; + r_font_file_contents : font_file_contents; + r_used_as_math_font : bool; +} +[@@deriving show { with_path = false }] + type untyped_package = | UTLibraryPackage of { main_module_name : module_name; @@ -613,7 +620,7 @@ type untyped_package = } | UTFontPackage of { main_module_name : module_name; - font_files : (abs_path * font_file_contents) list; + font_files : font_file_record list; } [@@deriving show { with_path = false }] @@ -1035,8 +1042,15 @@ and abstract_tree = | Lift of abstract_tree | ASTCodeSymbol of CodeSymbol.t (* Fonts: *) - | LoadSingleFont of abs_path - | LoadCollectionFont of abs_path * int + | LoadSingleFont of { + path : abs_path; + used_as_math_font : bool; + } + | LoadCollectionFont of { + path : abs_path; + index : int; + used_as_math_font : bool; + } (* Primitive applications: *) #include "__attype.gen.ml" @@ -1207,8 +1221,16 @@ and code_value = | CdPatternMatch of Range.t * code_value * code_pattern_branch list | CdConstructor of constructor_name * code_value | CdTuple of code_value TupleList.t - | CdLoadSingleFont of abs_path - | CdLoadCollectionFont of abs_path * int + + | CdLoadSingleFont of { + path : abs_path; + used_as_math_font : bool; + } + | CdLoadCollectionFont of { + path : abs_path; + index : int; + used_as_math_font : bool; + } #include "__codetype.gen.ml" and code_inline_text_element = @@ -1452,8 +1474,11 @@ let rec unlift_code (code : code_value) : abstract_tree = | CdConstructor(constrnm, code1) -> NonValueConstructor(constrnm, aux code1) | CdTuple(codes) -> PrimitiveTuple(TupleList.map aux codes) - | CdLoadSingleFont(abspath) -> LoadSingleFont(abspath) - | CdLoadCollectionFont(abspath, index) -> LoadCollectionFont(abspath, index) + | CdLoadSingleFont{ path; used_as_math_font } -> + LoadSingleFont{ path; used_as_math_font } + + | CdLoadCollectionFont{ path; index; used_as_math_font } -> + LoadCollectionFont{ path; index; used_as_math_font } #include "__unliftcode.gen.ml" in aux code diff --git a/tools/gencode/type.ml b/tools/gencode/type.ml index 8adbdc03d..fa04fb4b0 100644 --- a/tools/gencode/type.ml +++ b/tools/gencode/type.ml @@ -133,6 +133,7 @@ let tPAGEPARTS = tycon0 "tPAGEPARTS" "page-parts" let tPT = tycon0 "tPT" "point" let tPADS = tycon0 "tPADS" "paddings" let tDECOSET = tycon0 "tDECOSET" "deco-set" +let tFONTKEY = tycon0 "tFONTKEY" "font" let tFONTWR = tycon0 "tFONTWR" "font-with-ratio" let tDECO = tycon0 "tDECO" "deco" let tIGR = tycon0 "tIGR" "inline-graphics" diff --git a/tools/gencode/type.mli b/tools/gencode/type.mli index 442613d6a..f923bd1e7 100644 --- a/tools/gencode/type.mli +++ b/tools/gencode/type.mli @@ -56,6 +56,7 @@ val tPAGECONTF : t val tPAGEPARTSF : t val tPADS : t val tDECOSET : t +val tFONTKEY : t val tFONTWR : t val tDECO : t val tIGR : t diff --git a/tools/gencode/vminst.ml b/tools/gencode/vminst.ml index 523ab3365..cef4aa80d 100644 --- a/tools/gencode/vminst.ml +++ b/tools/gencode/vminst.ml @@ -1314,8 +1314,8 @@ match ctx.script_space_map |> CharBasis.ScriptSpaceMap.find_opt (script1, script ] ~is_pdf_mode_primitive:true ~code:{| -let mfabbrev = Context.math_font_abbrev ictx in -let mc = FontInfo.get_math_constants mfabbrev in +let mathkey = Context.math_font_key_exn ictx in +let mc = FontInfo.get_math_constants mathkey in make_float (mc.FontFormat.axis_height) |} ; inst "PrimitiveSetParagraphMargin" @@ -1408,16 +1408,16 @@ make_font_with_ratio_value fontwr |} ; inst "PrimitiveSetMathFont" ~name:"set-math-font" - ~type_:Type.(tS @-> tCTX @-> tCTX) + ~type_:Type.(tFONTKEY @-> tCTX @-> tCTX) ~fields:[ ] ~params:[ - param "mfabbrev" ~type_:"string"; + param "mathkey" ~type_:"font_key"; param "(ctx, ctxsub)" ~type_:"context"; ] ~is_pdf_mode_primitive:true ~code:{| -Context(HorzBox.({ ctx with math_font_abbrev = mfabbrev; }), ctxsub) +Context(HorzBox.({ ctx with math_font_key = Some(mathkey); }), ctxsub) |} ; inst "PrimitiveSetDominantWideScript" ~name:"set-dominant-wide-script" From b7d26ffc395575a0d66afca4abc45a01b0a7dedd Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 12 Nov 2022 19:22:30 +0900 Subject: [PATCH 135/288] discard 'LoadFont' and 'SetDefaultFont' --- src/backend/loadFont.ml | 70 --------------------------------- src/backend/loadFont.mli | 8 ---- src/backend/setDefaultFont.ml | 43 -------------------- src/backend/setDefaultFont.mli | 5 --- src/frontend/fontInfo.ml | 32 --------------- src/frontend/primitives.cppo.ml | 6 +-- 6 files changed, 1 insertion(+), 163 deletions(-) delete mode 100644 src/backend/loadFont.ml delete mode 100644 src/backend/loadFont.mli delete mode 100644 src/backend/setDefaultFont.ml delete mode 100644 src/backend/setDefaultFont.mli diff --git a/src/backend/loadFont.ml b/src/backend/loadFont.ml deleted file mode 100644 index 6ff13d040..000000000 --- a/src/backend/loadFont.ml +++ /dev/null @@ -1,70 +0,0 @@ - -open MyUtil - -module YS = Yojson.SafePos -module MYU = MyYojsonUtil - -type font_abbrev = string - -type data = FontAccess.t - - -let read_path_from_dict ((pos, _) as assoc) : lib_path = - let srcopt = assoc |> MYU.find_opt "src" in - let srcdistopt = assoc |> MYU.find_opt "src-dist" in - let relpathstr = - match (srcopt, srcdistopt) with - | (None, None) -> - raise (MYU.MissingRequiredKey(MYU.make_range pos, "src")) - - | (None, Some(srcdist)) -> - let rng = MYU.make_range pos in - Logging.warn_deprecated ("at " ^ (Range.to_string rng) ^ ": the key 'src-dist' in font hash files is deprecated; consider using 'src'."); - let s = srcdist |> YS.Util.to_string in - Filename.concat "dist/fonts" s - - | (Some(src), None) -> - src |> YS.Util.to_string - - | (Some(src), Some(_)) -> - let rng = MYU.make_range pos in - Logging.warn_deprecated ("at " ^ (Range.to_string rng) ^ ": the key 'src-dist' in font hash files is deprecated; the entry of 'src' is used."); - src |> YS.Util.to_string - in - make_lib_path relpathstr - - -let read_assoc_single (json : YS.json) : data = - let assoc = json |> MYU.make_assoc in - let relpath = assoc |> read_path_from_dict in - FontAccess.Single(relpath) - - -let read_assoc_ttc (json : YS.json) = - let assoc = json |> MYU.make_assoc in - let relpath = assoc |> read_path_from_dict in - let index = assoc |> MYU.find "index" |> YS.Util.to_int in - FontAccess.Collection(relpath, index) - - -let read_assoc (assoc : MYU.assoc) = - assoc |> MYU.fold (fun abbrev json acc -> - let data = - json |> MYU.decode_variant [ - ("Single", MYU.Arg(read_assoc_single)); - ("Collection", MYU.Arg(read_assoc_ttc)); - ] - in - Alist.extend acc (abbrev, data) - ) Alist.empty |> Alist.to_list - - -let main (abspath : abs_path) : (font_abbrev * data) list = - let pathstr = get_abs_path_string abspath in - try - let json = YS.from_file ~fname:pathstr pathstr in - (* -- may raise 'Sys_error', or 'Yojson.Json_error' -- *) - let assoc = MYU.make_assoc json in - read_assoc assoc - with - | Yojson.Json_error(msg) -> MYU.syntax_error pathstr msg diff --git a/src/backend/loadFont.mli b/src/backend/loadFont.mli deleted file mode 100644 index b07a14292..000000000 --- a/src/backend/loadFont.mli +++ /dev/null @@ -1,8 +0,0 @@ - -open MyUtil - -type font_abbrev = string - -type data = FontAccess.t - -val main : abs_path -> (font_abbrev * data) list diff --git a/src/backend/setDefaultFont.ml b/src/backend/setDefaultFont.ml deleted file mode 100644 index 396e54e96..000000000 --- a/src/backend/setDefaultFont.ml +++ /dev/null @@ -1,43 +0,0 @@ - -open MyUtil -(* -open HorzBox -*) -open CharBasis -(* -module YS = Yojson.SafePos -module MYU = MyYojsonUtil -*) -(* -let read_single_assoc assoc = - let name = assoc |> MYU.find "font-name" |> YS.Util.to_string in - let ratio = assoc |> MYU.find "ratio" |> YS.Util.to_float in - let rising = assoc |> MYU.find "rising" |> YS.Util.to_float in - (StringFontAbbrev(name), ratio, rising) - - -let read_assoc (assoc : MYU.assoc) = - List.fold_left (fun mapacc (key_script, script) -> - let singleassoc = assoc |> MYU.find key_script |> MYU.make_assoc in - let triple = read_single_assoc singleassoc in - mapacc |> ScriptSchemeMap.add script triple - ) ScriptSchemeMap.empty [ - ("han-ideographic", HanIdeographic); - ("latin" , Latin); - ("kana" , HiraganaOrKatakana); - ("other-script" , OtherScript); - ] -*) - -let main (_abspath : abs_path) : (FontKey.t * float * float) ScriptSchemeMap.t = - ScriptSchemeMap.empty -(* - let pathstr = get_abs_path_string abspath in - try - let json = YS.from_file ~fname:pathstr pathstr in - (* -- may raise 'Sys_error' -- *) - let assoc = json |> MYU.make_assoc in - read_assoc assoc - with - | Yojson.Json_error(msg) -> MYU.syntax_error pathstr msg -*) diff --git a/src/backend/setDefaultFont.mli b/src/backend/setDefaultFont.mli deleted file mode 100644 index 5aea3cb9b..000000000 --- a/src/backend/setDefaultFont.mli +++ /dev/null @@ -1,5 +0,0 @@ - -open MyUtil -open CharBasis - -val main : abs_path -> (FontKey.t * float * float) ScriptSchemeMap.t diff --git a/src/frontend/fontInfo.ml b/src/frontend/fontInfo.ml index 3d3b55bdf..3c18e0324 100644 --- a/src/frontend/fontInfo.ml +++ b/src/frontend/fontInfo.ml @@ -457,38 +457,6 @@ let initialize () = ScriptDataMap.set_from_file abspath_S abspath_EAW; let* abspath_LB = resolve_lib_file (make_lib_path "dist/unidata/LineBreak.txt") in LineBreakDataMap.set_from_file abspath_LB; - let font_hash_local = - match Config.resolve_lib_file (make_lib_path "local/hash/fonts.satysfi-hash") with - | Error(_) -> [] - | Ok(abspath) -> LoadFont.main abspath - in - let* abspath_fonts = resolve_lib_file (make_lib_path "dist/hash/fonts.satysfi-hash") in - let font_hash_dist = LoadFont.main abspath_fonts in - let font_hash = List.append font_hash_local font_hash_dist in - if OptionState.does_show_fonts () then Logging.show_fonts font_hash; -(* - font_hash |> List.iter (fun (name, data) -> - match data with - | FontAccess.Single(relpath) -> FontAbbrevHashTable.add_single abbrev relpath - | FontAccess.Collection(relpath, i) -> FontAbbrevHashTable.add_ttc abbrev relpath i - ); -*) - let math_font_hash_local = - match Config.resolve_lib_file (make_lib_path "local/hash/mathfonts.satysfi-hash") with - | Error(_) -> [] - | Ok(abspath) -> LoadFont.main abspath - in - let* abspath_mathfonts = resolve_lib_file (make_lib_path "dist/hash/mathfonts.satysfi-hash") in - let math_font_hash_dist = LoadFont.main abspath_mathfonts in - let math_font_hash = List.append math_font_hash_local math_font_hash_dist in - if OptionState.does_show_fonts () then Logging.show_math_fonts math_font_hash; -(* - math_font_hash |> List.iter (fun (mfabbrev, data) -> - match data with - | FontAccess.Single(srcpath) -> MathFontAbbrevHashTable.add_single mfabbrev srcpath - | FontAccess.Collection(srcpath, i) -> MathFontAbbrevHashTable.add_ttc mfabbrev srcpath i - ); -*) return () in match res with diff --git a/src/frontend/primitives.cppo.ml b/src/frontend/primitives.cppo.ml index 9f1f7279b..34a20da97 100644 --- a/src/frontend/primitives.cppo.ml +++ b/src/frontend/primitives.cppo.ml @@ -628,8 +628,6 @@ let default_math_class_map = ] -let default_font_scheme_ref = ref CharBasis.ScriptSchemeMap.empty - let default_hyphen_dictionary = ref LoadHyph.empty @@ -648,7 +646,7 @@ let get_pdf_mode_initial_context wid = { hyphen_dictionary = !default_hyphen_dictionary; hyphen_badness = 100; - font_scheme = !default_font_scheme_ref; + font_scheme = CharBasis.ScriptSchemeMap.empty; font_size = pdfpt 12.; dominant_wide_script = CharBasis.OtherScript; dominant_narrow_script = CharBasis.OtherScript; @@ -764,9 +762,7 @@ let resolve_lib_file (libpath : lib_path) = let make_pdf_mode_environments () = let open ResultMonad in - let* abspath_default_font = resolve_lib_file (make_lib_path "dist/hash/default-font.satysfi-hash") in let* abspath_hyphen = resolve_lib_file (make_lib_path "dist/hyph/english.satysfi-hyph") in - default_font_scheme_ref := SetDefaultFont.main abspath_default_font; default_hyphen_dictionary := LoadHyph.main abspath_hyphen; (* TODO: should depend on the current language *) return @@ make_environments pdf_mode_table From 4e9b38568f041af369d9abb8b8bbf8c07eec5dc8 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 12 Nov 2022 19:27:46 +0900 Subject: [PATCH 136/288] discard 'lib-satysfi/{fonts,hash}' --- lib-satysfi/dist/fonts/.gitkeep | 0 .../dist/hash/default-font.satysfi-hash | 22 ------------------- lib-satysfi/dist/hash/fonts.satysfi-hash | 13 ----------- lib-satysfi/dist/hash/mathfonts.satysfi-hash | 3 --- 4 files changed, 38 deletions(-) delete mode 100644 lib-satysfi/dist/fonts/.gitkeep delete mode 100644 lib-satysfi/dist/hash/default-font.satysfi-hash delete mode 100644 lib-satysfi/dist/hash/fonts.satysfi-hash delete mode 100644 lib-satysfi/dist/hash/mathfonts.satysfi-hash diff --git a/lib-satysfi/dist/fonts/.gitkeep b/lib-satysfi/dist/fonts/.gitkeep deleted file mode 100644 index e69de29bb..000000000 diff --git a/lib-satysfi/dist/hash/default-font.satysfi-hash b/lib-satysfi/dist/hash/default-font.satysfi-hash deleted file mode 100644 index 82ebbe9bb..000000000 --- a/lib-satysfi/dist/hash/default-font.satysfi-hash +++ /dev/null @@ -1,22 +0,0 @@ -{ - "han-ideographic": { - "font-name": "ipaexm", - "ratio" : 0.88, - "rising" : 0.0 - }, - "kana": { - "font-name": "ipaexm", - "ratio" : 0.88, - "rising" : 0.0 - }, - "latin": { - "font-name": "Junicode", - "ratio" : 1.0, - "rising" : 0.0 - }, - "other-script": { - "font-name": "Junicode", - "ratio" : 1.0, - "rising" : 0.0 - } -} diff --git a/lib-satysfi/dist/hash/fonts.satysfi-hash b/lib-satysfi/dist/hash/fonts.satysfi-hash deleted file mode 100644 index 728bc2db3..000000000 --- a/lib-satysfi/dist/hash/fonts.satysfi-hash +++ /dev/null @@ -1,13 +0,0 @@ -{ - "ipaexm" : , - "ipaexg" : , - "lmroman" : , - "lmroman-b" : , - "lmroman-it": , - "lmmono" : , - "lmsans" : , - "Junicode" : , - "Junicode-b": , - "Junicode-b-it": , - "Junicode-it": -} diff --git a/lib-satysfi/dist/hash/mathfonts.satysfi-hash b/lib-satysfi/dist/hash/mathfonts.satysfi-hash deleted file mode 100644 index 61eac970c..000000000 --- a/lib-satysfi/dist/hash/mathfonts.satysfi-hash +++ /dev/null @@ -1,3 +0,0 @@ -{ - "lmodern": -} From 6c60b49793e5a14c4fab99dfe7e0121e9341ca9c Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 12 Nov 2022 19:28:52 +0900 Subject: [PATCH 137/288] update 'demo.satysfi-lock-expected' --- demo/demo.satysfi-lock-expected | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/demo/demo.satysfi-lock-expected b/demo/demo.satysfi-lock-expected index dc8fce20c..141e11fcd 100644 --- a/demo/demo.satysfi-lock-expected +++ b/demo/demo.satysfi-lock-expected @@ -11,6 +11,27 @@ locks: path: ./dist/packages/code/code.0.0.1/ dependencies: - stdlib.0.0.1 + - font-latin-modern.0.0.1 +- name: font-ipa-ex.0.0.1 + location: + type: global + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + dependencies: [] +- name: font-junicode.0.0.1 + location: + type: global + path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + dependencies: [] +- name: font-latin-modern.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + dependencies: [] +- name: font-latin-modern-math.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + dependencies: [] - name: footnote-scheme.0.0.1 location: type: global @@ -45,6 +66,10 @@ locks: - annot.0.0.1 - code.0.0.1 - footnote-scheme.0.0.1 + - font-junicode.0.0.1 + - font-latin-modern.0.0.1 + - font-ipa-ex.0.0.1 + - font-latin-modern-math.0.0.1 - name: stdlib.0.0.1 location: type: global From e3fd715acec62fd326ce16cef2feadfdaabac7a0 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 12 Nov 2022 19:38:15 +0900 Subject: [PATCH 138/288] update CI --- .github/workflows/ci.yml | 2 +- satysfi.opam | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 3536ef009..f138e7661 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -50,7 +50,7 @@ jobs: ocaml-compiler: ${{ matrix.ocaml-version }} dune-cache: ${{ matrix.os != 'macos-latest' }} - opam-depext: true + opam-depext: ${{ matrix.os != 'macos-latest' }} opam-pin: true opam-repositories: | diff --git a/satysfi.opam b/satysfi.opam index feae54825..bb0cd4aa9 100644 --- a/satysfi.opam +++ b/satysfi.opam @@ -1,4 +1,4 @@ -opam-version: "2.0" +opam-version: "2.1" name: "satysfi" version: "0.0.8" maintainer: "gfngfn" From 8868271b983fb2e36ed51b8f3f5d3624c316b9d8 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 12 Nov 2022 19:57:57 +0900 Subject: [PATCH 139/288] make 'doc/*.saty' pass --- doc/doc-lang.satysfi-lock-expected | 25 +++++++ doc/doc-primitives.satysfi-lock-expected | 19 +++++ doc/local.satyh | 3 +- doc/math1.satysfi-lock-expected | 6 ++ install-libs.sh | 4 -- lib-satysfi/dist/cache/registry.yaml | 8 +++ .../packages/code/code.0.0.1/satysfi.yaml | 6 +- .../std-ja-book.0.0.1/satysfi.yaml | 35 +++------- .../std-ja-book.0.0.1/src/std-ja-book.satyh | 3 +- .../std-ja/std-ja.0.0.1/package.satysfi-lock | 69 ++++++++++++------- .../packages/std-ja/std-ja.0.0.1/satysfi.yaml | 23 ++++--- .../std-ja/std-ja.0.0.1/src/std-ja.satyh | 36 ++++++---- 12 files changed, 149 insertions(+), 88 deletions(-) diff --git a/doc/doc-lang.satysfi-lock-expected b/doc/doc-lang.satysfi-lock-expected index 5bd4d4d5f..3ec050ba9 100644 --- a/doc/doc-lang.satysfi-lock-expected +++ b/doc/doc-lang.satysfi-lock-expected @@ -11,6 +11,27 @@ locks: path: ./dist/packages/code/code.0.0.1/ dependencies: - stdlib.0.0.1 + - font-latin-modern.0.0.1 +- name: font-ipa-ex.0.0.1 + location: + type: global + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + dependencies: [] +- name: font-junicode.0.0.1 + location: + type: global + path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + dependencies: [] +- name: font-latin-modern.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + dependencies: [] +- name: font-latin-modern-math.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + dependencies: [] - name: math.0.0.1 location: type: global @@ -26,6 +47,10 @@ locks: - math.0.0.1 - annot.0.0.1 - code.0.0.1 + - font-junicode.0.0.1 + - font-latin-modern.0.0.1 + - font-ipa-ex.0.0.1 + - font-latin-modern-math.0.0.1 - name: stdlib.0.0.1 location: type: global diff --git a/doc/doc-primitives.satysfi-lock-expected b/doc/doc-primitives.satysfi-lock-expected index 77dce0f1a..feb720dd8 100644 --- a/doc/doc-primitives.satysfi-lock-expected +++ b/doc/doc-primitives.satysfi-lock-expected @@ -11,6 +11,22 @@ locks: path: ./dist/packages/code/code.0.0.1/ dependencies: - stdlib.0.0.1 + - font-latin-modern.0.0.1 +- name: font-ipa-ex.0.0.1 + location: + type: global + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + dependencies: [] +- name: font-junicode.0.0.1 + location: + type: global + path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + dependencies: [] +- name: font-latin-modern.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + dependencies: [] - name: footnote-scheme.0.0.1 location: type: global @@ -39,6 +55,9 @@ locks: - annot.0.0.1 - code.0.0.1 - footnote-scheme.0.0.1 + - font-junicode.0.0.1 + - font-latin-modern.0.0.1 + - font-ipa-ex.0.0.1 - name: stdlib.0.0.1 location: type: global diff --git a/doc/local.satyh b/doc/local.satyh index 8a7478c77..47d08f9dc 100644 --- a/doc/local.satyh +++ b/doc/local.satyh @@ -1,6 +1,7 @@ use package Stdlib use package Math use package StdJaBook +use package FontLatinModern use LocalParen of `paren` module Local = struct @@ -177,7 +178,7 @@ module Local = struct val name-context ctx = ctx |> set-dominant-narrow-script Latin - |> set-font Latin (`lmmono`, 1., 0.) + |> set-font Latin (FontLatinModern.mono, 1., 0.) |> set-text-color Color.red diff --git a/doc/math1.satysfi-lock-expected b/doc/math1.satysfi-lock-expected index 5c26d4071..37bad55ca 100644 --- a/doc/math1.satysfi-lock-expected +++ b/doc/math1.satysfi-lock-expected @@ -11,6 +11,12 @@ locks: path: ./dist/packages/code/code.0.0.1/ dependencies: - stdlib.0.0.1 + - font-latin-modern.0.0.1 +- name: font-latin-modern.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + dependencies: [] - name: math.0.0.1 location: type: global diff --git a/install-libs.sh b/install-libs.sh index d895ecf24..a23face95 100755 --- a/install-libs.sh +++ b/install-libs.sh @@ -7,10 +7,6 @@ INSTALL=${2:-install} "${INSTALL}" -d "${LIBDIR}/dist" "${INSTALL}" -d "${LIBDIR}/dist/unidata" "${INSTALL}" -m 644 lib-satysfi/dist/unidata/*.txt "${LIBDIR}/dist/unidata" -"${INSTALL}" -d "${LIBDIR}/dist/fonts" -"${INSTALL}" -m 644 lib-satysfi/dist/fonts/* "${LIBDIR}/dist/fonts" -"${INSTALL}" -d "${LIBDIR}/dist/hash" -"${INSTALL}" -m 644 lib-satysfi/dist/hash/* "${LIBDIR}/dist/hash" "${INSTALL}" -d "${LIBDIR}/dist/hyph" "${INSTALL}" -m 644 lib-satysfi/dist/hyph/* "${LIBDIR}/dist/hyph" "${INSTALL}" -d "${LIBDIR}/dist/packages" diff --git a/lib-satysfi/dist/cache/registry.yaml b/lib-satysfi/dist/cache/registry.yaml index 7ad24ea4e..3d97847ca 100644 --- a/lib-satysfi/dist/cache/registry.yaml +++ b/lib-satysfi/dist/cache/registry.yaml @@ -59,6 +59,14 @@ packages: requirements: [ "0.0.1" ] - name: "code" requirements: [ "0.0.1" ] + - name: "font-junicode" + requirements: [ "0.0.1" ] + - name: "font-latin-modern" + requirements: [ "0.0.1" ] + - name: "font-ipa-ex" + requirements: [ "0.0.1" ] + - name: "font-latin-modern-math" + requirements: [ "0.0.1" ] - name: "std-ja-book" implementations: - version: "0.0.1" diff --git a/lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml index b2ad01a6d..0251ae99f 100644 --- a/lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml @@ -6,8 +6,6 @@ contents: - "./src" dependencies: - name: "stdlib" - requirements: - - "0.0.1" + requirements: [ "0.0.1" ] - name: "latin-modern" - requirements: - - "0.0.1" + requirements: [ "0.0.1" ] diff --git a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml index 02517dafd..d9c6da8f6 100644 --- a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml @@ -6,37 +6,20 @@ contents: - "./src" dependencies: - name: "stdlib" - requirements: - - "0.0.1" - + requirements: [ "0.0.1" ] - name: "math" - requirements: - - "0.0.1" - + requirements: [ "0.0.1" ] - name: "annot" - requirements: - - "0.0.1" - + requirements: [ "0.0.1" ] - name: "code" - requirements: - - "0.0.1" - + requirements: [ "0.0.1" ] - name: "footnote-scheme" - requirements: - - "0.0.1" - + requirements: [ "0.0.1" ] - name: "font-junicode" - requirements: - - "0.0.1" - + requirements: [ "0.0.1" ] - name: "font-latin-modern" - requirements: - - "0.0.1" - + requirements: [ "0.0.1" ] - name: "font-ipa-ex" - requirements: - - "0.0.1" - + requirements: [ "0.0.1" ] - name: "font-latin-modern-math" - requirements: - - "0.0.1" + requirements: [ "0.0.1" ] diff --git a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh index 5e5986901..eff36ca92 100644 --- a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh +++ b/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh @@ -9,7 +9,6 @@ use package FontIpaEx use package FontLatinModern use package FontLatinModernMath - module StdJaBook :> sig val document : @@ -141,7 +140,7 @@ end = struct |> set-font Kana font-cjk-mincho |> set-font HanIdeographic font-cjk-mincho |> set-font Latin font-latin-roman - |> set-font OtherScript font-cjk-mincho + |> set-font OtherScript font-latin-roman |> set-math-font FontLatinModernMath.main |> set-hyphen-penalty 100 diff --git a/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/package.satysfi-lock b/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/package.satysfi-lock index 088d42950..c35cc3d1e 100644 --- a/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/package.satysfi-lock +++ b/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/package.satysfi-lock @@ -1,26 +1,45 @@ locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" - - - name: "math.0.0.1" - location: - type: "global" - path: "./dist/packages/math/math.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "annot.0.0.1" - location: - type: "global" - path: "./dist/packages/annot/annot.0.0.1/" - dependencies: - - "stdlib.0.0.1" - - - name: "code.0.0.1" - location: - type: "global" - path: "./dist/packages/code/code.0.0.1/" - dependencies: - - "stdlib.0.0.1" +- name: annot.0.0.1 + location: + type: global + path: ./dist/packages/annot/annot.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: code.0.0.1 + location: + type: global + path: ./dist/packages/code/code.0.0.1/ + dependencies: + - stdlib.0.0.1 + - font-latin-modern.0.0.1 +- name: font-ipa-ex.0.0.1 + location: + type: global + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + dependencies: [] +- name: font-junicode.0.0.1 + location: + type: global + path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + dependencies: [] +- name: font-latin-modern.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + dependencies: [] +- name: font-latin-modern-math.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + dependencies: [] +- name: math.0.0.1 + location: + type: global + path: ./dist/packages/math/math.0.0.1/ + dependencies: + - stdlib.0.0.1 +- name: stdlib.0.0.1 + location: + type: global + path: ./dist/packages/stdlib/stdlib.0.0.1/ + dependencies: [] diff --git a/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/satysfi.yaml index cb337f004..b970aab74 100644 --- a/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/satysfi.yaml @@ -6,17 +6,18 @@ contents: - "./src" dependencies: - name: "stdlib" - requirements: - - "0.0.1" - + requirements: [ "0.0.1" ] - name: "math" - requirements: - - "0.0.1" - + requirements: [ "0.0.1" ] - name: "annot" - requirements: - - "0.0.1" - + requirements: [ "0.0.1" ] - name: "code" - requirements: - - "0.0.1" + requirements: [ "0.0.1" ] + - name: "font-junicode" + requirements: [ "0.0.1" ] + - name: "font-latin-modern" + requirements: [ "0.0.1" ] + - name: "font-ipa-ex" + requirements: [ "0.0.1" ] + - name: "font-latin-modern-math" + requirements: [ "0.0.1" ] diff --git a/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/src/std-ja.satyh b/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/src/std-ja.satyh index 36d2dea39..93ef91e2d 100644 --- a/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/src/std-ja.satyh +++ b/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/src/std-ja.satyh @@ -3,6 +3,11 @@ use package Math use package Code use package Annot +use package FontJunicode +use package FontIpaEx +use package FontLatinModern +use package FontLatinModernMath + module StdJa :> sig val document : @@ -23,13 +28,13 @@ module StdJa :> sig author : inline-text, |) -> block-text -> document - val font-latin-roman : string * float * float - val font-latin-bold : string * float * float - val font-latin-italic : string * float * float - val font-latin-sans : string * float * float - val font-latin-mono : string * float * float - val font-cjk-mincho : string * float * float - val font-cjk-gothic : string * float * float + val font-latin-roman : font * float * float + val font-latin-bold : font * float * float + val font-latin-italic : font * float * float + val font-latin-sans : font * float * float + val font-latin-mono : font * float * float + val font-cjk-mincho : font * float * float + val font-cjk-gothic : font * float * float val \ref : inline [string] val \ref-page : inline [string] @@ -92,13 +97,13 @@ end = struct val font-ratio-latin = 1. val font-ratio-cjk = 0.88 - val font-latin-roman = (`Junicode` , font-ratio-latin, 0.) - val font-latin-bold = (`Junicode-b` , font-ratio-latin, 0.) - val font-latin-italic = (`Junicode-it`, font-ratio-latin, 0.) - val font-latin-sans = (`lmsans` , font-ratio-latin, 0.) - val font-latin-mono = (`lmmono` , font-ratio-latin, 0.) - val font-cjk-mincho = (`ipaexm` , font-ratio-cjk , 0.) - val font-cjk-gothic = (`ipaexg` , font-ratio-cjk , 0.) + val font-latin-roman = (FontJunicode.normal , font-ratio-latin, 0.) + val font-latin-bold = (FontJunicode.bold , font-ratio-latin, 0.) + val font-latin-italic = (FontJunicode.italic , font-ratio-latin, 0.) + val font-latin-sans = (FontLatinModern.sans, font-ratio-latin, 0.) + val font-latin-mono = (FontLatinModern.mono, font-ratio-latin, 0.) + val font-cjk-mincho = (FontIpaEx.mincho , font-ratio-cjk , 0.) + val font-cjk-gothic = (FontIpaEx.gothic , font-ratio-cjk , 0.) val set-cjk-font font ctx = ctx |> set-font HanIdeographic font @@ -116,7 +121,8 @@ end = struct |> set-font Kana font-cjk-mincho |> set-font HanIdeographic font-cjk-mincho |> set-font Latin font-latin-roman - |> set-math-font `lmodern` + |> set-font OtherScript font-latin-roman + |> set-math-font FontLatinModernMath.main |> set-hyphen-penalty 100 From 5c413bdb648979369af546719b04fd8c9be87043 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 12 Nov 2022 20:02:09 +0900 Subject: [PATCH 140/288] fix 'opam-version' --- satysfi.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/satysfi.opam b/satysfi.opam index bb0cd4aa9..feae54825 100644 --- a/satysfi.opam +++ b/satysfi.opam @@ -1,4 +1,4 @@ -opam-version: "2.1" +opam-version: "2.0" name: "satysfi" version: "0.0.8" maintainer: "gfngfn" From a5781b26c5da69a8aaa23a782df14d3f148e09f2 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 12 Nov 2022 20:14:12 +0900 Subject: [PATCH 141/288] make 'doc/*.saty' pass (2) --- doc/doc-primitives.satysfi-lock-expected | 6 ++++++ doc/math1.satysfi-lock-expected | 19 +++++++++++++++++++ 2 files changed, 25 insertions(+) diff --git a/doc/doc-primitives.satysfi-lock-expected b/doc/doc-primitives.satysfi-lock-expected index feb720dd8..c027aab20 100644 --- a/doc/doc-primitives.satysfi-lock-expected +++ b/doc/doc-primitives.satysfi-lock-expected @@ -27,6 +27,11 @@ locks: type: global path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ dependencies: [] +- name: font-latin-modern-math.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + dependencies: [] - name: footnote-scheme.0.0.1 location: type: global @@ -58,6 +63,7 @@ locks: - font-junicode.0.0.1 - font-latin-modern.0.0.1 - font-ipa-ex.0.0.1 + - font-latin-modern-math.0.0.1 - name: stdlib.0.0.1 location: type: global diff --git a/doc/math1.satysfi-lock-expected b/doc/math1.satysfi-lock-expected index 37bad55ca..25a88e979 100644 --- a/doc/math1.satysfi-lock-expected +++ b/doc/math1.satysfi-lock-expected @@ -12,11 +12,26 @@ locks: dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 +- name: font-ipa-ex.0.0.1 + location: + type: global + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + dependencies: [] +- name: font-junicode.0.0.1 + location: + type: global + path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + dependencies: [] - name: font-latin-modern.0.0.1 location: type: global path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ dependencies: [] +- name: font-latin-modern-math.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + dependencies: [] - name: math.0.0.1 location: type: global @@ -38,6 +53,10 @@ locks: - math.0.0.1 - annot.0.0.1 - code.0.0.1 + - font-junicode.0.0.1 + - font-latin-modern.0.0.1 + - font-ipa-ex.0.0.1 + - font-latin-modern-math.0.0.1 - name: stdlib.0.0.1 location: type: global From c1989e3c95ab598f54f45e0cfad7f442a3a3d3a3 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 12 Nov 2022 20:14:29 +0900 Subject: [PATCH 142/288] remove OCaml 4.13.1 from 'ci.yml' --- .github/workflows/ci.yml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index f138e7661..332ed012e 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -10,7 +10,6 @@ jobs: matrix: os: [ 'ubuntu-latest', 'macos-latest' ] ocaml-version: - - 4.13.1 - 4.14.0 runs-on: ${{ matrix.os }} @@ -50,7 +49,7 @@ jobs: ocaml-compiler: ${{ matrix.ocaml-version }} dune-cache: ${{ matrix.os != 'macos-latest' }} - opam-depext: ${{ matrix.os != 'macos-latest' }} + opam-depext: true opam-pin: true opam-repositories: | From 0950d7bbef4226acf2fc045da8dc27f7c0252e04 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 12 Nov 2022 20:51:06 +0900 Subject: [PATCH 143/288] make 'tests/*' pass --- lib-satysfi/dist/cache/registry.yaml | 32 +++++++++++++++ .../packages/md-ja/md-ja.0.0.1/satysfi.yaml | 31 +++++++------- .../md-ja/md-ja.0.0.1/src/md-ja.satyh | 18 ++++++--- .../std-ja-report.0.0.1/satysfi.yaml | 27 ++++++------- .../src/std-ja-report.satyh | 40 +++++++++++-------- tests/clip.saty | 4 ++ tests/clip.satysfi-lock-expected | 20 ++++++++++ tests/glue1.saty | 4 ++ tests/glue1.satysfi-lock-expected | 20 ++++++++++ tests/head.satyh | 30 +++++++++----- tests/images/test.satysfi-lock-expected | 25 ++++++++++++ tests/macro1.satysfi-lock-expected | 25 ++++++++++++ tests/math-typefaces.satysfi-lock-expected | 25 ++++++++++++ tests/math2.saty | 4 ++ tests/math2.satysfi-lock-expected | 20 ++++++++++ tests/md/test.satysfi-lock | 29 ++++++++++++++ tests/refactor1.saty | 19 ++++++++- tests/refactor1.satysfi-lock-expected | 15 +++++++ tests/refactor2.saty | 20 +++++++++- tests/refactor2.satysfi-lock-expected | 17 +++++++- tests/refactor3.saty | 20 +++++++++- tests/refactor3.satysfi-lock-expected | 17 +++++++- tests/refactor5.saty | 20 +++++++++- tests/refactor5.satysfi-lock-expected | 17 +++++++- tests/staged1.satysfi-lock-expected | 25 ++++++++++++ 25 files changed, 454 insertions(+), 70 deletions(-) diff --git a/lib-satysfi/dist/cache/registry.yaml b/lib-satysfi/dist/cache/registry.yaml index 3d97847ca..0fdb97f70 100644 --- a/lib-satysfi/dist/cache/registry.yaml +++ b/lib-satysfi/dist/cache/registry.yaml @@ -103,6 +103,38 @@ packages: requirements: [ "0.0.1" ] - name: "footnote-scheme" requirements: [ "0.0.1" ] + - name: "font-junicode" + requirements: [ "0.0.1" ] + - name: "font-latin-modern" + requirements: [ "0.0.1" ] + - name: "font-ipa-ex" + requirements: [ "0.0.1" ] + - name: "font-latin-modern-math" + requirements: [ "0.0.1" ] +- name: "md-ja" + implementations: + - version: "0.0.1" + dependencies: + - name: "stdlib" + requirements: [ "0.0.1" ] + - name: "math" + requirements: [ "0.0.1" ] + - name: "annot" + requirements: [ "0.0.1" ] + - name: "code" + requirements: [ "0.0.1" ] + - name: "footnote-scheme" + requirements: [ "0.0.1" ] + - name: "itemize" + requirements: [ "0.0.1" ] + - name: "font-junicode" + requirements: [ "0.0.1" ] + - name: "font-latin-modern" + requirements: [ "0.0.1" ] + - name: "font-ipa-ex" + requirements: [ "0.0.1" ] + - name: "font-latin-modern-math" + requirements: [ "0.0.1" ] - name: "font-latin-modern" implementations: - version: "0.0.1" diff --git a/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml index 59e7a4c62..9b893fea8 100644 --- a/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml @@ -6,25 +6,22 @@ contents: - "./src" dependencies: - name: "stdlib" - requirements: - - "0.0.1" - + requirements: [ "0.0.1" ] - name: "math" - requirements: - - "0.0.1" - + requirements: [ "0.0.1" ] - name: "annot" - requirements: - - "0.0.1" - + requirements: [ "0.0.1" ] - name: "code" - requirements: - - "0.0.1" - + requirements: [ "0.0.1" ] - name: "footnote-scheme" - requirements: - - "0.0.1" - + requirements: [ "0.0.1" ] - name: "itemize" - requirements: - - "0.0.1" + requirements: [ "0.0.1" ] + - name: "font-junicode" + requirements: [ "0.0.1" ] + - name: "font-latin-modern" + requirements: [ "0.0.1" ] + - name: "font-ipa-ex" + requirements: [ "0.0.1" ] + - name: "font-latin-modern-math" + requirements: [ "0.0.1" ] diff --git a/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/src/md-ja.satyh b/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/src/md-ja.satyh index 1b1c8d6b1..77b858fa2 100644 --- a/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/src/md-ja.satyh +++ b/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/src/md-ja.satyh @@ -4,6 +4,11 @@ use package Code use package Itemize use package Annot +use package FontJunicode +use package FontIpaEx +use package FontLatinModern +use package FontLatinModernMath + module MDJa :> sig val document : (| title : inline-text, @@ -52,13 +57,13 @@ end = struct val font-ratio-cjk = 0.88 - val font-latin-roman = (`Junicode` , 1., 0.) - val font-latin-italic = (`Junicode-it`, 1., 0.) - val font-latin-sans = (`lmsans` , 1., 0.) - val font-latin-mono = (`lmmono` , 1., 0.) + val font-latin-roman = (FontJunicode.normal, 1., 0.) + val font-latin-italic = (FontJunicode.italic, 1., 0.) + val font-latin-sans = (FontLatinModern.sans, 1., 0.) + val font-latin-mono = (FontLatinModern.mono, 1., 0.) - val font-cjk-gothic = (`ipaexg`, font-ratio-cjk, 0.) - val font-cjk-mincho = (`ipaexm`, font-ratio-cjk, 0.) + val font-cjk-gothic = (FontIpaEx.gothic, font-ratio-cjk, 0.) + val font-cjk-mincho = (FontIpaEx.mincho, font-ratio-cjk, 0.) val hr-margin = 5mm val hr-thickness = 1pt @@ -92,6 +97,7 @@ end = struct |> set-dominant-wide-script Kana |> set-latin-font font-latin-roman |> set-cjk-font font-cjk-mincho + |> set-font OtherScript font-latin-roman |> set-hyphen-penalty 1000 |> set-space-ratio 0.275 0.08 0.12 diff --git a/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml index 6628681d4..9125ad9c1 100644 --- a/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml @@ -6,21 +6,20 @@ contents: - "./src" dependencies: - name: "stdlib" - requirements: - - "0.0.1" - + requirements: [ "0.0.1" ] - name: "math" - requirements: - - "0.0.1" - + requirements: [ "0.0.1" ] - name: "annot" - requirements: - - "0.0.1" - + requirements: [ "0.0.1" ] - name: "code" - requirements: - - "0.0.1" - + requirements: [ "0.0.1" ] - name: "footnote-scheme" - requirements: - - "0.0.1" + requirements: [ "0.0.1" ] + - name: "font-junicode" + requirements: [ "0.0.1" ] + - name: "font-latin-modern" + requirements: [ "0.0.1" ] + - name: "font-ipa-ex" + requirements: [ "0.0.1" ] + - name: "font-latin-modern-math" + requirements: [ "0.0.1" ] diff --git a/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/src/std-ja-report.satyh b/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/src/std-ja-report.satyh index b59d2dfd7..8970a17e1 100644 --- a/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/src/std-ja-report.satyh +++ b/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/src/std-ja-report.satyh @@ -4,6 +4,11 @@ use package Code use package Annot use package FootnoteScheme +use package FontJunicode +use package FontIpaEx +use package FontLatinModern +use package FontLatinModernMath + module StdJaReport :> sig val document : ?( @@ -21,15 +26,15 @@ module StdJaReport :> sig author : inline-text, |) -> block-text -> document - val font-latin-roman : string * float * float - val font-latin-bold : string * float * float - val font-latin-italic : string * float * float - val font-latin-sans : string * float * float - val font-latin-mono : string * float * float - val font-cjk-mincho : string * float * float - val font-cjk-gothic : string * float * float - val set-latin-font : (string * float * float) -> context -> context - val set-cjk-font : (string * float * float) -> context -> context + val font-latin-roman : font * float * float + val font-latin-bold : font * float * float + val font-latin-italic : font * float * float + val font-latin-sans : font * float * float + val font-latin-mono : font * float * float + val font-cjk-mincho : font * float * float + val font-cjk-gothic : font * float * float + val set-latin-font : (font * float * float) -> context -> context + val set-cjk-font : (font * float * float) -> context -> context val \ref : inline [string] val \ref-page : inline [string] val \figure : inline [?(label : string) inline-text, block-text] @@ -104,13 +109,13 @@ end = struct val font-ratio-latin = 1. val font-ratio-cjk = 0.88 - val font-latin-roman = (`Junicode` , font-ratio-latin, 0.) - val font-latin-bold = (`Junicode-b` , font-ratio-latin, 0.) - val font-latin-italic = (`Junicode-it`, font-ratio-latin, 0.) - val font-latin-sans = (`lmsans` , font-ratio-latin, 0.) - val font-latin-mono = (`lmmono` , font-ratio-latin, 0.) - val font-cjk-mincho = (`ipaexm` , font-ratio-cjk , 0.) - val font-cjk-gothic = (`ipaexg` , font-ratio-cjk , 0.) + val font-latin-roman = (FontJunicode.normal , font-ratio-latin, 0.) + val font-latin-bold = (FontJunicode.bold , font-ratio-latin, 0.) + val font-latin-italic = (FontJunicode.italic , font-ratio-latin, 0.) + val font-latin-sans = (FontLatinModern.sans, font-ratio-latin, 0.) + val font-latin-mono = (FontLatinModern.mono, font-ratio-latin, 0.) + val font-cjk-mincho = (FontIpaEx.mincho , font-ratio-cjk , 0.) + val font-cjk-gothic = (FontIpaEx.gothic , font-ratio-cjk , 0.) val set-latin-font font ctx = @@ -133,7 +138,8 @@ end = struct |> set-font Kana font-cjk-mincho |> set-font HanIdeographic font-cjk-mincho |> set-font Latin font-latin-roman - |> set-math-font `lmodern` + |> set-font OtherScript font-latin-roman + |> set-math-font FontLatinModernMath.main |> set-hyphen-penalty 100 diff --git a/tests/clip.saty b/tests/clip.saty index 77fe77209..131886f9c 100644 --- a/tests/clip.saty +++ b/tests/clip.saty @@ -1,6 +1,10 @@ #[dependencies [ (`stdlib`, `0.0.1`), (`math`, `0.0.1`), + (`font-junicode`, `0.0.1`), + (`font-ipa-ex`, `0.0.1`), + (`font-latin-modern`, `0.0.1`), + (`font-latin-modern-math`, `0.0.1`), ]] use package open Stdlib use open Head of `head` diff --git a/tests/clip.satysfi-lock-expected b/tests/clip.satysfi-lock-expected index 460d82536..436f4709a 100644 --- a/tests/clip.satysfi-lock-expected +++ b/tests/clip.satysfi-lock-expected @@ -1,4 +1,24 @@ locks: +- name: font-ipa-ex.0.0.1 + location: + type: global + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + dependencies: [] +- name: font-junicode.0.0.1 + location: + type: global + path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + dependencies: [] +- name: font-latin-modern.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + dependencies: [] +- name: font-latin-modern-math.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + dependencies: [] - name: math.0.0.1 location: type: global diff --git a/tests/glue1.saty b/tests/glue1.saty index 743b6bcdf..129cf28c5 100644 --- a/tests/glue1.saty +++ b/tests/glue1.saty @@ -1,6 +1,10 @@ #[dependencies [ (`stdlib`, `0.0.1`), (`math`, `0.0.1`), + (`font-junicode`, `0.0.1`), + (`font-ipa-ex`, `0.0.1`), + (`font-latin-modern`, `0.0.1`), + (`font-latin-modern-math`, `0.0.1`), ]] use Head of `head` diff --git a/tests/glue1.satysfi-lock-expected b/tests/glue1.satysfi-lock-expected index 460d82536..436f4709a 100644 --- a/tests/glue1.satysfi-lock-expected +++ b/tests/glue1.satysfi-lock-expected @@ -1,4 +1,24 @@ locks: +- name: font-ipa-ex.0.0.1 + location: + type: global + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + dependencies: [] +- name: font-junicode.0.0.1 + location: + type: global + path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + dependencies: [] +- name: font-latin-modern.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + dependencies: [] +- name: font-latin-modern-math.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + dependencies: [] - name: math.0.0.1 location: type: global diff --git a/tests/head.satyh b/tests/head.satyh index ef6a28675..d4dfac527 100644 --- a/tests/head.satyh +++ b/tests/head.satyh @@ -1,6 +1,11 @@ use package Stdlib use package Math +use package FontJunicode +use package FontIpaEx +use package FontLatinModern +use package FontLatinModernMath + module Head = struct %- TODO: remove this by using 'open' @@ -25,12 +30,13 @@ module Head = struct val font-ratio-latin = 1. val font-ratio-cjk = 0.88 - val font-latin-roman = (`Junicode`, font-ratio-latin, 0.) - val font-latin-italic = (`lmroman-it`, font-ratio-latin, 0.) - val font-latin-sans = (`lmsans`, font-ratio-latin, 0.) - val font-latin-mono = (`lmmono`, font-ratio-latin, 0.) - val font-cjk-mincho = (`ipaexm`, font-ratio-cjk , 0.) - val font-cjk-gothic = (`ipaexg`, font-ratio-cjk , 0.) + val font-latin-roman = (FontJunicode.normal , font-ratio-latin, 0.) + val font-latin-bold = (FontJunicode.bold , font-ratio-latin, 0.) + val font-latin-italic = (FontJunicode.italic , font-ratio-latin, 0.) + val font-latin-sans = (FontLatinModern.sans, font-ratio-latin, 0.) + val font-latin-mono = (FontLatinModern.mono, font-ratio-latin, 0.) + val font-cjk-mincho = (FontIpaEx.mincho , font-ratio-cjk , 0.) + val font-cjk-gothic = (FontIpaEx.gothic , font-ratio-cjk , 0.) val set-latin-font font ctx = ctx |> set-font Latin font @@ -61,10 +67,16 @@ module Head = struct let hgt = 650pt in let ctx-doc = get-initial-context wid (command \Math.math) - |> set-font Latin font-latin-roman - |> set-language Latin English + |> set-dominant-wide-script Kana + |> set-language Kana Japanese + |> set-language HanIdeographic Japanese |> set-dominant-narrow-script Latin - |> set-math-font `lmodern` + |> set-language Latin English + |> set-font Kana font-cjk-mincho + |> set-font HanIdeographic font-cjk-mincho + |> set-font Latin font-latin-roman + |> set-font OtherScript font-latin-roman + |> set-math-font FontLatinModernMath.main |> set-hyphen-penalty 100 in let () = ref-title <- title in diff --git a/tests/images/test.satysfi-lock-expected b/tests/images/test.satysfi-lock-expected index 4e3cb27f5..10aae1dc5 100644 --- a/tests/images/test.satysfi-lock-expected +++ b/tests/images/test.satysfi-lock-expected @@ -11,6 +11,27 @@ locks: path: ./dist/packages/code/code.0.0.1/ dependencies: - stdlib.0.0.1 + - font-latin-modern.0.0.1 +- name: font-ipa-ex.0.0.1 + location: + type: global + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + dependencies: [] +- name: font-junicode.0.0.1 + location: + type: global + path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + dependencies: [] +- name: font-latin-modern.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + dependencies: [] +- name: font-latin-modern-math.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + dependencies: [] - name: itemize.0.0.1 location: type: global @@ -32,6 +53,10 @@ locks: - math.0.0.1 - annot.0.0.1 - code.0.0.1 + - font-junicode.0.0.1 + - font-latin-modern.0.0.1 + - font-ipa-ex.0.0.1 + - font-latin-modern-math.0.0.1 - name: stdlib.0.0.1 location: type: global diff --git a/tests/macro1.satysfi-lock-expected b/tests/macro1.satysfi-lock-expected index 1640427dc..b386d3a04 100644 --- a/tests/macro1.satysfi-lock-expected +++ b/tests/macro1.satysfi-lock-expected @@ -11,6 +11,27 @@ locks: path: ./dist/packages/code/code.0.0.1/ dependencies: - stdlib.0.0.1 + - font-latin-modern.0.0.1 +- name: font-ipa-ex.0.0.1 + location: + type: global + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + dependencies: [] +- name: font-junicode.0.0.1 + location: + type: global + path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + dependencies: [] +- name: font-latin-modern.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + dependencies: [] +- name: font-latin-modern-math.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + dependencies: [] - name: footnote-scheme.0.0.1 location: type: global @@ -33,6 +54,10 @@ locks: - annot.0.0.1 - code.0.0.1 - footnote-scheme.0.0.1 + - font-junicode.0.0.1 + - font-latin-modern.0.0.1 + - font-ipa-ex.0.0.1 + - font-latin-modern-math.0.0.1 - name: stdlib.0.0.1 location: type: global diff --git a/tests/math-typefaces.satysfi-lock-expected b/tests/math-typefaces.satysfi-lock-expected index 35b53dee8..3162e6d52 100644 --- a/tests/math-typefaces.satysfi-lock-expected +++ b/tests/math-typefaces.satysfi-lock-expected @@ -11,6 +11,27 @@ locks: path: ./dist/packages/code/code.0.0.1/ dependencies: - stdlib.0.0.1 + - font-latin-modern.0.0.1 +- name: font-ipa-ex.0.0.1 + location: + type: global + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + dependencies: [] +- name: font-junicode.0.0.1 + location: + type: global + path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + dependencies: [] +- name: font-latin-modern.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + dependencies: [] +- name: font-latin-modern-math.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + dependencies: [] - name: footnote-scheme.0.0.1 location: type: global @@ -39,6 +60,10 @@ locks: - annot.0.0.1 - code.0.0.1 - footnote-scheme.0.0.1 + - font-junicode.0.0.1 + - font-latin-modern.0.0.1 + - font-ipa-ex.0.0.1 + - font-latin-modern-math.0.0.1 - name: stdlib.0.0.1 location: type: global diff --git a/tests/math2.saty b/tests/math2.saty index 803c45e3f..1545ef8c7 100644 --- a/tests/math2.saty +++ b/tests/math2.saty @@ -1,6 +1,10 @@ #[dependencies [ (`stdlib`, `0.0.1`), (`math`, `0.0.1`), + (`font-junicode`, `0.0.1`), + (`font-ipa-ex`, `0.0.1`), + (`font-latin-modern`, `0.0.1`), + (`font-latin-modern-math`, `0.0.1`), ]] use package Math use Head of `head` diff --git a/tests/math2.satysfi-lock-expected b/tests/math2.satysfi-lock-expected index 460d82536..436f4709a 100644 --- a/tests/math2.satysfi-lock-expected +++ b/tests/math2.satysfi-lock-expected @@ -1,4 +1,24 @@ locks: +- name: font-ipa-ex.0.0.1 + location: + type: global + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + dependencies: [] +- name: font-junicode.0.0.1 + location: + type: global + path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + dependencies: [] +- name: font-latin-modern.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + dependencies: [] +- name: font-latin-modern-math.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + dependencies: [] - name: math.0.0.1 location: type: global diff --git a/tests/md/test.satysfi-lock b/tests/md/test.satysfi-lock index 5b9d17d6d..5f49c2b63 100644 --- a/tests/md/test.satysfi-lock +++ b/tests/md/test.satysfi-lock @@ -22,6 +22,10 @@ locks: - "itemize.0.0.1" - "annot.0.0.1" - "footnote-scheme.0.0.1" + - "font-junicode.0.0.1" + - "font-ipa-ex.0.0.1" + - "font-latin-modern.0.0.1" + - "font-latin-modern-math.0.0.1" - name: "annot.0.0.1" location: @@ -36,6 +40,7 @@ locks: path: "./dist/packages/code/code.0.0.1/" dependencies: - "stdlib.0.0.1" + - "font-latin-modern.0.0.1" - name: "footnote-scheme.0.0.1" location: @@ -50,3 +55,27 @@ locks: path: "./dist/packages/itemize/itemize.0.0.1" dependencies: - "stdlib.0.0.1" + + - name: "font-junicode.0.0.1" + location: + type: "global" + path: "./dist/packages/font-junicode/font-junicode.0.0.1" + dependencies: [] + + - name: "font-ipa-ex.0.0.1" + location: + type: "global" + path: "./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1" + dependencies: [] + + - name: "font-latin-modern.0.0.1" + location: + type: "global" + path: "./dist/packages/font-latin-modern/font-latin-modern.0.0.1" + dependencies: [] + + - name: "font-latin-modern-math.0.0.1" + location: + type: "global" + path: "./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1" + dependencies: [] diff --git a/tests/refactor1.saty b/tests/refactor1.saty index 62d96b758..b2780821d 100644 --- a/tests/refactor1.saty +++ b/tests/refactor1.saty @@ -1,9 +1,19 @@ #[dependencies [ (`stdlib`, `0.0.1`), (`math`, `0.0.1`), + (`font-junicode`, `0.0.1`), + (`font-ipa-ex`, `0.0.1`), + (`font-latin-modern-math`, `0.0.1`), ]] use package open Stdlib use package open Math +use package FontJunicode +use package FontIpaEx +use package FontLatinModernMath + +let font-latin-roman = (FontJunicode.normal, 1., 0.) in +let font-cjk-mincho = (FontIpaEx.mincho, 0.88, 0.) in + %let rec fold-left f i l = % match l with @@ -26,7 +36,14 @@ in let s = arabic sum ^ `,` ^ arabic (f 0 42) ^ `,` ^ arabic (f 1 42) ^ `,` ^ arabic (g 0 42) ^ `,` ^ arabic (g 1 42) in %let inline ctx \math m = embed-math ctx (read-math ctx m) in -let ctx = get-initial-context 400pt (command \math) in +let ctx = + get-initial-context 400pt (command \math) + |> set-font Kana font-cjk-mincho + |> set-font HanIdeographic font-cjk-mincho + |> set-font Latin font-latin-roman + |> set-font OtherScript font-latin-roman + |> set-math-font FontLatinModernMath.main +in let paper-size = (210mm, 297mm) in %A4 let pagecontf _ = (| text-origin = (20pt, 20pt), text-height = 600pt, |) in let pagepartsf _ = (| header-origin = (0pt, 0pt), header-content = block-nil, footer-origin = (0pt, 0pt), footer-content = block-nil, |) in diff --git a/tests/refactor1.satysfi-lock-expected b/tests/refactor1.satysfi-lock-expected index 460d82536..440316850 100644 --- a/tests/refactor1.satysfi-lock-expected +++ b/tests/refactor1.satysfi-lock-expected @@ -1,4 +1,19 @@ locks: +- name: font-ipa-ex.0.0.1 + location: + type: global + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + dependencies: [] +- name: font-junicode.0.0.1 + location: + type: global + path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + dependencies: [] +- name: font-latin-modern-math.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + dependencies: [] - name: math.0.0.1 location: type: global diff --git a/tests/refactor2.saty b/tests/refactor2.saty index 3946882ba..a843af9b1 100644 --- a/tests/refactor2.saty +++ b/tests/refactor2.saty @@ -1,10 +1,28 @@ +#[dependencies [ + (`font-junicode`, `0.0.1`), + (`font-ipa-ex`, `0.0.1`), + (`font-latin-modern-math`, `0.0.1`), +]] +use package FontJunicode +use package FontIpaEx +use package FontLatinModernMath + +let font-latin-roman = (FontJunicode.normal, 1., 0.) in +let font-cjk-mincho = (FontIpaEx.mincho, 0.88, 0.) in let id x = x in let s = arabic (id 1) ^ `,` ^ (id `s`) in let inline ctx \math m = embed-math ctx (read-math ctx m) in -let ctx = get-initial-context 400pt (command \math) in +let ctx = + get-initial-context 400pt (command \math) + |> set-font Kana font-cjk-mincho + |> set-font HanIdeographic font-cjk-mincho + |> set-font Latin font-latin-roman + |> set-font OtherScript font-latin-roman + |> set-math-font FontLatinModernMath.main +in let paper-size = (210mm, 297mm) in %A4 let pagecontf _ = (| text-origin = (20pt, 20pt), text-height = 600pt, |) in let pagepartsf _ = (| header-origin = (0pt, 0pt), header-content = block-nil, footer-origin = (0pt, 0pt), footer-content = block-nil, |) in diff --git a/tests/refactor2.satysfi-lock-expected b/tests/refactor2.satysfi-lock-expected index a2e98fa3c..46ca436ae 100644 --- a/tests/refactor2.satysfi-lock-expected +++ b/tests/refactor2.satysfi-lock-expected @@ -1 +1,16 @@ -locks: [] +locks: +- name: font-ipa-ex.0.0.1 + location: + type: global + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + dependencies: [] +- name: font-junicode.0.0.1 + location: + type: global + path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + dependencies: [] +- name: font-latin-modern-math.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + dependencies: [] diff --git a/tests/refactor3.saty b/tests/refactor3.saty index 2e98f1985..aa8c164fd 100644 --- a/tests/refactor3.saty +++ b/tests/refactor3.saty @@ -1,3 +1,14 @@ +#[dependencies [ + (`font-junicode`, `0.0.1`), + (`font-ipa-ex`, `0.0.1`), + (`font-latin-modern-math`, `0.0.1`), +]] +use package FontJunicode +use package FontIpaEx +use package FontLatinModernMath + +let font-latin-roman = (FontJunicode.normal, 1., 0.) in +let font-cjk-mincho = (FontIpaEx.mincho, 0.88, 0.) in let inline ctx \math m = embed-math ctx (read-math ctx m) in @@ -15,7 +26,14 @@ let it = {${\exprabsI{x}{e}}} in %let it = {A ${E = m c^2}} in -let ctx = get-initial-context 400pt (command \math) in +let ctx = + get-initial-context 400pt (command \math) + |> set-font Kana font-cjk-mincho + |> set-font HanIdeographic font-cjk-mincho + |> set-font Latin font-latin-roman + |> set-font OtherScript font-latin-roman + |> set-math-font FontLatinModernMath.main +in let paper-size = (210mm, 297mm) in %A4 let pagecontf _ = (| text-origin = (20pt, 20pt), text-height = 600pt, |) in let pagepartsf _ = (| header-origin = (0pt, 0pt), header-content = block-nil, footer-origin = (0pt, 0pt), footer-content = block-nil, |) in diff --git a/tests/refactor3.satysfi-lock-expected b/tests/refactor3.satysfi-lock-expected index a2e98fa3c..46ca436ae 100644 --- a/tests/refactor3.satysfi-lock-expected +++ b/tests/refactor3.satysfi-lock-expected @@ -1 +1,16 @@ -locks: [] +locks: +- name: font-ipa-ex.0.0.1 + location: + type: global + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + dependencies: [] +- name: font-junicode.0.0.1 + location: + type: global + path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + dependencies: [] +- name: font-latin-modern-math.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + dependencies: [] diff --git a/tests/refactor5.saty b/tests/refactor5.saty index 551e67b28..f9fce5eb4 100644 --- a/tests/refactor5.saty +++ b/tests/refactor5.saty @@ -1,3 +1,14 @@ +#[dependencies [ + (`font-junicode`, `0.0.1`), + (`font-ipa-ex`, `0.0.1`), + (`font-latin-modern-math`, `0.0.1`), +]] +use package FontJunicode +use package FontIpaEx +use package FontLatinModernMath + +let font-latin-roman = (FontJunicode.normal, 1., 0.) in +let font-cjk-mincho = (FontIpaEx.mincho, 0.88, 0.) in let test1 ?(i = iopt) s = match iopt with @@ -9,7 +20,14 @@ in let it = embed-string ((test1 `hoge`) ^ `/` ^ (test1 ?(i = 2) `piyo`) ^ `/` ^ (test1 `fuga`)) in let inline ctx \math m = embed-math ctx (read-math ctx m) in -let ctx = get-initial-context 400pt (command \math) in +let ctx = + get-initial-context 400pt (command \math) + |> set-font Kana font-cjk-mincho + |> set-font HanIdeographic font-cjk-mincho + |> set-font Latin font-latin-roman + |> set-font OtherScript font-latin-roman + |> set-math-font FontLatinModernMath.main +in let paper-size = (210mm, 297mm) in %A4 let pagecontf _ = (| text-origin = (20pt, 20pt), text-height = 600pt, |) in let pagepartsf _ = diff --git a/tests/refactor5.satysfi-lock-expected b/tests/refactor5.satysfi-lock-expected index a2e98fa3c..46ca436ae 100644 --- a/tests/refactor5.satysfi-lock-expected +++ b/tests/refactor5.satysfi-lock-expected @@ -1 +1,16 @@ -locks: [] +locks: +- name: font-ipa-ex.0.0.1 + location: + type: global + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + dependencies: [] +- name: font-junicode.0.0.1 + location: + type: global + path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + dependencies: [] +- name: font-latin-modern-math.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + dependencies: [] diff --git a/tests/staged1.satysfi-lock-expected b/tests/staged1.satysfi-lock-expected index 5bd4d4d5f..3ec050ba9 100644 --- a/tests/staged1.satysfi-lock-expected +++ b/tests/staged1.satysfi-lock-expected @@ -11,6 +11,27 @@ locks: path: ./dist/packages/code/code.0.0.1/ dependencies: - stdlib.0.0.1 + - font-latin-modern.0.0.1 +- name: font-ipa-ex.0.0.1 + location: + type: global + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + dependencies: [] +- name: font-junicode.0.0.1 + location: + type: global + path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + dependencies: [] +- name: font-latin-modern.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + dependencies: [] +- name: font-latin-modern-math.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + dependencies: [] - name: math.0.0.1 location: type: global @@ -26,6 +47,10 @@ locks: - math.0.0.1 - annot.0.0.1 - code.0.0.1 + - font-junicode.0.0.1 + - font-latin-modern.0.0.1 + - font-ipa-ex.0.0.1 + - font-latin-modern-math.0.0.1 - name: stdlib.0.0.1 location: type: global From c43ac40d782142091e1d0d21b272fd7df8281b42 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 12 Nov 2022 22:43:17 +0900 Subject: [PATCH 144/288] update lock files of packages --- .../annot/annot.0.0.1/package.satysfi-lock | 9 +++++---- .../dist/packages/annot/annot.0.0.1/satysfi.yaml | 3 +-- .../packages/code/code.0.0.1/package.satysfi-lock | 14 ++++++++++---- .../dist/packages/code/code.0.0.1/satysfi.yaml | 2 +- .../footnote-scheme.0.0.1/package.satysfi-lock | 9 +++++---- .../footnote-scheme.0.0.1/satysfi.yaml | 3 +-- .../itemize/itemize.0.0.1/package.satysfi-lock | 9 +++++---- .../packages/itemize/itemize.0.0.1/satysfi.yaml | 3 +-- .../packages/math/math.0.0.1/package.satysfi-lock | 9 +++++---- .../dist/packages/math/math.0.0.1/satysfi.yaml | 3 +-- .../proof/proof.0.0.1/package.satysfi-lock | 9 +++++---- .../dist/packages/proof/proof.0.0.1/satysfi.yaml | 3 +-- .../tabular/tabular.0.0.1/package.satysfi-lock | 9 +++++---- .../packages/tabular/tabular.0.0.1/satysfi.yaml | 3 +-- 14 files changed, 47 insertions(+), 41 deletions(-) diff --git a/lib-satysfi/dist/packages/annot/annot.0.0.1/package.satysfi-lock b/lib-satysfi/dist/packages/annot/annot.0.0.1/package.satysfi-lock index 3a4c4e576..634d7b23d 100644 --- a/lib-satysfi/dist/packages/annot/annot.0.0.1/package.satysfi-lock +++ b/lib-satysfi/dist/packages/annot/annot.0.0.1/package.satysfi-lock @@ -1,5 +1,6 @@ locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" +- name: stdlib.0.0.1 + location: + type: global + path: ./dist/packages/stdlib/stdlib.0.0.1/ + dependencies: [] diff --git a/lib-satysfi/dist/packages/annot/annot.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/annot/annot.0.0.1/satysfi.yaml index f7d2f9cce..963274f52 100644 --- a/lib-satysfi/dist/packages/annot/annot.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/annot/annot.0.0.1/satysfi.yaml @@ -6,5 +6,4 @@ contents: - "./src" dependencies: - name: "stdlib" - requirements: - - "0.0.1" + requirements: [ "0.0.1" ] diff --git a/lib-satysfi/dist/packages/code/code.0.0.1/package.satysfi-lock b/lib-satysfi/dist/packages/code/code.0.0.1/package.satysfi-lock index 3a4c4e576..5d1def628 100644 --- a/lib-satysfi/dist/packages/code/code.0.0.1/package.satysfi-lock +++ b/lib-satysfi/dist/packages/code/code.0.0.1/package.satysfi-lock @@ -1,5 +1,11 @@ locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" +- name: font-latin-modern.0.0.1 + location: + type: global + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + dependencies: [] +- name: stdlib.0.0.1 + location: + type: global + path: ./dist/packages/stdlib/stdlib.0.0.1/ + dependencies: [] diff --git a/lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml index 0251ae99f..624b06ddf 100644 --- a/lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml @@ -7,5 +7,5 @@ contents: dependencies: - name: "stdlib" requirements: [ "0.0.1" ] - - name: "latin-modern" + - name: "font-latin-modern" requirements: [ "0.0.1" ] diff --git a/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/package.satysfi-lock b/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/package.satysfi-lock index 3a4c4e576..634d7b23d 100644 --- a/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/package.satysfi-lock +++ b/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/package.satysfi-lock @@ -1,5 +1,6 @@ locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" +- name: stdlib.0.0.1 + location: + type: global + path: ./dist/packages/stdlib/stdlib.0.0.1/ + dependencies: [] diff --git a/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml index 4d80fb5c6..1e5b3ec88 100644 --- a/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml @@ -6,5 +6,4 @@ contents: - "./src" dependencies: - name: "stdlib" - requirements: - - "0.0.1" + requirements: [ "0.0.1" ] diff --git a/lib-satysfi/dist/packages/itemize/itemize.0.0.1/package.satysfi-lock b/lib-satysfi/dist/packages/itemize/itemize.0.0.1/package.satysfi-lock index 3a4c4e576..634d7b23d 100644 --- a/lib-satysfi/dist/packages/itemize/itemize.0.0.1/package.satysfi-lock +++ b/lib-satysfi/dist/packages/itemize/itemize.0.0.1/package.satysfi-lock @@ -1,5 +1,6 @@ locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" +- name: stdlib.0.0.1 + location: + type: global + path: ./dist/packages/stdlib/stdlib.0.0.1/ + dependencies: [] diff --git a/lib-satysfi/dist/packages/itemize/itemize.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/itemize/itemize.0.0.1/satysfi.yaml index 4cc7fed31..acb288e1b 100644 --- a/lib-satysfi/dist/packages/itemize/itemize.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/itemize/itemize.0.0.1/satysfi.yaml @@ -6,5 +6,4 @@ contents: - "./src" dependencies: - name: "stdlib" - requirements: - - "0.0.1" + requirements: [ "0.0.1" ] diff --git a/lib-satysfi/dist/packages/math/math.0.0.1/package.satysfi-lock b/lib-satysfi/dist/packages/math/math.0.0.1/package.satysfi-lock index 3a4c4e576..634d7b23d 100644 --- a/lib-satysfi/dist/packages/math/math.0.0.1/package.satysfi-lock +++ b/lib-satysfi/dist/packages/math/math.0.0.1/package.satysfi-lock @@ -1,5 +1,6 @@ locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" +- name: stdlib.0.0.1 + location: + type: global + path: ./dist/packages/stdlib/stdlib.0.0.1/ + dependencies: [] diff --git a/lib-satysfi/dist/packages/math/math.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/math/math.0.0.1/satysfi.yaml index b96d863ad..b1bf5c1df 100644 --- a/lib-satysfi/dist/packages/math/math.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/math/math.0.0.1/satysfi.yaml @@ -6,5 +6,4 @@ contents: - "./src" dependencies: - name: "stdlib" - requirements: - - "0.0.1" + requirements: [ "0.0.1" ] diff --git a/lib-satysfi/dist/packages/proof/proof.0.0.1/package.satysfi-lock b/lib-satysfi/dist/packages/proof/proof.0.0.1/package.satysfi-lock index 3a4c4e576..634d7b23d 100644 --- a/lib-satysfi/dist/packages/proof/proof.0.0.1/package.satysfi-lock +++ b/lib-satysfi/dist/packages/proof/proof.0.0.1/package.satysfi-lock @@ -1,5 +1,6 @@ locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" +- name: stdlib.0.0.1 + location: + type: global + path: ./dist/packages/stdlib/stdlib.0.0.1/ + dependencies: [] diff --git a/lib-satysfi/dist/packages/proof/proof.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/proof/proof.0.0.1/satysfi.yaml index 5467511b2..1b7274a7e 100644 --- a/lib-satysfi/dist/packages/proof/proof.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/proof/proof.0.0.1/satysfi.yaml @@ -6,5 +6,4 @@ contents: - "./src" dependencies: - name: "stdlib" - requirements: - - "0.0.1" + requirements: [ "0.0.1" ] diff --git a/lib-satysfi/dist/packages/tabular/tabular.0.0.1/package.satysfi-lock b/lib-satysfi/dist/packages/tabular/tabular.0.0.1/package.satysfi-lock index 3a4c4e576..634d7b23d 100644 --- a/lib-satysfi/dist/packages/tabular/tabular.0.0.1/package.satysfi-lock +++ b/lib-satysfi/dist/packages/tabular/tabular.0.0.1/package.satysfi-lock @@ -1,5 +1,6 @@ locks: - - name: "stdlib.0.0.1" - location: - type: "global" - path: "./dist/packages/stdlib/stdlib.0.0.1/" +- name: stdlib.0.0.1 + location: + type: global + path: ./dist/packages/stdlib/stdlib.0.0.1/ + dependencies: [] diff --git a/lib-satysfi/dist/packages/tabular/tabular.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/tabular/tabular.0.0.1/satysfi.yaml index be9c9a3fb..c577d335c 100644 --- a/lib-satysfi/dist/packages/tabular/tabular.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/tabular/tabular.0.0.1/satysfi.yaml @@ -6,5 +6,4 @@ contents: - "./src" dependencies: - name: "stdlib" - requirements: - - "0.0.1" + requirements: [ "0.0.1" ] From 43a5085a8041cc8762c5020756a91493b7b4d393 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 13 Nov 2022 00:00:26 +0900 Subject: [PATCH 145/288] disable printf for debugging --- src/frontend/fontInfo.ml | 8 -------- src/frontend/signatureSubtyping.ml | 3 --- 2 files changed, 11 deletions(-) diff --git a/src/frontend/fontInfo.ml b/src/frontend/fontInfo.ml index 3c18e0324..a49b51165 100644 --- a/src/frontend/fontInfo.ml +++ b/src/frontend/fontInfo.ml @@ -50,7 +50,6 @@ end = struct let initialize () = - Printf.printf "**** INITIALIZE\n"; (* TODO: remove this *) Ht.clear key_to_definition_hash_table; FontKey.initialize (); current_tag_number := 0 @@ -66,7 +65,6 @@ end = struct let key = FontKey.generate () in let storeref = ref UnusedSingle in Ht.add key_to_definition_hash_table key (abspath, storeref); - Printf.printf "**** %s = SINGLE %s\n" (FontKey.show key) (get_abs_path_string abspath); (* TODO: remove this *) key @@ -75,7 +73,6 @@ end = struct let key = FontKey.generate () in let storeref = ref (UnusedTTC(index)) in Ht.add key_to_definition_hash_table key (abspath, storeref); - Printf.printf "**** %s = TTC %s, %d\n" (FontKey.show key) (get_abs_path_string abspath) index; (* TODO: remove this *) key @@ -92,7 +89,6 @@ end = struct let open ResultMonad in match Ht.find_opt key_to_definition_hash_table key with | None -> - Printf.printf "**** FIND %s\n" (FontKey.show key); (* TODO: remove this *) assert false | Some((abspath, storeref)) -> @@ -254,7 +250,6 @@ end = struct let initialize () = - Printf.printf "**** INITIALIZE MATH\n"; (* TODO: remove this *) Ht.clear key_to_definition_hash_table; current_tag_number := 0 @@ -268,7 +263,6 @@ end = struct let mathkey = FontKey.generate () in let storeref = ref UnusedMathSingle in Ht.add key_to_definition_hash_table mathkey (abspath, storeref); - Printf.printf "**** %s = MATH SINGLE %s\n" (FontKey.show mathkey) (get_abs_path_string abspath); (* TODO: remove this *) mathkey @@ -276,7 +270,6 @@ end = struct let mathkey = FontKey.generate () in let storeref = ref (UnusedMathTTC(index)) in Ht.add key_to_definition_hash_table mathkey (abspath, storeref); - Printf.printf "**** %s = MATH TTC %s, %d\n" (FontKey.show mathkey) (get_abs_path_string abspath) index; (* TODO: remove this *) mathkey @@ -293,7 +286,6 @@ end = struct let open ResultMonad in match Ht.find_opt key_to_definition_hash_table mathkey with | None -> - Printf.printf "**** FIND MATH %s\n" (FontKey.show mathkey); (* TODO: remove this *) assert false | Some((abspath, storeref)) -> diff --git a/src/frontend/signatureSubtyping.ml b/src/frontend/signatureSubtyping.ml index d3463cdfc..d65649a11 100644 --- a/src/frontend/signatureSubtyping.ml +++ b/src/frontend/signatureSubtyping.ml @@ -62,7 +62,6 @@ let rec lookup_struct (rng : Range.t) (modsig1 : signature) (modsig2 : signature begin match lookup_type_entry tentry1 tentry2 with | None -> - let () = print_endline "****** 3" in (* TODO: remove this *) err (NotASubtypeAboutType(rng, tynm2, tentry1, tentry2)) | Some(subst0) -> @@ -345,7 +344,6 @@ and subtype_concrete_with_concrete (rng : Range.t) (modsig1 : signature) (modsig begin match (ssig1 |> StructSig.find_type tynm2, ssig2 |> StructSig.find_type tynm2) with | (Some(tentry1), Some(tentry2)) -> - print_endline "****** 1"; (* TODO: remove this *) err (NotASubtypeAboutType(rng, tynm2, tentry1, tentry2)) | _ -> @@ -370,7 +368,6 @@ and subtype_concrete_with_concrete (rng : Range.t) (modsig1 : signature) (modsig if b1 && b2 then return () else - let () = print_endline "****** 2" in (* TODO: remove this *) err (NotASubtypeAboutType(rng, tynm2, tentry1, tentry2)) ) ~m:(fun modnm2 { mod_signature = modsig2; _ } res -> From 47cbcdc4b3aabc83d8b2febeb0167fccc13cbeda Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 13 Nov 2022 01:53:19 +0900 Subject: [PATCH 146/288] refactor 'FontInfo' and 'FontFormat' --- src/backend/fontFormat.ml | 501 +++++++++++++++++++----------------- src/backend/fontFormat.mli | 22 +- src/frontend/configError.ml | 7 - src/frontend/fontError.ml | 17 ++ src/frontend/fontInfo.ml | 87 ++----- src/frontend/fontInfo.mli | 2 +- src/frontend/main.ml | 59 +++-- 7 files changed, 362 insertions(+), 333 deletions(-) create mode 100644 src/frontend/fontError.ml diff --git a/src/backend/fontFormat.ml b/src/backend/fontFormat.ml index 3cdff0b02..69e19fb35 100644 --- a/src/backend/fontFormat.ml +++ b/src/backend/fontFormat.ml @@ -1,14 +1,18 @@ open MyUtil +open FontError module V = Otfed.Value module I = Otfed.Intermediate module D = Otfed.Decode +exception FontError of font_error +exception BrokenFont of abs_path * string + type original_glyph_id = V.glyph_id -type 'a ok = ('a, D.Error.t) result +type 'a ok = ('a, font_error) result type design_units = V.design_units @@ -17,16 +21,17 @@ type per_mille = type metrics = per_mille * per_mille * per_mille -exception FailToLoadFontOwingToSystem of abs_path * string -exception BrokenFont of abs_path * string -exception CannotFindUnicodeCmap of abs_path - let broken srcpath oerr s = let msg = Format.asprintf "%a" D.Error.pp oerr in raise (BrokenFont(srcpath, msg ^ "; " ^ s)) +let raise_if_err = function + | Ok(v) -> v + | Error(e) -> raise (FontError(e)) + + let pickup xs predicate e = let open ResultMonad in match xs |> List.filter predicate with @@ -51,8 +56,9 @@ type font_registration = (* Last boolean: true iff it should embed /W information *) -let extract_registration (d : D.source) = +let extract_registration (d : D.source) : font_registration ok = let open ResultMonad in + begin match d with | D.Cff(cff) -> begin @@ -75,50 +81,55 @@ let extract_registration (d : D.source) = | D.Ttf(_) -> return (CIDFontType2OTRegistration(adobe_identity, true)) + end + |> Result.map_error (fun e -> FailedToDecodeFont(e)) -let get_main_decoder_single (abspath : abs_path) : ((D.source * font_registration) option) ok = - match read_file abspath with - | Ok(s) -> - let open ResultMonad in - begin - D.source_of_string s >>= function - | D.Collection(_) -> - return None +let get_main_decoder_single (abspath : abs_path) : (D.source * font_registration) ok = + let open ResultMonad in + let* data = + read_file abspath + |> Result.map_error (fun msg -> FailedToReadFont(abspath, msg)) + in + let* source = + D.source_of_string data + |> Result.map_error (fun e -> FailedToDecodeFont(e)) + in + match source with + | D.Collection(_) -> + err @@ NotASingleFont(abspath) - | D.Single(d) -> - extract_registration d >>= fun registration -> - return (Some((d, registration))) - end + | D.Single(d) -> + extract_registration d >>= fun registration -> + return (d, registration) - | Error(msg) -> - raise (FailToLoadFontOwingToSystem(abspath, msg)) +let get_main_decoder_ttc (abspath : abs_path) (index : int) : (D.source * font_registration) ok = + let open ResultMonad in + let* data = + read_file abspath + |> Result.map_error (fun msg -> FailedToReadFont(abspath, msg)) + in + let* source = + D.source_of_string data + |> Result.map_error (fun e -> FailedToDecodeFont(e)) + in + match source with + | D.Single(_) -> + err @@ NotAFontCollectionElement(abspath, index) -let get_main_decoder_ttc (abspath : abs_path) (i : int) : ((D.source * font_registration) option) ok = - match read_file abspath with - | Ok(s) -> - let open ResultMonad in + | D.Collection(ds) -> begin - D.source_of_string s >>= function - | D.Single(_) -> - return None - - | D.Collection(ds) -> - begin - match List.nth_opt ds i with - | None -> - return None + match List.nth_opt ds index with + | None -> + let num_elements = List.length ds in + err @@ CollectionIndexOutOfBounds{ path = abspath; index; num_elements } - | Some(d) -> - extract_registration d >>= fun registration -> - return (Some((d, registration))) - end + | Some(d) -> + extract_registration d >>= fun registration -> + return (d, registration) end - | Error(msg) -> - raise (FailToLoadFontOwingToSystem(abspath, msg)) - module UHt = Hashtbl.Make(struct type t = Uchar.t @@ -1055,6 +1066,7 @@ let get_kerning_table srcpath (d : D.source) = type decoder = { file_path : abs_path; + postscript_name : string; main : D.source; cmap_subtable : V.Cmap.subtable; head_record : I.Head.t; @@ -1078,32 +1090,33 @@ let get_original_gid (_dcdr : decoder) (gid : glyph_id) : original_glyph_id = let get_ttf_raw_bbox (ttf : D.ttf_source) (gidorg : original_glyph_id) : ((design_units * design_units * design_units * design_units) option) ok = let open ResultMonad in - D.Ttf.loca ttf gidorg >>= function - | None -> - return None - - | Some(gloc) -> - D.Ttf.glyf ttf gloc >>= fun ttf_glyph_info -> - let V.{ x_min; y_min; x_max; y_max } = ttf_glyph_info.bounding_box in - return (Some((x_min, y_min, x_max, y_max))) + begin + D.Ttf.loca ttf gidorg >>= function + | None -> + return None + | Some(gloc) -> + D.Ttf.glyf ttf gloc >>= fun ttf_glyph_info -> + let V.{ x_min; y_min; x_max; y_max } = ttf_glyph_info.bounding_box in + return (Some((x_min, y_min, x_max, y_max))) + end + |> Result.map_error (fun e -> FailedToDecodeFont(e)) let bbox_zero = (PerMille(0), PerMille(0), PerMille(0), PerMille(0)) -let get_ttf_bbox ~(units_per_em : int) ~(file_path : abs_path) (ttf : D.ttf_source) (gidorg : original_glyph_id) : bbox = +let get_ttf_bbox ~(units_per_em : int) (ttf : D.ttf_source) (gidorg : original_glyph_id) : bbox ok = + let open ResultMonad in let f = per_mille ~units_per_em in - match get_ttf_raw_bbox ttf gidorg with - | Error(e) -> - broken file_path e (Printf.sprintf "get_ttf_bbox (gid = %d)" gidorg) - - | Ok(None) -> - bbox_zero + let* bbox_opt = get_ttf_raw_bbox ttf gidorg in + match bbox_opt with + | None -> + return bbox_zero - | Ok(Some(bbox_raw)) -> + | Some(bbox_raw) -> let (xmin_raw, ymin_raw, xmax_raw, ymax_raw) = bbox_raw in - (f xmin_raw, f ymin_raw, f xmax_raw, f ymax_raw) + return (f xmin_raw, f ymin_raw, f xmax_raw, f ymax_raw) let get_glyph_advance_width (dcdr : decoder) (gidorg_key : original_glyph_id) : per_mille = @@ -1119,16 +1132,15 @@ let get_glyph_advance_width (dcdr : decoder) (gidorg_key : original_glyph_id) : | Ok(Some((adv, _lsb))) -> per_mille ~units_per_em:dcdr.units_per_em adv -let get_bbox (dcdr : decoder) (gidorg : original_glyph_id) : bbox = +let get_bbox (dcdr : decoder) (gidorg : original_glyph_id) : bbox ok = + let open ResultMonad in let units_per_em = dcdr.units_per_em in - let file_path = dcdr.file_path in match dcdr.main with | D.Ttf(ttf) -> - get_ttf_bbox ~units_per_em ~file_path ttf gidorg + get_ttf_bbox ~units_per_em ttf gidorg | D.Cff(cff) -> - let res = - let open ResultMonad in + begin D.Cff.charstring cff gidorg >>= function | None -> return bbox_zero @@ -1146,33 +1158,33 @@ let get_bbox (dcdr : decoder) (gidorg : original_glyph_id) : bbox = let f = per_mille ~units_per_em in (f x_min, f y_min, f x_max, f y_max) end - in - match res with - | Error(oerr) -> - broken dcdr.file_path oerr (Printf.sprintf "get_bbox (gid = %d)" gidorg) - - | Ok(bbox_opt) -> - bbox_opt + end + |> Result.map_error (fun e -> FailedToDecodeFont(e)) -let get_glyph_metrics (dcdr : decoder) (gid : glyph_id) : metrics = +let get_glyph_metrics (dcdr : decoder) (gid : glyph_id) : metrics ok = + let open ResultMonad in let bboxtbl = dcdr.glyph_bbox_table in let gidorg = get_original_gid dcdr gid in - let (wid, (_, ymin, _, ymax)) = + let* (wid, (_, ymin, _, ymax)) = match bboxtbl |> GlyphBBoxTable.find_opt gidorg with | Some(pair) -> - pair + return pair | None -> let wid = get_glyph_advance_width dcdr gidorg in - let bbox = get_bbox dcdr gidorg in + let* bbox = get_bbox dcdr gidorg in let pair = (wid, bbox) in bboxtbl |> GlyphBBoxTable.add gidorg pair; - pair + return pair in let hgt = ymax in let dpt = ymin in - (wid, hgt, dpt) + return (wid, hgt, dpt) + + +let get_glyph_metrics_exn (dcdr : decoder) (gid : glyph_id) : metrics = + raise_if_err @@ get_glyph_metrics dcdr gid type 'a resource = @@ -1331,18 +1343,19 @@ let cmap_predicate f = List.find_opt (fun (subtbl, format) -> f (subtbl.V.Cmap.subtable_ids, format)) -let get_cmap_subtable srcpath (d : D.source) : V.Cmap.subtable = - let res = - let open ResultMonad in - D.Cmap.get d >>= fun icmap -> - D.Cmap.get_subtables icmap >>= fun isubtbls -> - isubtbls |> List.fold_left (fun res isubtbl -> (* TODO: refactor here by using `mapM` *) - res >>= fun acc -> - let format = D.Cmap.get_format_number isubtbl in - D.Cmap.unmarshal_subtable isubtbl >>= fun subtbl -> - return (Alist.extend acc (subtbl, format)) - ) (return Alist.empty) >>= fun acc -> - let subtbls = Alist.to_list acc in +let get_cmap_subtable ~(file_path : abs_path) (d : D.source) : V.Cmap.subtable ok = + let open ResultMonad in + let* opt = + begin + D.Cmap.get d >>= fun icmap -> + D.Cmap.get_subtables icmap >>= fun isubtbls -> + isubtbls |> List.fold_left (fun res isubtbl -> (* TODO: refactor here by using `mapM` *) + res >>= fun acc -> + let format = D.Cmap.get_format_number isubtbl in + D.Cmap.unmarshal_subtable isubtbl >>= fun subtbl -> + return (Alist.extend acc (subtbl, format)) + ) (return Alist.empty) >>= fun acc -> + let subtbls = Alist.to_list acc in let opt = List.fold_left (fun opt idspred -> match opt with @@ -1357,13 +1370,13 @@ let get_cmap_subtable srcpath (d : D.source) : V.Cmap.subtable = (fun (V.Cmap.{ platform_id; _ }, _) -> platform_id = 1); ] in - match opt with - | None -> raise (CannotFindUnicodeCmap(srcpath)) - | Some(subtbl) -> return subtbl + return opt + end + |> Result.map_error (fun e -> FailedToDecodeFont(e)) in - match res with - | Error(oerr) -> broken srcpath oerr "get_cmap_subtable" - | Ok((subtbl, _)) -> subtbl + match opt with + | None -> err @@ CannotFindUnicodeCmap(file_path) + | Some((subtbl, _)) -> return subtbl let get_glyph_id (dcdr : decoder) (uch : Uchar.t) : glyph_id option = @@ -1434,31 +1447,32 @@ let font_descriptor_of_decoder (dcdr : decoder) (font_name : string) = } -let get_postscript_name (dcdr : decoder) = - let d = dcdr.main in - let res = - let open ResultMonad in - D.Name.get d >>= fun iname -> - return begin - iname.V.Name.name_records |> List.find_map (fun name_record -> - let V.Name.{ platform_id; encoding_id; name_id; name; _ } = name_record in - if name_id = 6 then - (* If the entry contains the PostScript name: *) - if platform_id = 0 || platform_id = 1 then - Some(name) - else if platform_id = 3 && encoding_id = 1 then - Some(InternalText.to_utf8 (InternalText.of_utf16be name)) - else - None +let get_postscript_name ~(file_path : abs_path) (d : D.source) : string ok = + let open ResultMonad in + let* vname = + D.Name.get d + |> Result.map_error (fun e -> FailedToDecodeFont(e)) + in + let name_opt = + vname.V.Name.name_records |> List.find_map (fun name_record -> + let V.Name.{ platform_id; encoding_id; name_id; name; _ } = name_record in + if name_id = 6 then + if platform_id = 0 || platform_id = 1 then + Some(name) + else if platform_id = 3 && encoding_id = 1 then + Some(InternalText.to_utf8 (InternalText.of_utf16be name)) else None - ) - end + else + None + ) in - match res with - | Error(e) -> broken dcdr.file_path e "get_postscript_name" - | Ok(None) -> assert false (* temporary *) - | Ok(Some(x)) -> x + match name_opt with + | None -> + err @@ PostscriptNameNotFound(file_path) + + | Some(name) -> + return name (* -w -unused-constructor *) @@ -1475,31 +1489,30 @@ let font_file_info_of_embedding embedding = | FontFile3(sub) -> ("/FontFile3", Some(sub)) -module CIDFontType0 -= struct - type font = { - cid_system_info : cid_system_info; - base_font : string; - font_descriptor : font_descriptor; - dw : design_units option; (* Represented by units defined by head.unitsPerEm *) - dw2 : (int * int) option; - (* temporary; should contain more fields; /W2 *) - } - (* Doesn't have to contain information about /W entry; - the PDF file will be furnished with /W entry when outputted - according to the glyph metrics table. *) +module CIDFontType0 = struct + type font = { + cid_system_info : cid_system_info; + base_font : string; + font_descriptor : font_descriptor; + dw : design_units option; (* Represented by units defined by head.unitsPerEm *) + dw2 : (int * int) option; + (* temporary; should contain more fields; /W2 *) + } + (* Doesn't have to contain information about /W entry; + the PDF file will be furnished with /W entry when outputted + according to the glyph metrics table. *) - let of_decoder dcdr cidsysinfo = - let base_font = get_postscript_name dcdr in - { - cid_system_info = cidsysinfo; - base_font = base_font; - font_descriptor = font_descriptor_of_decoder dcdr base_font; - dw = None; (* temporary *) - dw2 = None; (* temporary *) - } - end + let of_decoder dcdr cidsysinfo = + let base_font = dcdr.postscript_name in + { + cid_system_info = cidsysinfo; + base_font = base_font; + font_descriptor = font_descriptor_of_decoder dcdr base_font; + dw = None; (* temporary *) + dw2 = None; (* temporary *) + } +end (* -w -unused-constructor *) @@ -1508,34 +1521,33 @@ type[@ocaml.warning "-37"] cid_to_gid_map = | CIDToGIDStream of (string resource) ref (* temporary *) -module CIDFontType2 -= struct - type font = { - cid_system_info : cid_system_info; - base_font : string; - font_descriptor : font_descriptor; - dw : int option; - dw2 : (int * int) option; - cid_to_gid_map : cid_to_gid_map; - is_pure_truetype : bool; - (* temporary; should contain more fields; /W2 *) - } - (* Doesn't have to contain information about /W entry; - the /W entry will be added by using the glyph metrics table when the PDF file is outputted. *) +module CIDFontType2 = struct + type font = { + cid_system_info : cid_system_info; + base_font : string; + font_descriptor : font_descriptor; + dw : int option; + dw2 : (int * int) option; + cid_to_gid_map : cid_to_gid_map; + is_pure_truetype : bool; + (* temporary; should contain more fields; /W2 *) + } + (* Doesn't have to contain information about /W entry; + the /W entry will be added by using the glyph metrics table when the PDF file is outputted. *) - let of_decoder dcdr cidsysinfo isptt = - let base_font = get_postscript_name dcdr in - { - cid_system_info = cidsysinfo; - base_font = base_font; - font_descriptor = font_descriptor_of_decoder dcdr base_font; - dw = None; (* temporary *) - dw2 = None; (* temporary *) - is_pure_truetype = isptt; - cid_to_gid_map = CIDToGIDIdentity; (* temporary *) - } - end + let of_decoder dcdr cidsysinfo isptt = + let base_font = dcdr.postscript_name in + { + cid_system_info = cidsysinfo; + base_font = base_font; + font_descriptor = font_descriptor_of_decoder dcdr base_font; + dw = None; (* temporary *) + dw2 = None; (* temporary *) + is_pure_truetype = isptt; + cid_to_gid_map = CIDToGIDIdentity; (* temporary *) + } +end type cid_font = @@ -1806,40 +1818,47 @@ let make_dictionary (pdf : Pdf.t) (font : font) (dcdr : decoder) : Pdf.pdfobject | Type0(ty0font) -> Type0.to_pdfdict pdf ty0font dcdr -let make_decoder (abspath : abs_path) (d : D.source) : decoder = - let cmapsubtbl = get_cmap_subtable abspath d in +let make_decoder (abspath : abs_path) (d : D.source) : decoder ok = + let open ResultMonad in + let* cmapsubtbl = get_cmap_subtable ~file_path:abspath d in let submap = SubsetMap.create abspath d 32 in (* temporary; initial size of hash tables *) let gidtbl = GlyphIDTable.create submap 256 in (* temporary; initial size of hash tables *) let bboxtbl = GlyphBBoxTable.create 256 in (* temporary; initial size of hash tables *) - let (rcdhhea, ascent, descent) = - match D.Hhea.get d with - | Ok(ihhea) -> (ihhea, ihhea.value.ascender, ihhea.value.descender) - | Error(e) -> broken abspath e "make_decoder (hhea)" + let* (rcdhhea, ascent, descent) = + begin + let* ihhea = D.Hhea.get d in + return (ihhea, ihhea.value.ascender, ihhea.value.descender) + end + |> Result.map_error (fun e -> FailedToDecodeFont(e)) in - let (rcdhead, units_per_em) = - match D.Head.get d with - | Ok(ihead) -> (ihead, ihead.value.units_per_em) - | Error(e) -> broken abspath e "make_decoder (head)" + let* (rcdhead, units_per_em) = + begin + let* ihead = D.Head.get d in + return (ihead, ihead.value.units_per_em) + end + |> Result.map_error (fun e -> FailedToDecodeFont(e)) in + let* postscript_name = get_postscript_name ~file_path:abspath d in let kerntbl = get_kerning_table abspath d in let ligtbl = get_ligature_table abspath submap d in let mktbl = get_mark_table abspath units_per_em d in - { - file_path = abspath; - main = d; - cmap_subtable = cmapsubtbl; - head_record = rcdhead; - hhea_record = rcdhhea; - kerning_table = kerntbl; - ligature_table = ligtbl; - mark_table = mktbl; - subset_map = submap; - glyph_id_table = gidtbl; - glyph_bbox_table = bboxtbl; - units_per_em = units_per_em; - default_ascent = per_mille ~units_per_em ascent; - default_descent = per_mille ~units_per_em descent; - } + return { + file_path = abspath; + postscript_name = postscript_name; + main = d; + cmap_subtable = cmapsubtbl; + head_record = rcdhead; + hhea_record = rcdhhea; + kerning_table = kerntbl; + ligature_table = ligtbl; + mark_table = mktbl; + subset_map = submap; + glyph_id_table = gidtbl; + glyph_bbox_table = bboxtbl; + units_per_em = units_per_em; + default_ascent = per_mille ~units_per_em ascent; + default_descent = per_mille ~units_per_em descent; + } let cid_font_type_0 cidty0font fontname cmap = @@ -1850,33 +1869,34 @@ let cid_font_type_2 cidty2font fontname cmap = Type0(Type0.of_cid_font (CIDFontType2(cidty2font)) fontname cmap) -let get_font (dcdr : decoder) (fontreg : font_registration) (fontname : string) : font = +let get_font (dcdr : decoder) (fontreg : font_registration) : font = let cmap = PredefinedCMap("Identity-H") in match fontreg with | CIDFontType0Registration(cidsysinfo, _embedW) -> let cidty0font = CIDFontType0.of_decoder dcdr cidsysinfo in - (cid_font_type_0 cidty0font fontname cmap) + (cid_font_type_0 cidty0font dcdr.postscript_name cmap) | CIDFontType2OTRegistration(cidsysinfo, _embedW) -> let cidty2font = CIDFontType2.of_decoder dcdr cidsysinfo true (* temporary *) in - (cid_font_type_2 cidty2font fontname cmap) + (cid_font_type_2 cidty2font dcdr.postscript_name cmap) -let get_decoder_single (fontname : string) (abspath : abs_path) : (decoder * font) option = - match get_main_decoder_single abspath with - | Error(oerr) -> broken abspath oerr "get_decoder_single" - | Ok(None) -> None - | Ok(Some((d, fontreg))) -> let dcdr = make_decoder abspath d in Some((dcdr, get_font dcdr fontreg fontname)) +let get_decoder_single (abspath : abs_path) : (decoder * font) ok = + let open ResultMonad in + let* (d, fontreg) = get_main_decoder_single abspath in + let* dcdr = make_decoder abspath d in + return (dcdr, get_font dcdr fontreg) -let get_decoder_ttc (fontname : string) (abspath :abs_path) (i : int) : (decoder * font) option = - match get_main_decoder_ttc abspath i with - | Error(oerr) -> broken abspath oerr "get_decoder_ttc" - | Ok(None) -> None - | Ok(Some((d, fontreg))) -> let dcdr = make_decoder abspath d in Some((dcdr, get_font dcdr fontreg fontname)) +let get_decoder_ttc (abspath :abs_path) (index : int) : (decoder * font) ok = + let open ResultMonad in + let* (d, fontreg) = get_main_decoder_ttc abspath index in + let* dcdr = make_decoder abspath d in + return (dcdr, get_font dcdr fontreg) -let convert_to_ligatures (dcdr : decoder) (seglst : glyph_segment list) : glyph_synthesis list = +let convert_to_ligatures (dcdr : decoder) (seglst : glyph_segment list) : (glyph_synthesis list) ok = + let open ResultMonad in let ligtbl = dcdr.ligature_table in let mktbl = dcdr.mark_table in let intf = intern_gid dcdr in @@ -1889,13 +1909,13 @@ let convert_to_ligatures (dcdr : decoder) (seglst : glyph_segment list) : glyph_ let rec aux acc segorglst = match ligtbl |> LigatureTable.match_prefix segorglst mktbl with | ReachEnd -> - Alist.to_list acc + return @@ Alist.to_list acc | Match(gidorglig, markorginfolst, segorgrest) -> - let markinfolst = - markorginfolst |> List.map (fun (gidorg, v) -> - let (w, _, _) = get_glyph_metrics dcdr (intf gidorg) in - Mark(intf gidorg, w, v) + let* markinfolst = + markorginfolst |> mapM (fun (gidorg, v) -> + let* (w, _, _) = get_glyph_metrics dcdr (intf gidorg) in + return @@ Mark(intf gidorg, w, v) ) in aux (Alist.extend acc (intf gidorglig, markinfolst)) segorgrest @@ -1904,6 +1924,10 @@ let convert_to_ligatures (dcdr : decoder) (seglst : glyph_segment list) : glyph_ aux Alist.empty segorglst +let convert_to_ligatures_exn (dcdr : decoder) (segs : glyph_segment list) : glyph_synthesis list = + raise_if_err @@ convert_to_ligatures dcdr segs + + let find_kerning (dcdr : decoder) (gidprev : glyph_id) (gid : glyph_id) : per_mille option = let kerntbl = dcdr.kerning_table in let gidorgprev = get_original_gid dcdr gidprev in @@ -1994,17 +2018,19 @@ let assoc_to_map f gidassoc = ) MathInfoMap.empty -let make_math_decoder_from_decoder (abspath : abs_path) ((dcdr, font) : decoder * font) = +let make_math_decoder_from_decoder (abspath : abs_path) (dcdr : decoder) (font : font) : (math_decoder * font) ok = + let open ResultMonad in let units_per_em = dcdr.units_per_em in let d = dcdr.main in - match D.Math.get d with - | Error(oerr) -> - broken abspath oerr "make_math_decoder_from_decoder" - - | Ok(None) -> - None + let* mathraw_opt = + D.Math.get d + |> Result.map_error (fun e -> FailedToDecodeFont(e)) + in + match mathraw_opt with + | None -> + err @@ NoMathTable(abspath) - | Ok(Some(mathraw)) -> + | Some(mathraw) -> let micmap = mathraw.V.Math.math_glyph_info.V.Math.math_italics_correction |> assoc_to_map (fun v -> per_mille ~units_per_em (get_main_math_value v)) @@ -2031,7 +2057,7 @@ let make_math_decoder_from_decoder (abspath : abs_path) ((dcdr, font) : decoder ) ) in - let sstyopt = + let* ssty_opt = let res = let open ResultMonad in inject @@ D.Gsub.get d >>= function @@ -2049,14 +2075,14 @@ let make_math_decoder_from_decoder (abspath : abs_path) ((dcdr, font) : decoder in match res with | Ok(feature_ssty) -> - Some(feature_ssty) + return @@ Some(feature_ssty) | Error(MissingScript) | Error(MissingFeature) -> - None + return None - | Error(GeneralError(oerr)) -> - broken abspath oerr "make_math_decoder_from_decoder" + | Error(GeneralError(e)) -> + err @@ FailedToDecodeFont(e) in let md = { @@ -2067,20 +2093,22 @@ let make_math_decoder_from_decoder (abspath : abs_path) ((dcdr, font) : decoder math_vertical_variants = mvertvarmap; math_horizontal_variants = mhorzvarmap; math_kern_info = mkimap; - script_style_info = sstyopt; + script_style_info = ssty_opt; } in - Some((md, font)) + return (md, font) -let get_math_decoder_single (fontname : string) (abspath : abs_path) : (math_decoder * font) option = - let open OptionMonad in - get_decoder_single fontname abspath >>= make_math_decoder_from_decoder abspath +let get_math_decoder_single (abspath : abs_path) : (math_decoder * font) ok = + let open ResultMonad in + let* (dcdr, font) = get_decoder_single abspath in + make_math_decoder_from_decoder abspath dcdr font -let get_math_decoder_ttc (fontname : string) (abspath : abs_path) (i : int) : (math_decoder * font) option = - let open OptionMonad in - get_decoder_ttc fontname abspath i >>= make_math_decoder_from_decoder abspath +let get_math_decoder_ttc (abspath : abs_path) (index : int) : (math_decoder * font) ok = + let open ResultMonad in + let* (dcdr, font) = get_decoder_ttc abspath index in + make_math_decoder_from_decoder abspath dcdr font let get_math_script_variant (md : math_decoder) (gid : glyph_id) : glyph_id = @@ -2124,14 +2152,19 @@ let truncate_positive (PerMille(x)) = PerMille(min 0 x) -let get_math_glyph_metrics (md : math_decoder) (gid : glyph_id) : per_mille * per_mille * per_mille = +let get_math_glyph_metrics (md : math_decoder) (gid : glyph_id) : metrics ok = + let open ResultMonad in let dcdr = md.as_normal_font in - let (wid, _, _) = get_glyph_metrics dcdr gid in + let* (wid, _, _) = get_glyph_metrics dcdr gid in let gidorg = get_original_gid dcdr gid in - let (_, ymin, _, ymax) = get_bbox md.as_normal_font gidorg in + let* (_, ymin, _, ymax) = get_bbox md.as_normal_font gidorg in let hgt = truncate_negative ymax in let dpt = truncate_positive ymin in - (wid, hgt, dpt) + return (wid, hgt, dpt) + + +let get_math_glyph_metrics_exn (md : math_decoder) (gid : glyph_id) : metrics = + raise_if_err @@ get_math_glyph_metrics md gid let get_math_correction_metrics (md : math_decoder) (gid : glyph_id) : per_mille option * math_kern_info option = diff --git a/src/backend/fontFormat.mli b/src/backend/fontFormat.mli index 2413b05b6..65fab8ea5 100644 --- a/src/backend/fontFormat.mli +++ b/src/backend/fontFormat.mli @@ -1,5 +1,9 @@ open MyUtil +open FontError + +exception BrokenFont of abs_path * string +exception FontError of font_error type glyph_id @@ -21,10 +25,6 @@ val hex_of_glyph_id : glyph_id -> string type decoder -exception FailToLoadFontOwingToSystem of abs_path * string -exception BrokenFont of abs_path * string -exception CannotFindUnicodeCmap of abs_path - type 'a resource = | Data of 'a | EmbeddedStream of int @@ -39,15 +39,15 @@ type font val make_dictionary : Pdf.t -> font -> decoder -> Pdf.pdfobject -val get_decoder_single : string -> abs_path -> (decoder * font) option +val get_decoder_single : abs_path -> (decoder * font, font_error) result -val get_decoder_ttc : string -> abs_path -> int -> (decoder * font) option +val get_decoder_ttc : abs_path -> int -> (decoder * font, font_error) result -val get_glyph_metrics : decoder -> glyph_id -> metrics +val get_glyph_metrics_exn : decoder -> glyph_id -> metrics val get_glyph_id : decoder -> Uchar.t -> glyph_id option -val convert_to_ligatures : decoder -> glyph_segment list -> glyph_synthesis list +val convert_to_ligatures_exn : decoder -> glyph_segment list -> glyph_synthesis list val find_kerning : decoder -> glyph_id -> glyph_id -> per_mille option @@ -63,9 +63,9 @@ type math_kern_info = type math_decoder -val get_math_decoder_single : string -> abs_path -> (math_decoder * font) option +val get_math_decoder_single : abs_path -> (math_decoder * font, font_error) result -val get_math_decoder_ttc : string -> abs_path -> int -> (math_decoder * font) option +val get_math_decoder_ttc : abs_path -> int -> (math_decoder * font, font_error) result val math_base_font : math_decoder -> decoder @@ -73,7 +73,7 @@ val get_math_glyph_id : math_decoder -> Uchar.t -> glyph_id option val get_math_script_variant : math_decoder -> glyph_id -> glyph_id -val get_math_glyph_metrics : math_decoder -> glyph_id -> metrics +val get_math_glyph_metrics_exn : math_decoder -> glyph_id -> metrics val get_math_correction_metrics : math_decoder -> glyph_id -> per_mille option * math_kern_info option diff --git a/src/frontend/configError.ml b/src/frontend/configError.ml index 8a9e4d2b5..ac196ec67 100644 --- a/src/frontend/configError.ml +++ b/src/frontend/configError.ml @@ -72,10 +72,3 @@ type config_error = } | CannotSolvePackageConstraints | DocumentAttributeError of DocumentAttribute.error - -type font_error = - | NotASingleFont of abs_path - | NotATTCElement of abs_path * int - | NotASingleMathFont of abs_path - | NotATTCMathFont of abs_path * int - | CannotFindLibraryFileAsToFont of lib_path * abs_path list diff --git a/src/frontend/fontError.ml b/src/frontend/fontError.ml new file mode 100644 index 000000000..1a4b2aef6 --- /dev/null +++ b/src/frontend/fontError.ml @@ -0,0 +1,17 @@ + +open MyUtil + +type font_error = + | FailedToReadFont of abs_path * string + | FailedToDecodeFont of Otfed.Decode.Error.t + | NotASingleFont of abs_path + | NotAFontCollectionElement of abs_path * int + | CannotFindLibraryFileAsToFont of lib_path * abs_path list + | NoMathTable of abs_path + | PostscriptNameNotFound of abs_path + | CannotFindUnicodeCmap of abs_path + | CollectionIndexOutOfBounds of { + path : abs_path; + index : int; + num_elements : int; + } diff --git a/src/frontend/fontInfo.ml b/src/frontend/fontInfo.ml index a49b51165..5da641e57 100644 --- a/src/frontend/fontInfo.ml +++ b/src/frontend/fontInfo.ml @@ -1,6 +1,6 @@ open MyUtil -open ConfigError +open FontError open LengthInterface open HorzBox open CharBasis @@ -99,34 +99,19 @@ end = struct | UnusedSingle -> (* If this is the first access to the single font: *) - let fontname = Printf.sprintf "id-%s-Composite" (FontKey.show key) in (* TODO: fix this *) - begin - match FontFormat.get_decoder_single fontname abspath with - | None -> - (* If the font file is a TrueType collection: *) - err @@ NotASingleFont(abspath) - - | Some((dcdr, font)) -> - let tag = generate_tag () in - let dfn = { font_tag = tag; font = font; decoder = dcdr; } in - storeref := Loaded(dfn); - return dfn - end - - | UnusedTTC(i) -> + let* (dcdr, font) = FontFormat.get_decoder_single abspath in + let tag = generate_tag () in + let dfn = { font_tag = tag; font = font; decoder = dcdr; } in + storeref := Loaded(dfn); + return dfn + + | UnusedTTC(index) -> (* If this is the first access to the TrueType collection: *) - let fontname = Printf.sprintf "id-%s-Composite" (FontKey.show key) in (* TODO: fix this *) - begin - match FontFormat.get_decoder_ttc fontname abspath i with - | None -> - err @@ NotATTCElement(abspath, i) - - | Some((dcdr, font)) -> - let tag = generate_tag () in - let dfn = { font_tag = tag; font = font; decoder = dcdr; } in - storeref := Loaded(dfn); - return dfn - end + let* (dcdr, font) = FontFormat.get_decoder_ttc abspath index in + let tag = generate_tag () in + let dfn = { font_tag = tag; font = font; decoder = dcdr; } in + storeref := Loaded(dfn); + return dfn end end @@ -213,8 +198,8 @@ let get_metrics_of_word (hsinfo : horz_string_info) (uchseglst : uchar_segment l (gbase, gmarks) ) in - let gsynlst = FontFormat.convert_to_ligatures dcdr gseglst in - let (_, otxt, (rawwid, rawhgt, rawdpt)) = convert_gid_list (FontFormat.get_glyph_metrics dcdr) dcdr gsynlst in + let gsynlst = FontFormat.convert_to_ligatures_exn dcdr gseglst in + let (_, otxt, (rawwid, rawhgt, rawdpt)) = convert_gid_list (FontFormat.get_glyph_metrics_exn dcdr) dcdr gsynlst in let wid = f_skip rawwid in let hgtsub = f_skip rawhgt in let dptsub = f_skip rawdpt in @@ -293,35 +278,19 @@ end = struct match !storeref with | UnusedMathSingle -> (* If this is the first access to the single math font: *) - let fontname = Printf.sprintf "id-%s-Composite-Math" (FontKey.show mathkey) in (* TODO: fix this *) - begin - match FontFormat.get_math_decoder_single fontname abspath with - | None -> - (* If the font file does not have a MATH table or is a TrueType collection: *) - err @@ NotASingleMathFont(abspath) - - | Some((md, font)) -> - let tag = generate_tag () in - let mfdfn = { math_font_tag = tag; math_font = font; math_decoder = md; } in - storeref := LoadedMath(mfdfn); - return mfdfn - end - - | UnusedMathTTC(i) -> + let* (md, font) = FontFormat.get_math_decoder_single abspath in + let tag = generate_tag () in + let mfdfn = { math_font_tag = tag; math_font = font; math_decoder = md; } in + storeref := LoadedMath(mfdfn); + return mfdfn + + | UnusedMathTTC(index) -> (* If this is the first access to the collection math font: *) - let fontname = Printf.sprintf "id-%s-Composite-Math" (FontKey.show mathkey) in (* TODO: fix this *) - begin - match FontFormat.get_math_decoder_ttc fontname abspath i with - | None -> - (* If the font does not have a MATH table or is a single font file: *) - err @@ NotATTCMathFont(abspath, i) - - | Some((md, font)) -> - let tag = generate_tag () in - let mfdfn = { math_font_tag = tag; math_font = font; math_decoder = md; } in - storeref := LoadedMath(mfdfn); - return mfdfn - end + let* (md, font) = FontFormat.get_math_decoder_ttc abspath index in + let tag = generate_tag () in + let mfdfn = { math_font_tag = tag; math_font = font; math_decoder = md; } in + storeref := LoadedMath(mfdfn); + return mfdfn | LoadedMath(mfdfn) -> return mfdfn @@ -404,7 +373,7 @@ let get_math_char_info (mathkey : math_key) ~(is_in_base_level : bool) ~(is_in_d ) in let (gidligedlst, otxt, (rawwid, rawhgt, rawdpt)) = - convert_gid_list (FontFormat.get_math_glyph_metrics md) (FontFormat.math_base_font md) gidlst + convert_gid_list (FontFormat.get_math_glyph_metrics_exn md) (FontFormat.math_base_font md) gidlst in let (rawmicopt, rawmkiopt) = match List.rev gidligedlst with diff --git a/src/frontend/fontInfo.mli b/src/frontend/fontInfo.mli index 5db052312..24d235efa 100644 --- a/src/frontend/fontInfo.mli +++ b/src/frontend/fontInfo.mli @@ -1,6 +1,6 @@ open MyUtil -open ConfigError +open FontError open LengthInterface open HorzBox open CharBasis diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 3e843cc45..d42342164 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -4,6 +4,7 @@ open Types open StaticEnv open PackageSystemBase open ConfigError +open FontError open TypeError @@ -1061,28 +1062,29 @@ let report_config_error : config_error -> unit = function let report_font_error : font_error -> unit = function - | NotASingleFont(abspath) -> + | FailedToReadFont(abspath, msg) -> let fname = convert_abs_path_to_show abspath in report_error Interface [ - NormalLine(Printf.sprintf "the font file '%s' is not a single font file." fname); + NormalLine(Printf.sprintf "cannot load font file '%s';" fname); + DisplayLine(msg); ] - | NotATTCElement(abspath, index) -> - let fname = convert_abs_path_to_show abspath in + | FailedToDecodeFont(e) -> report_error Interface [ - NormalLine(Printf.sprintf "the font file '%s' (used with index %d) is not a collection." fname index); + NormalLine("failed to decode font;"); + NormalLine(Format.asprintf "%a" Otfed.Decode.Error.pp e); ] - | NotASingleMathFont(abspath) -> + | NotASingleFont(abspath) -> let fname = convert_abs_path_to_show abspath in report_error Interface [ - NormalLine(Printf.sprintf "the font file '%s' is not a single font file or does not have a MATH table." fname); + NormalLine(Printf.sprintf "the font file '%s' is not a single font file." fname); ] - | NotATTCMathFont(abspath, index) -> + | NotAFontCollectionElement(abspath, index) -> let fname = convert_abs_path_to_show abspath in report_error Interface [ - NormalLine(Printf.sprintf "the font file '%s' (used with index %d) is not a collection or does not have a MATH table." fname index); + NormalLine(Printf.sprintf "the font file '%s' (used with index %d) is not a collection." fname index); ] | CannotFindLibraryFileAsToFont(libpath, candidates) -> @@ -1094,6 +1096,31 @@ let report_font_error : font_error -> unit = function report_error Interface (NormalLine(Printf.sprintf "cannot find '%s'. candidates:" (get_lib_path_string libpath)) :: lines) + | NoMathTable(abspath) -> + let fname = convert_abs_path_to_show abspath in + report_error Interface [ + NormalLine(Printf.sprintf "font file '%s' does not have a 'MATH' table." fname); + ] + + | PostscriptNameNotFound(abspath) -> + let fname = convert_abs_path_to_show abspath in + report_error Interface [ + NormalLine(Printf.sprintf "font file '%s' does not have a PostScript name." fname); + ] + + | CannotFindUnicodeCmap(abspath) -> + let fname = convert_abs_path_to_show abspath in + report_error Interface [ + NormalLine(Printf.sprintf "font file '%s' does not have a 'cmap' subtable for Unicode code points." fname); + ] + + | CollectionIndexOutOfBounds{ path; index; num_elements } -> + let fname = convert_abs_path_to_show path in + report_error Interface [ + NormalLine(Printf.sprintf "%d: index out of bounds;" index); + NormalLine(Printf.sprintf "font file '%s' has %d elements." fname num_elements); + ] + let error_log_environment (suspended : unit -> unit) : unit = try @@ -1129,13 +1156,6 @@ let error_log_environment (suspended : unit -> unit) : unit = | FontInfo.FontInfoError(e) -> report_font_error e - | FontFormat.FailToLoadFontOwingToSystem(abspath, msg) -> - let fname = convert_abs_path_to_show abspath in - report_error Interface [ - NormalLine(Printf.sprintf "cannot load font file '%s';" fname); - DisplayLine(msg); - ] - | FontFormat.BrokenFont(abspath, msg) -> let fname = convert_abs_path_to_show abspath in report_error Interface [ @@ -1143,11 +1163,8 @@ let error_log_environment (suspended : unit -> unit) : unit = DisplayLine(msg); ] - | FontFormat.CannotFindUnicodeCmap(abspath) -> - let fname = convert_abs_path_to_show abspath in - report_error Interface [ - NormalLine(Printf.sprintf "font file '%s' does not have 'cmap' subtable for Unicode code points." fname); - ] + | FontFormat.FontError(e) -> + report_font_error e | ImageHashTable.CannotLoadPdf(msg, abspath, pageno) -> let fname = convert_abs_path_to_show abspath in From c1927c0a80214029646181463e8e91012ad16101 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 13 Nov 2022 02:02:59 +0900 Subject: [PATCH 147/288] modify 'FailedToDecodeFont' --- src/backend/fontFormat.ml | 37 +++++++++++++++++++------------------ src/frontend/fontError.ml | 2 +- src/frontend/main.ml | 5 +++-- 3 files changed, 23 insertions(+), 21 deletions(-) diff --git a/src/backend/fontFormat.ml b/src/backend/fontFormat.ml index 69e19fb35..5a0fbc503 100644 --- a/src/backend/fontFormat.ml +++ b/src/backend/fontFormat.ml @@ -56,7 +56,7 @@ type font_registration = (* Last boolean: true iff it should embed /W information *) -let extract_registration (d : D.source) : font_registration ok = +let extract_registration ~(file_path : abs_path) (d : D.source) : font_registration ok = let open ResultMonad in begin match d with @@ -82,7 +82,7 @@ let extract_registration (d : D.source) : font_registration ok = | D.Ttf(_) -> return (CIDFontType2OTRegistration(adobe_identity, true)) end - |> Result.map_error (fun e -> FailedToDecodeFont(e)) + |> Result.map_error (fun e -> FailedToDecodeFont(file_path, e)) let get_main_decoder_single (abspath : abs_path) : (D.source * font_registration) ok = @@ -93,14 +93,14 @@ let get_main_decoder_single (abspath : abs_path) : (D.source * font_registration in let* source = D.source_of_string data - |> Result.map_error (fun e -> FailedToDecodeFont(e)) + |> Result.map_error (fun e -> FailedToDecodeFont(abspath, e)) in match source with | D.Collection(_) -> err @@ NotASingleFont(abspath) | D.Single(d) -> - extract_registration d >>= fun registration -> + extract_registration ~file_path:abspath d >>= fun registration -> return (d, registration) @@ -112,7 +112,7 @@ let get_main_decoder_ttc (abspath : abs_path) (index : int) : (D.source * font_r in let* source = D.source_of_string data - |> Result.map_error (fun e -> FailedToDecodeFont(e)) + |> Result.map_error (fun e -> FailedToDecodeFont(abspath, e)) in match source with | D.Single(_) -> @@ -126,7 +126,7 @@ let get_main_decoder_ttc (abspath : abs_path) (index : int) : (D.source * font_r err @@ CollectionIndexOutOfBounds{ path = abspath; index; num_elements } | Some(d) -> - extract_registration d >>= fun registration -> + extract_registration ~file_path:abspath d >>= fun registration -> return (d, registration) end @@ -1088,7 +1088,7 @@ let get_original_gid (_dcdr : decoder) (gid : glyph_id) : original_glyph_id = gidorg -let get_ttf_raw_bbox (ttf : D.ttf_source) (gidorg : original_glyph_id) : ((design_units * design_units * design_units * design_units) option) ok = +let get_ttf_raw_bbox ~(file_path : abs_path) (ttf : D.ttf_source) (gidorg : original_glyph_id) : ((design_units * design_units * design_units * design_units) option) ok = let open ResultMonad in begin D.Ttf.loca ttf gidorg >>= function @@ -1100,16 +1100,16 @@ let get_ttf_raw_bbox (ttf : D.ttf_source) (gidorg : original_glyph_id) : ((desig let V.{ x_min; y_min; x_max; y_max } = ttf_glyph_info.bounding_box in return (Some((x_min, y_min, x_max, y_max))) end - |> Result.map_error (fun e -> FailedToDecodeFont(e)) + |> Result.map_error (fun e -> FailedToDecodeFont(file_path, e)) let bbox_zero = (PerMille(0), PerMille(0), PerMille(0), PerMille(0)) -let get_ttf_bbox ~(units_per_em : int) (ttf : D.ttf_source) (gidorg : original_glyph_id) : bbox ok = +let get_ttf_bbox ~(units_per_em : int) ~(file_path : abs_path) (ttf : D.ttf_source) (gidorg : original_glyph_id) : bbox ok = let open ResultMonad in let f = per_mille ~units_per_em in - let* bbox_opt = get_ttf_raw_bbox ttf gidorg in + let* bbox_opt = get_ttf_raw_bbox ~file_path ttf gidorg in match bbox_opt with | None -> return bbox_zero @@ -1135,9 +1135,10 @@ let get_glyph_advance_width (dcdr : decoder) (gidorg_key : original_glyph_id) : let get_bbox (dcdr : decoder) (gidorg : original_glyph_id) : bbox ok = let open ResultMonad in let units_per_em = dcdr.units_per_em in + let abspath = dcdr.file_path in match dcdr.main with | D.Ttf(ttf) -> - get_ttf_bbox ~units_per_em ttf gidorg + get_ttf_bbox ~units_per_em ~file_path:abspath ttf gidorg | D.Cff(cff) -> begin @@ -1159,7 +1160,7 @@ let get_bbox (dcdr : decoder) (gidorg : original_glyph_id) : bbox ok = (f x_min, f y_min, f x_max, f y_max) end end - |> Result.map_error (fun e -> FailedToDecodeFont(e)) + |> Result.map_error (fun e -> FailedToDecodeFont(abspath, e)) let get_glyph_metrics (dcdr : decoder) (gid : glyph_id) : metrics ok = @@ -1372,7 +1373,7 @@ let get_cmap_subtable ~(file_path : abs_path) (d : D.source) : V.Cmap.subtable o in return opt end - |> Result.map_error (fun e -> FailedToDecodeFont(e)) + |> Result.map_error (fun e -> FailedToDecodeFont(file_path, e)) in match opt with | None -> err @@ CannotFindUnicodeCmap(file_path) @@ -1451,7 +1452,7 @@ let get_postscript_name ~(file_path : abs_path) (d : D.source) : string ok = let open ResultMonad in let* vname = D.Name.get d - |> Result.map_error (fun e -> FailedToDecodeFont(e)) + |> Result.map_error (fun e -> FailedToDecodeFont(file_path, e)) in let name_opt = vname.V.Name.name_records |> List.find_map (fun name_record -> @@ -1829,14 +1830,14 @@ let make_decoder (abspath : abs_path) (d : D.source) : decoder ok = let* ihhea = D.Hhea.get d in return (ihhea, ihhea.value.ascender, ihhea.value.descender) end - |> Result.map_error (fun e -> FailedToDecodeFont(e)) + |> Result.map_error (fun e -> FailedToDecodeFont(abspath, e)) in let* (rcdhead, units_per_em) = begin let* ihead = D.Head.get d in return (ihead, ihead.value.units_per_em) end - |> Result.map_error (fun e -> FailedToDecodeFont(e)) + |> Result.map_error (fun e -> FailedToDecodeFont(abspath, e)) in let* postscript_name = get_postscript_name ~file_path:abspath d in let kerntbl = get_kerning_table abspath d in @@ -2024,7 +2025,7 @@ let make_math_decoder_from_decoder (abspath : abs_path) (dcdr : decoder) (font : let d = dcdr.main in let* mathraw_opt = D.Math.get d - |> Result.map_error (fun e -> FailedToDecodeFont(e)) + |> Result.map_error (fun e -> FailedToDecodeFont(abspath, e)) in match mathraw_opt with | None -> @@ -2082,7 +2083,7 @@ let make_math_decoder_from_decoder (abspath : abs_path) (dcdr : decoder) (font : return None | Error(GeneralError(e)) -> - err @@ FailedToDecodeFont(e) + err @@ FailedToDecodeFont(abspath, e) in let md = { diff --git a/src/frontend/fontError.ml b/src/frontend/fontError.ml index 1a4b2aef6..0ed883566 100644 --- a/src/frontend/fontError.ml +++ b/src/frontend/fontError.ml @@ -3,7 +3,7 @@ open MyUtil type font_error = | FailedToReadFont of abs_path * string - | FailedToDecodeFont of Otfed.Decode.Error.t + | FailedToDecodeFont of abs_path * Otfed.Decode.Error.t | NotASingleFont of abs_path | NotAFontCollectionElement of abs_path * int | CannotFindLibraryFileAsToFont of lib_path * abs_path list diff --git a/src/frontend/main.ml b/src/frontend/main.ml index d42342164..6754efdf2 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1069,9 +1069,10 @@ let report_font_error : font_error -> unit = function DisplayLine(msg); ] - | FailedToDecodeFont(e) -> + | FailedToDecodeFont(abspath, e) -> + let fname = convert_abs_path_to_show abspath in report_error Interface [ - NormalLine("failed to decode font;"); + NormalLine(Printf.sprintf "cannot decode font file '%s';" fname); NormalLine(Format.asprintf "%a" Otfed.Decode.Error.pp e); ] From f5b1552c89c6369d6b008664b5e6ed516f7a3bf5 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 13 Nov 2022 04:52:12 +0900 Subject: [PATCH 148/288] refactor 'FontFormat' to remove exception 'BrokenFont' --- src/backend/fontFormat.ml | 1080 ++++++++++++++++++------------------ src/backend/fontFormat.mli | 13 +- src/frontend/fontError.ml | 1 + src/frontend/fontInfo.ml | 12 +- src/frontend/main.ml | 14 +- 5 files changed, 566 insertions(+), 554 deletions(-) diff --git a/src/backend/fontFormat.ml b/src/backend/fontFormat.ml index 5a0fbc503..474d60195 100644 --- a/src/backend/fontFormat.ml +++ b/src/backend/fontFormat.ml @@ -8,7 +8,6 @@ module D = Otfed.Decode exception FontError of font_error -exception BrokenFont of abs_path * string type original_glyph_id = V.glyph_id @@ -22,21 +21,19 @@ type per_mille = type metrics = per_mille * per_mille * per_mille -let broken srcpath oerr s = - let msg = Format.asprintf "%a" D.Error.pp oerr in - raise (BrokenFont(srcpath, msg ^ "; " ^ s)) - - let raise_if_err = function | Ok(v) -> v | Error(e) -> raise (FontError(e)) -let pickup xs predicate e = +let pickup (xs : 'a list) (predicate : 'a -> bool) (e : 'b) (k : 'a -> ('b, 'e) result) : ('b, 'e) result = let open ResultMonad in match xs |> List.filter predicate with - | head :: _ -> return head - | [] -> err e + | head :: _ -> k head + | [] -> return e + + +let ( <| ) f x = f x type cid_system_info = { @@ -177,100 +174,104 @@ let hex_of_glyph_id ((SubsetGlyphID(_, SubsetNumber(n))) : glyph_id) = module SubsetMap : sig type t val create : abs_path -> D.source -> int -> t - val intern : original_glyph_id -> t -> subset_glyph_id + val intern : original_glyph_id -> t -> subset_glyph_id ok val to_list : t -> original_glyph_id list end = struct - type subset = { - file_path : abs_path; - decoder : D.source; - original_to_subset : subset_glyph_id GOHt.t; - subset_to_original : original_glyph_id GSHt.t; - count : int ref; - store : (original_glyph_id Alist.t) ref; - } + type subset = { + file_path : abs_path; + decoder : D.source; + original_to_subset : subset_glyph_id GOHt.t; + subset_to_original : original_glyph_id GSHt.t; + count : int ref; + store : (original_glyph_id Alist.t) ref; + } - type t = - | Subset of subset - - - let create file_path d n = - let ht = GOHt.create n in - let revht = GSHt.create n in - GOHt.add ht 0 (SubsetNumber(0)); - Subset{ - file_path = file_path; - decoder = d; - original_to_subset = ht; - subset_to_original = revht; - count = ref 0; - store = ref (Alist.extend Alist.empty 0); - } + type t = + | Subset of subset + + + let create file_path d n = + let ht = GOHt.create n in + let revht = GSHt.create n in + GOHt.add ht 0 (SubsetNumber(0)); + Subset{ + file_path = file_path; + decoder = d; + original_to_subset = ht; + subset_to_original = revht; + count = ref 0; + store = ref (Alist.extend Alist.empty 0); + } - let get_elements_of_composite_glyph ~(file_path : abs_path) (d : D.source) (gidorg : original_glyph_id) : original_glyph_id list = - let res = - let open ResultMonad in - match d with - | D.Cff(_) -> - return [] + let get_elements_of_composite_glyph ~(file_path : abs_path) (d : D.source) (gidorg : original_glyph_id) : (original_glyph_id list) ok = + let open ResultMonad in + begin + match d with + | D.Cff(_) -> + return [] - | D.Ttf(ttf) -> - D.Ttf.loca ttf gidorg >>= function - | None -> - return [] + | D.Ttf(ttf) -> + D.Ttf.loca ttf gidorg >>= function + | None -> + return [] - | Some(loc) -> - D.Ttf.glyf ttf loc >>= fun ttf_glyph_info -> - begin - match ttf_glyph_info.description with - | SimpleGlyph(_) -> - return [] - - | CompositeGlyph(composite) -> - return begin - composite.composite_components |> List.map (fun components -> - components.V.Ttf.component_glyph_id - ) - end - end - in - match res with - | Error(e) -> broken file_path e "add_element_of_composite_glyph" - | Ok(gidorgs) -> gidorgs + | Some(loc) -> + D.Ttf.glyf ttf loc >>= fun ttf_glyph_info -> + begin + match ttf_glyph_info.description with + | SimpleGlyph(_) -> + return [] + + | CompositeGlyph(composite) -> + return begin + composite.composite_components |> List.map (fun components -> + components.V.Ttf.component_glyph_id + ) + end + end + end + |> Result.map_error (fun e -> FailedToDecodeFont(file_path, e)) - let rec intern gidorg submap = - match submap with - | Subset(r) -> - let ht = r.original_to_subset in - let revht = r.subset_to_original in - let count = r.count in - let store = r.store in - begin - match GOHt.find_opt ht gidorg with - | Some(gidsub) -> - gidsub + let rec intern (gidorg : original_glyph_id) (submap : t) : subset_glyph_id ok = + let open ResultMonad in + match submap with + | Subset(r) -> + let ht = r.original_to_subset in + let revht = r.subset_to_original in + let count = r.count in + let store = r.store in + begin + match GOHt.find_opt ht gidorg with + | Some(gidsub) -> + return gidsub - | None -> - incr count; - let gidsub = SubsetNumber(!count) in - GOHt.add ht gidorg gidsub; - GSHt.add revht gidsub gidorg; - let alst = Alist.extend (!store) gidorg in - store := alst; - let gidorgs_elem = get_elements_of_composite_glyph ~file_path:r.file_path r.decoder gidorg in - gidorgs_elem |> List.iter (fun gidorg_elem -> intern gidorg_elem submap |> ignore); - gidsub - end + | None -> + incr count; + let gidsub = SubsetNumber(!count) in + GOHt.add ht gidorg gidsub; + GSHt.add revht gidsub gidorg; + let alst = Alist.extend (!store) gidorg in + store := alst; + let* gidorgs_elem = get_elements_of_composite_glyph ~file_path:r.file_path r.decoder gidorg in + let* () = + gidorgs_elem |> foldM (fun () gidorg_elem -> + let* _ = intern gidorg_elem submap in + return () + ) () + in + return gidsub + end - let to_list submap = - match submap with - | Subset(r) -> Alist.to_list !(r.store) + let to_list submap = + match submap with + | Subset(r) -> Alist.to_list !(r.store) - end +end type subset_map = SubsetMap.t @@ -279,7 +280,7 @@ type subset_map = SubsetMap.t module GlyphIDTable : sig type t val create : subset_map -> int -> t - val add : Uchar.t -> original_glyph_id -> t -> unit + val add : Uchar.t -> original_glyph_id -> t -> unit ok val find_opt : Uchar.t -> t -> glyph_id_pair option val find_rev_opt : original_glyph_id -> t -> Uchar.t option val fold_rev : (subset_glyph_id -> Uchar.t -> 'a -> 'a) -> 'a -> t -> 'a @@ -305,21 +306,23 @@ end = struct } - let add uch gidorg r = + let add (uch : Uchar.t) (gidorg : original_glyph_id) r = + let open ResultMonad in let submap = r.subset_map in let ht = r.main in let revsubht = r.rev_subset in let revorght = r.rev_original in - let gidsub = submap |> SubsetMap.intern gidorg in + let* gidsub = submap |> SubsetMap.intern gidorg in UHt.add ht uch { original_id = gidorg; subset_id = gidsub; }; match GSHt.find_opt revsubht gidsub with | None -> GSHt.add revsubht gidsub uch; - GOHt.add revorght gidorg uch + GOHt.add revorght gidorg uch; + return () - | Some(uchpre) -> - Logging.warn_noninjective_cmap uchpre uch gidorg; - () + | Some(uch_pre) -> + Logging.warn_noninjective_cmap uch_pre uch gidorg; + return () let find_opt uch r = @@ -564,66 +567,50 @@ let select_gpos_langsys = select_langsys D.Gpos.langsyses let select_gsub_langsys = select_langsys D.Gsub.langsyses -let get_mark_table srcpath units_per_em d = - let script_tag = "latn" in (* TODO: should depend on the script *) +let get_mark_table ~(file_path : abs_path) ~(units_per_em : int) (d : D.source) : MarkTable.t ok = + let open ResultMonad in + let script_tag = "latn" in (* TODO: make Script tags changeable *) let mktbl = MarkTable.create () in - let res = - let open ResultMonad in - D.Gpos.get d >>= function - | None -> - (* If the font does NOT have a GPOS table: *) - return () - - | Some(igpos) -> - D.Gpos.scripts igpos >>= fun scripts -> - begin - match - scripts |> List.find_opt (fun gs -> String.equal (D.Gpos.get_script_tag gs) script_tag) - with - | None -> - return () + begin + let* () = + D.Gpos.get d >>= function + | None -> + (* If the font does NOT have a GPOS table: *) + return () - | Some(script) -> - select_gpos_langsys script >>= fun langsys -> - D.Gpos.features langsys >>= fun (_, features) -> - begin - match - features |> List.find_opt - (fun gf -> String.equal (D.Gpos.get_feature_tag gf) "mark") - with - | None -> - return () - - | Some(feature_mark) -> - D.Gpos.fold_subtables - ~markbase1:(fun clscnt () markassoc baseassoc -> - MarkTable.add_base ~units_per_em clscnt markassoc baseassoc mktbl - ) - ~marklig1:(fun clscnt () markassoc ligassoc -> - MarkTable.add_ligature ~units_per_em clscnt markassoc ligassoc mktbl - ) - feature_mark () - end >>= fun () -> - begin - match - features |> List.find_opt - (fun gf -> String.equal (D.Gpos.get_feature_tag gf) "mkmk") - with - | None -> - return () - - | Some(feature_mkmk) -> - D.Gpos.fold_subtables - ~markmark1:(fun clscnt () mark1assoc mark2assoc -> - MarkTable.add_mark_to_mark ~units_per_em clscnt mark1assoc mark2assoc mktbl - ) - feature_mkmk () - end - end - in - match res with - | Error(oerr) -> broken srcpath oerr "get_mark_table" - | _ -> mktbl + | Some(igpos) -> + D.Gpos.scripts igpos >>= fun scripts -> + pickup scripts (fun gs -> String.equal (D.Gpos.get_script_tag gs) script_tag) () <| fun script -> + select_gpos_langsys script >>= fun langsys -> + D.Gpos.features langsys >>= fun (_, features) -> + let* () = + begin + pickup features (fun gf -> String.equal (D.Gpos.get_feature_tag gf) "mark") () <| fun feature_mark -> + D.Gpos.fold_subtables + ~markbase1:(fun clscnt () markassoc baseassoc -> + MarkTable.add_base ~units_per_em clscnt markassoc baseassoc mktbl + ) + ~marklig1:(fun clscnt () markassoc ligassoc -> + MarkTable.add_ligature ~units_per_em clscnt markassoc ligassoc mktbl + ) + feature_mark () + end + in + let* () = + begin + pickup features (fun gf -> String.equal (D.Gpos.get_feature_tag gf) "mkmk") () <| fun feature_mkmk -> + D.Gpos.fold_subtables + ~markmark1:(fun clscnt () mark1assoc mark2assoc -> + MarkTable.add_mark_to_mark ~units_per_em clscnt mark1assoc mark2assoc mktbl + ) + feature_mkmk () + end + in + return () + in + return mktbl + end + |> Result.map_error (fun e -> FailedToDecodeFont(file_path, e)) let ( -@ ) (PerMille(x1), PerMille(y1)) (PerMille(x2), PerMille(y2)) = @@ -653,7 +640,7 @@ module LigatureTable : sig } type t val create : subset_map -> int -> t - val add : original_glyph_id -> single list -> t -> unit + val add : original_glyph_id -> single list -> t -> unit ok val fold_rev : (subset_glyph_id -> original_glyph_id list -> 'a -> 'a) -> 'a -> t -> 'a val match_prefix : original_glyph_segment list -> MarkTable.t -> t -> ligature_matching end = struct @@ -671,31 +658,31 @@ end = struct } - let create submap n = + let create (submap : subset_map) (n : int) : t = let htmain = GOHt.create n in let htrev = GSHt.create n in { subset_map = submap; entry_table = htmain; rev_table = htrev; } - let add gidorg liginfolst ligtbl = + let add (gidorg : original_glyph_id) (liginfos : single list) (ligtbl : t) : unit ok = + let open ResultMonad in let htmain = ligtbl.entry_table in let htrev = ligtbl.rev_table in let submap = ligtbl.subset_map in - begin - GOHt.add htmain gidorg liginfolst; - liginfolst |> List.iter (fun single -> - let gidorgtail = single.tail in - let gidorglig = single.ligature in - let gidsublig = submap |> SubsetMap.intern gidorglig in - match GSHt.find_opt htrev gidsublig with - | None -> - GSHt.add htrev gidsublig (gidorg :: gidorgtail) + GOHt.add htmain gidorg liginfos; + liginfos |> foldM (fun () single -> + let gidorgtail = single.tail in + let gidorg_lig = single.ligature in + let* gidsub_lig = submap |> SubsetMap.intern gidorg_lig in + match GSHt.find_opt htrev gidsub_lig with + | None -> + GSHt.add htrev gidsub_lig (gidorg :: gidorgtail); + return () - | Some(_) -> - Logging.warn_noninjective_ligature gidorglig; - () - ); - end + | Some(_) -> + Logging.warn_noninjective_ligature gidorg_lig; + return () + ) () let fold_rev f init ligtbl = @@ -866,54 +853,41 @@ end = struct end -type ligature_error = - | MissingScript - | MissingFeature - | GeneralError of D.Error.t - - -let inject res = - res |> Result.map_error (fun oerr -> GeneralError(oerr)) -let get_ligature_table srcpath (submap : subset_map) (d : D.source) : LigatureTable.t = - let script_tag = "latn" in (* temporary; should depend on the script *) +let get_ligature_table ~(file_path : abs_path) (submap : subset_map) (d : D.source) : LigatureTable.t ok = + let open ResultMonad in + let inject res = + res |> Result.map_error (fun e -> FailedToDecodeFont(file_path, e)) + in + let script_tag = "latn" in (* TODO: make Script tags changeable *) let ligtbl = LigatureTable.create submap 32 (* arbitrary constant; the initial size of the hash table *) in - let res = - let open ResultMonad in + let* () = inject @@ D.Gsub.get d >>= function | None -> - (* If the font does NOT have GSUB table: *) + (* If the font does NOT have a GSUB table: *) return () | Some(igsub) -> inject @@ D.Gsub.scripts igsub >>= fun scripts -> - pickup scripts - (fun gs -> String.equal (D.Gsub.get_script_tag gs) script_tag) MissingScript >>= fun script -> + pickup scripts (fun gs -> String.equal (D.Gsub.get_script_tag gs) script_tag) () <| fun script -> inject @@ select_gsub_langsys script >>= fun langsys -> inject @@ D.Gsub.features langsys >>= fun (_, features) -> - pickup features - (fun gf -> String.equal (D.Gsub.get_feature_tag gf) "liga") MissingFeature >>= fun feature -> - inject @@ D.Gsub.fold_subtables - ~lig:(fun () (gid, liginfolst) -> - let liginfolst = - liginfolst |> List.map (fun (tail, ligature) -> LigatureTable.{ tail; ligature; }) - in - ligtbl |> LigatureTable.add gid liginfolst - ) - feature () + pickup features (fun gf -> String.equal (D.Gsub.get_feature_tag gf) "liga") () <| fun feature -> + let* res = + inject @@ D.Gsub.fold_subtables + ~lig:(fun res (gid, liginfos) -> + res >>= fun () -> + let liginfos = + liginfos |> List.map (fun (tail, ligature) -> LigatureTable.{ tail; ligature; }) + in + ligtbl |> LigatureTable.add gid liginfos + ) + feature (return ()) + in + res in - match res with - | Ok(()) -> - ligtbl - - | Error(e) -> - begin - match e with - | MissingScript -> ligtbl - | MissingFeature -> ligtbl - | GeneralError(oerr) -> broken srcpath oerr "get_ligature_table" - end + return ligtbl module KerningTable : sig @@ -997,11 +971,14 @@ end = struct end -let get_kerning_table srcpath (d : D.source) = - let script_tag = "latn" in (* temporary; should depend on the script *) - let kerntbl = KerningTable.create 32 (* arbitrary constant; the initial size of the hash table *) in - let res = +let get_kerning_table ~(file_path : abs_path) (d : D.source) = let open ResultMonad in + let script_tag = "latn" in (* TODO: make Script tags changeable *) + let kerntbl = KerningTable.create 32 (* arbitrary constant; the initial size of the hash table *) in + let inject res = + res |> Result.map_error (fun e -> FailedToDecodeFont(file_path, e)) + in + let* () = inject begin D.Kern.get d >>= function | None -> @@ -1024,20 +1001,20 @@ let get_kerning_table srcpath (d : D.source) = kerntbl |> KerningTable.add gid1 gid2 wid ) () ikern - end >>= fun () -> + end + in + let* () = inject @@ D.Gpos.get d >>= function | None -> return () | Some(igpos) -> inject @@ D.Gpos.scripts igpos >>= fun scripts -> - pickup scripts - (fun gs -> String.equal (D.Gpos.get_script_tag gs) script_tag) MissingScript >>= fun script -> + pickup scripts (fun gs -> String.equal (D.Gpos.get_script_tag gs) script_tag) () <| fun script -> inject @@ select_gpos_langsys script >>= fun langsys -> - (* temporary; should depend on the current language system *) + (* TODO: make LangSys tags changeable *) inject @@ D.Gpos.features langsys >>= fun (_, features) -> - pickup features - (fun gf -> String.equal (D.Gpos.get_feature_tag gf) "kern") MissingFeature >>= fun feature -> + pickup features (fun gf -> String.equal (D.Gpos.get_feature_tag gf) "kern") () <| fun feature -> inject @@ D.Gpos.fold_subtables ~pair1:(fun () (gid1, pairposlst) -> pairposlst |> List.iter (fun (gid2, valrcd1, _valrcd2) -> @@ -1051,17 +1028,7 @@ let get_kerning_table srcpath (d : D.source) = ) feature () in - match res with - | Ok(()) -> - kerntbl - - | Error(e) -> - begin - match e with - | MissingScript -> kerntbl - | MissingFeature -> kerntbl - | GeneralError(oerr) -> broken srcpath oerr "get_kerning_table" - end + return kerntbl type decoder = { @@ -1119,17 +1086,16 @@ let get_ttf_bbox ~(units_per_em : int) ~(file_path : abs_path) (ttf : D.ttf_sour return (f xmin_raw, f ymin_raw, f xmax_raw, f ymax_raw) -let get_glyph_advance_width (dcdr : decoder) (gidorg_key : original_glyph_id) : per_mille = +let get_glyph_advance_width (dcdr : decoder) (gidorg_key : original_glyph_id) : per_mille ok = + let open ResultMonad in let d = dcdr.main in - let res = - let open ResultMonad in + begin D.Hmtx.get d >>= fun ihmtx -> - D.Hmtx.access ihmtx gidorg_key - in - match res with - | Error(e) -> broken dcdr.file_path e (Printf.sprintf "get_glyph_advance_width (gid = %d)" gidorg_key) - | Ok(None) -> PerMille(0) - | Ok(Some((adv, _lsb))) -> per_mille ~units_per_em:dcdr.units_per_em adv + D.Hmtx.access ihmtx gidorg_key >>= function + | None -> return @@ PerMille(0) + | Some(adv, _lsb) -> return @@ per_mille ~units_per_em:dcdr.units_per_em adv + end + |> Result.map_error (fun e -> FailedToDecodeFont(dcdr.file_path, e)) let get_bbox (dcdr : decoder) (gidorg : original_glyph_id) : bbox ok = @@ -1173,7 +1139,7 @@ let get_glyph_metrics (dcdr : decoder) (gid : glyph_id) : metrics ok = return pair | None -> - let wid = get_glyph_advance_width dcdr gidorg in + let* wid = get_glyph_advance_width dcdr gidorg in let* bbox = get_bbox dcdr gidorg in let pair = (wid, bbox) in bboxtbl |> GlyphBBoxTable.add gidorg pair; @@ -1204,8 +1170,10 @@ type font_stretch = | SemiExpandedStretch | ExpandedStretch | ExtraExpandedStretch | UltraExpandedStretch -let intern_gid (dcdr : decoder) (gidorg : original_glyph_id) : glyph_id = - SubsetGlyphID(gidorg, dcdr.subset_map |> SubsetMap.intern gidorg) +let intern_gid (dcdr : decoder) (gidorg : original_glyph_id) : glyph_id ok = + let open ResultMonad in + let* gidsub = dcdr.subset_map |> SubsetMap.intern gidorg in + return @@ SubsetGlyphID(gidorg, gidsub) let font_stretch_of_width_class = function @@ -1297,23 +1265,22 @@ let get_subset_tag () = aux 0 !subset_tag_id -let add_subset_tag tagopt fontname = - match tagopt with +let add_subset_tag tag_opt fontname = + match tag_opt with | None -> fontname | Some(tag) -> tag ^ "+" ^ fontname -let pdfstream_of_decoder (pdf : Pdf.t) (dcdr : decoder) (subtypeopt : string option) : (Pdf.pdfobject * string option) = +let pdfstream_of_decoder (pdf : Pdf.t) (dcdr : decoder) (subtype_opt : string option) : (Pdf.pdfobject * string option) ok = + let open ResultMonad in let d = dcdr.main in - let (data, subset_tag) = - let gidorgs = SubsetMap.to_list dcdr.subset_map in - match Otfed.Subset.make ~omit_cmap:true d gidorgs with - | Error(e) -> - let msg = Format.asprintf "pdfstream_of_decoder: %a" Otfed.Subset.Error.pp e in - raise (BrokenFont(dcdr.file_path, msg)) - - | Ok(s) -> - (s, Some(get_subset_tag ())) + let gidorgs = SubsetMap.to_list dcdr.subset_map in + let* (data, subset_tag) = + begin + Otfed.Subset.make ~omit_cmap:true d gidorgs >>= fun data -> + return (data, Some(get_subset_tag ())) + end + |> Result.map_error (fun e -> FailedToMakeSubset(dcdr.file_path, e)) in let (filter, bt) = to_flate_pdf_bytes data in let len = Pdfio.bytes_size bt in @@ -1323,13 +1290,13 @@ let pdfstream_of_decoder (pdf : Pdf.t) (dcdr : decoder) (subtypeopt : string opt ] in let dict = - match subtypeopt with + match subtype_opt with | None -> contents | Some(subtype) -> ("/Subtype", Pdf.Name("/" ^ subtype)) :: contents in - let objstream = Pdf.Stream(ref (Pdf.Dictionary(dict), Pdf.Got(bt))) in - let irstream = Pdf.addobj pdf objstream in - (Pdf.Indirect(irstream), subset_tag) + let obj_stream = Pdf.Stream(ref (Pdf.Dictionary(dict), Pdf.Got(bt))) in + let ir_stream = Pdf.addobj pdf obj_stream in + return (Pdf.Indirect(ir_stream), subset_tag) let get_glyph_id_main (cmapsubtbl : V.Cmap.subtable) (uch_key : Uchar.t) : V.glyph_id option = @@ -1380,18 +1347,26 @@ let get_cmap_subtable ~(file_path : abs_path) (d : D.source) : V.Cmap.subtable o | Some((subtbl, _)) -> return subtbl -let get_glyph_id (dcdr : decoder) (uch : Uchar.t) : glyph_id option = +let get_glyph_id (dcdr : decoder) (uch : Uchar.t) : (glyph_id option) ok = + let open ResultMonad in let gidtbl = dcdr.glyph_id_table in - match gidtbl |> GlyphIDTable.find_opt uch with - | Some(gidpair) -> - Some(SubsetGlyphID(gidpair.original_id, gidpair.subset_id)) + match gidtbl |> GlyphIDTable.find_opt uch with + | Some(gidpair) -> + return @@ Some(SubsetGlyphID(gidpair.original_id, gidpair.subset_id)) + + | None -> + match get_glyph_id_main dcdr.cmap_subtable uch with + | None -> + return None + + | Some(gidorg) -> + let* () = gidtbl |> GlyphIDTable.add uch gidorg in + let* gid = intern_gid dcdr gidorg in + return @@ Some(gid) - | None -> - let open OptionMonad in - get_glyph_id_main dcdr.cmap_subtable uch >>= fun gidorg -> - gidtbl |> GlyphIDTable.add uch gidorg; - let gid = intern_gid dcdr gidorg in - return gid + +let get_glyph_id_exn (dcdr : decoder) (uch : Uchar.t) : glyph_id option = + raise_if_err @@ get_glyph_id dcdr uch let of_per_mille = function @@ -1415,37 +1390,37 @@ let add_entry_if_non_null key value dict = dict -let font_descriptor_of_decoder (dcdr : decoder) (font_name : string) = +let font_descriptor_of_decoder (dcdr : decoder) (font_name : string) : font_descriptor ok = + let open ResultMonad in let d = dcdr.main in let ihead = dcdr.head_record in let head_derived = ihead.I.Head.derived in let ihhea = dcdr.hhea_record in let units_per_em = dcdr.units_per_em in - match D.Os2.get d with - | Error(e) -> - broken dcdr.file_path e "font_descriptor_of_decoder" - - | Ok(ios2) -> - let bbox = - (per_mille ~units_per_em head_derived.x_min, - per_mille ~units_per_em head_derived.y_min, - per_mille ~units_per_em head_derived.x_max, - per_mille ~units_per_em head_derived.y_max) - in - { - font_name = font_name; (* Same as `Otfm.postscript_name dcdr` *) - font_family = ""; (* temporary; should be gotten from decoder *) - font_stretch = Some(font_stretch_of_width_class ios2.I.Os2.value.us_width_class); - font_weight = Some(font_weight_of_weight_class ios2.I.Os2.value.us_weight_class); - flags = None; (* temporary; should be gotten from decoder *) - font_bbox = bbox; - italic_angle = 0.; (* temporary; should be gotten from decoder; 'post.italicAngle' *) - ascent = per_mille ~units_per_em ihhea.I.Hhea.value.ascender; - descent = per_mille ~units_per_em ihhea.I.Hhea.value.descender; - stemv = 0.; (* temporary; should be gotten from decoder *) - font_data = ref (Data(d)); - (* temporary; should contain more fields *) - } + begin + D.Os2.get d >>= fun ios2 -> + let bbox = + (per_mille ~units_per_em head_derived.x_min, + per_mille ~units_per_em head_derived.y_min, + per_mille ~units_per_em head_derived.x_max, + per_mille ~units_per_em head_derived.y_max) + in + return { + font_name = font_name; (* Same as `Otfm.postscript_name dcdr` *) + font_family = ""; (* temporary; should be gotten from decoder *) + font_stretch = Some(font_stretch_of_width_class ios2.I.Os2.value.us_width_class); + font_weight = Some(font_weight_of_weight_class ios2.I.Os2.value.us_weight_class); + flags = None; (* temporary; should be gotten from decoder *) + font_bbox = bbox; + italic_angle = 0.; (* temporary; should be gotten from decoder; 'post.italicAngle' *) + ascent = per_mille ~units_per_em ihhea.I.Hhea.value.ascender; + descent = per_mille ~units_per_em ihhea.I.Hhea.value.descender; + stemv = 0.; (* temporary; should be gotten from decoder *) + font_data = ref (Data(d)); + (* temporary; should contain more fields *) + } + end + |> Result.map_error (fun e -> FailedToDecodeFont(dcdr.file_path, e)) let get_postscript_name ~(file_path : abs_path) (d : D.source) : string ok = @@ -1504,12 +1479,14 @@ module CIDFontType0 = struct according to the glyph metrics table. *) - let of_decoder dcdr cidsysinfo = + let of_decoder (dcdr : decoder) (cidsysinfo : cid_system_info) : font ok = + let open ResultMonad in let base_font = dcdr.postscript_name in - { + let* font_descriptor = font_descriptor_of_decoder dcdr base_font in + return { cid_system_info = cidsysinfo; base_font = base_font; - font_descriptor = font_descriptor_of_decoder dcdr base_font; + font_descriptor = font_descriptor; dw = None; (* temporary *) dw2 = None; (* temporary *) } @@ -1537,17 +1514,19 @@ module CIDFontType2 = struct the /W entry will be added by using the glyph metrics table when the PDF file is outputted. *) - let of_decoder dcdr cidsysinfo isptt = + let of_decoder ~(is_pure_truetype : bool) (dcdr : decoder) (cidsysinfo : cid_system_info) : font ok = + let open ResultMonad in let base_font = dcdr.postscript_name in - { - cid_system_info = cidsysinfo; - base_font = base_font; - font_descriptor = font_descriptor_of_decoder dcdr base_font; - dw = None; (* temporary *) - dw2 = None; (* temporary *) - is_pure_truetype = isptt; - cid_to_gid_map = CIDToGIDIdentity; (* temporary *) - } + let* font_descriptor = font_descriptor_of_decoder dcdr base_font in + return { + cid_system_info = cidsysinfo; + base_font = base_font; + font_descriptor = font_descriptor; + dw = None; (* temporary *) + dw2 = None; (* temporary *) + is_pure_truetype = is_pure_truetype; + cid_to_gid_map = CIDToGIDIdentity; (* temporary *) + } end @@ -1618,207 +1597,219 @@ module ToUnicodeCMap end -module Type0 -= struct - type font = { - base_font : string; - encoding : cmap; - descendant_fonts : cid_font; (* Represented as a singleton list in PDF. *) - } - - - let of_cid_font cidfont fontname cmap = - { - base_font = fontname; - encoding = cmap; - descendant_fonts = cidfont; - } +module Type0 = struct + type font = { + base_font : string; + encoding : cmap; + descendant_fonts : cid_font; (* Represented as a singleton list in PDF. *) + } - let pdfobject_of_font_descriptor (pdf : Pdf.t) (dcdr : decoder) fontdescr base_font embedding : (Pdf.pdfobject * string option) = - let (font_file_key, tagopt) = font_file_info_of_embedding embedding in - let (objstream, subset_tag_opt) = pdfstream_of_decoder pdf dcdr tagopt in - (* Adds to the PDF the stream in which the font file is embedded. *) - let objdescr = - Pdf.Dictionary[ - ("/Type" , Pdf.Name("/FontDescriptor")); - ("/FontName" , Pdf.Name("/" ^ (add_subset_tag subset_tag_opt base_font))); - ("/Flags" , Pdf.Integer(4)); (* temporary; should be variable *) - ("/FontBBox" , pdfobject_of_bbox fontdescr.font_bbox); - ("/ItalicAngle", Pdf.Real(fontdescr.italic_angle)); - ("/Ascent" , of_per_mille fontdescr.ascent); - ("/Descent" , of_per_mille fontdescr.descent); - ("/StemV" , Pdf.Real(fontdescr.stemv)); - (font_file_key , objstream); - ] - in - let irdescr = Pdf.addobj pdf objdescr in - (Pdf.Indirect(irdescr), subset_tag_opt) + let of_cid_font cidfont fontname cmap = + { + base_font = fontname; + encoding = cmap; + descendant_fonts = cidfont; + } - let pdfdict_of_cid_system_info cidsysinfo = + let pdfobject_of_font_descriptor (pdf : Pdf.t) (dcdr : decoder) fontdescr base_font embedding : (Pdf.pdfobject * string option) ok = + let open ResultMonad in + let (font_file_key, tagopt) = font_file_info_of_embedding embedding in + let* (objstream, subset_tag_opt) = pdfstream_of_decoder pdf dcdr tagopt in + (* Adds to the PDF the stream in which the font file is embedded. *) + let obj_descr = Pdf.Dictionary[ - ("/Registry" , Pdf.String(cidsysinfo.registry)); - ("/Ordering" , Pdf.String(cidsysinfo.ordering)); - ("/Supplement", Pdf.Integer(cidsysinfo.supplement)); + ("/Type" , Pdf.Name("/FontDescriptor")); + ("/FontName" , Pdf.Name("/" ^ (add_subset_tag subset_tag_opt base_font))); + ("/Flags" , Pdf.Integer(4)); (* temporary; should be variable *) + ("/FontBBox" , pdfobject_of_bbox fontdescr.font_bbox); + ("/ItalicAngle", Pdf.Real(fontdescr.italic_angle)); + ("/Ascent" , of_per_mille fontdescr.ascent); + ("/Descent" , of_per_mille fontdescr.descent); + ("/StemV" , Pdf.Real(fontdescr.stemv)); + (font_file_key , objstream); ] + in + let ir_descr = Pdf.addobj pdf obj_descr in + return (Pdf.Indirect(ir_descr), subset_tag_opt) - let pdfobject_of_width_array (pdf : Pdf.t) (dcdr : decoder) : Pdf.pdfobject = - let bboxtbl = dcdr.glyph_bbox_table in - let arr = - bboxtbl |> GlyphBBoxTable.fold (fun gidorg (PerMille(w), _) acc -> - let SubsetNumber(n) = dcdr.subset_map |> SubsetMap.intern gidorg in - Pdf.Integer(n) :: Pdf.Array[Pdf.Integer(w)] :: acc - ) [] - in - let obj = Pdf.Array(arr) in - let ir = Pdf.addobj pdf obj in - Pdf.Indirect(ir) - - - let pdfobject_of_to_unicode_cmap (pdf : Pdf.t) (dcdr : decoder) : Pdf.pdfobject = - let gidtbl = dcdr.glyph_id_table in - let ligtbl = dcdr.ligature_table in - let touccmap = ToUnicodeCMap.create () in - - gidtbl |> GlyphIDTable.fold_rev (fun gidsub uch () -> - ToUnicodeCMap.add_single touccmap gidsub [uch] - ) (); - - ligtbl |> LigatureTable.fold_rev (fun gidlig gidlst () -> - try - let uchlst = - gidlst |> List.map (fun gidorg -> - match gidtbl |> GlyphIDTable.find_rev_opt gidorg with - | None -> raise Exit - | Some(uch) -> uch - ) - in + let pdfdict_of_cid_system_info cidsysinfo = + Pdf.Dictionary[ + ("/Registry" , Pdf.String(cidsysinfo.registry)); + ("/Ordering" , Pdf.String(cidsysinfo.ordering)); + ("/Supplement", Pdf.Integer(cidsysinfo.supplement)); + ] + + + let pdfobject_of_width_array (pdf : Pdf.t) (dcdr : decoder) : Pdf.pdfobject ok = + let open ResultMonad in + let bboxtbl = dcdr.glyph_bbox_table in + let* arr = + bboxtbl |> GlyphBBoxTable.fold (fun gidorg (PerMille(w), _) res -> + let* acc = res in + let* SubsetNumber(n) = dcdr.subset_map |> SubsetMap.intern gidorg in + return (Pdf.Integer(n) :: Pdf.Array[Pdf.Integer(w)] :: acc) + ) (return []) + in + let obj = Pdf.Array(arr) in + let ir = Pdf.addobj pdf obj in + return @@ Pdf.Indirect(ir) + + + let pdfobject_of_to_unicode_cmap (pdf : Pdf.t) (dcdr : decoder) : Pdf.pdfobject = + let gidtbl = dcdr.glyph_id_table in + let ligtbl = dcdr.ligature_table in + let touccmap = ToUnicodeCMap.create () in + + gidtbl |> GlyphIDTable.fold_rev (fun gidsub uch () -> + ToUnicodeCMap.add_single touccmap gidsub [uch] + ) (); + + ligtbl |> LigatureTable.fold_rev (fun gidlig gidlst () -> + try + let uchlst = + gidlst |> List.map (fun gidorg -> + match gidtbl |> GlyphIDTable.find_rev_opt gidorg with + | None -> raise Exit + | Some(uch) -> uch + ) + in (* - let pp_uchar_list fmt uchlst = Format.fprintf fmt "%s" (InternalText.to_utf8 (InternalText.of_uchar_list uchlst)) in (* for debug *) - let () = Format.printf "FontFormat> add ligature GID %04X -> [%a](debug)\n" gidlig pp_uchar_list uchlst in (* for debug *) + let pp_uchar_list fmt uchlst = Format.fprintf fmt "%s" (InternalText.to_utf8 (InternalText.of_uchar_list uchlst)) in (* for debug *) + let () = Format.printf "FontFormat> add ligature GID %04X -> [%a](debug)\n" gidlig pp_uchar_list uchlst in (* for debug *) *) - ToUnicodeCMap.add_single touccmap gidlig uchlst - with - | Exit -> () - ) (); - - let str = ToUnicodeCMap.stringify touccmap in - let iobytes = Pdfio.bytes_of_string str in - let stream = Pdf.Got(iobytes) in - let len = Pdfio.bytes_size iobytes in - let objstream = Pdf.Stream(ref (Pdf.Dictionary[("/Length", Pdf.Integer(len))], stream)) in - - Pdfcodec.encode_pdfstream pdf Pdfcodec.Flate objstream; - - let ir = Pdf.addobj pdf objstream in - Pdf.Indirect(ir) - - - (* Returns a descendant font dictionary of Type 0 CIDFont as an indirect reference. *) - let pdfobject_of_cid_type_0 pdf cidty0font dcdr : (Pdf.pdfobject * string option) = - let units_per_em = dcdr.units_per_em in - let cidsysinfo = cidty0font.CIDFontType0.cid_system_info in - let base_font = cidty0font.CIDFontType0.base_font in - let fontdescr = cidty0font.CIDFontType0.font_descriptor in - let (objdescr, subset_tag_opt) = pdfobject_of_font_descriptor pdf dcdr fontdescr base_font (FontFile3("OpenType")) in - let objwarr = pdfobject_of_width_array pdf dcdr in - let pmoptdw = - cidty0font.CIDFontType0.dw |> Option.map (per_mille ~units_per_em) - in - let pmpairoptdw2 = - cidty0font.CIDFontType0.dw2 |> Option.map (fun (a, b) -> (per_mille ~units_per_em a, per_mille ~units_per_em b)) - in - let objdescend = - Pdf.Dictionary([ - ("/Type" , Pdf.Name("/Font")); - ("/Subtype" , Pdf.Name("/CIDFontType0")); - ("/BaseFont" , Pdf.Name("/" ^ (add_subset_tag subset_tag_opt base_font))); - ("/CIDSystemInfo" , pdfdict_of_cid_system_info cidsysinfo); - ("/FontDescriptor", objdescr); - ("/W" , objwarr); - (* temporary; should add more; /W2 *) - ] |> add_entry_if_non_null "/DW" (of_per_mille_opt pmoptdw) - |> add_entry_if_non_null "/DW2" (of_per_mille_pair_opt pmpairoptdw2)) - in - let irdescend = Pdf.addobj pdf objdescend in - (Pdf.Indirect(irdescend), subset_tag_opt) - - - (* Returns a descendant font dictionary of Type 2 CIDFont as an indirect reference. *) - let pdfobject_of_cid_type_2 pdf cidty2font dcdr : (Pdf.pdfobject * string option) = - let units_per_em = dcdr.units_per_em in - let cidsysinfo = cidty2font.CIDFontType2.cid_system_info in - let base_font = cidty2font.CIDFontType2.base_font in - let fontdescr = cidty2font.CIDFontType2.font_descriptor in - let font_file = - (* Probably such conditional branching is not appropriate; should always choose true-branch *) - if cidty2font.CIDFontType2.is_pure_truetype then - FontFile2 - else - FontFile3("OpenType") - in - let (objdescr, subset_tag_opt) = pdfobject_of_font_descriptor pdf dcdr fontdescr base_font font_file in - let objcidtogidmap = - match cidty2font.CIDFontType2.cid_to_gid_map with - | CIDToGIDIdentity -> Pdf.Name("/Identity") - | _ -> remains_to_be_implemented "/CIDToGIDMap other than /Identity" - in - let dwpmopt = - cidty2font.CIDFontType2.dw |> Option.map (fun dw -> per_mille ~units_per_em dw) - in (* Per mille *) - let dw2pmpairopt = - cidty2font.CIDFontType2.dw2 |> Option.map (fun (a, b) -> (per_mille ~units_per_em a, per_mille ~units_per_em b)) - in - let objwarr = pdfobject_of_width_array pdf dcdr in - let objdescend = - Pdf.Dictionary([ - ("/Type" , Pdf.Name("/Font")); - ("/Subtype" , Pdf.Name("/CIDFontType2")); - ("/BaseFont" , Pdf.Name("/" ^ (add_subset_tag subset_tag_opt base_font))); - ("/CIDSystemInfo" , pdfdict_of_cid_system_info cidsysinfo); - ("/FontDescriptor", objdescr); - ("/W" , objwarr); - ("/CIDToGIDMap" , objcidtogidmap); - (* should add more; /W2 *) - ] |> add_entry_if_non_null "/DW" (of_per_mille_opt dwpmopt) - |> add_entry_if_non_null "/DW2" (of_per_mille_pair_opt dw2pmpairopt)) - in - let irdescend = Pdf.addobj pdf objdescend in - (Pdf.Indirect(irdescend), subset_tag_opt) - - - let to_pdfdict pdf ty0font dcdr = - let cidfont = ty0font.descendant_fonts in - let base_font_ty0 = ty0font.base_font in - let cmap = ty0font.encoding in - let (objdescend, subset_tag_opt) = - match cidfont with - | CIDFontType0(cidty0font) -> pdfobject_of_cid_type_0 pdf cidty0font dcdr - | CIDFontType2(cidty2font) -> pdfobject_of_cid_type_2 pdf cidty2font dcdr - in - let pdfobjtouc = pdfobject_of_to_unicode_cmap pdf dcdr in - Pdf.Dictionary[ - ("/Type" , Pdf.Name("/Font")); - ("/Subtype" , Pdf.Name("/Type0")); - ("/Encoding" , pdfobject_of_cmap pdf cmap); - ("/BaseFont" , Pdf.Name("/" ^ (add_subset_tag subset_tag_opt base_font_ty0))); (* Can be arbitrary name. *) - ("/DescendantFonts", Pdf.Array[objdescend]); - ("/ToUnicode" , pdfobjtouc); - ] + ToUnicodeCMap.add_single touccmap gidlig uchlst + with + | Exit -> () + ) (); + + let str = ToUnicodeCMap.stringify touccmap in + let iobytes = Pdfio.bytes_of_string str in + let stream = Pdf.Got(iobytes) in + let len = Pdfio.bytes_size iobytes in + let objstream = Pdf.Stream(ref (Pdf.Dictionary[("/Length", Pdf.Integer(len))], stream)) in + + Pdfcodec.encode_pdfstream pdf Pdfcodec.Flate objstream; + + let ir = Pdf.addobj pdf objstream in + Pdf.Indirect(ir) + + + (* Returns a descendant font dictionary of Type 0 CIDFont as an indirect reference. *) + let pdfobject_of_cid_type_0 pdf cidty0font dcdr : (Pdf.pdfobject * string option) ok = + let open ResultMonad in + let units_per_em = dcdr.units_per_em in + let cidsysinfo = cidty0font.CIDFontType0.cid_system_info in + let base_font = cidty0font.CIDFontType0.base_font in + let fontdescr = cidty0font.CIDFontType0.font_descriptor in + let* (obj_descr, subset_tag_opt) = pdfobject_of_font_descriptor pdf dcdr fontdescr base_font (FontFile3("OpenType")) in + let* obj_warr = pdfobject_of_width_array pdf dcdr in + let pmoptdw = + cidty0font.CIDFontType0.dw |> Option.map (per_mille ~units_per_em) + in + let pmpairoptdw2 = + cidty0font.CIDFontType0.dw2 |> Option.map (fun (a, b) -> (per_mille ~units_per_em a, per_mille ~units_per_em b)) + in + let obj_descend = + Pdf.Dictionary([ + ("/Type" , Pdf.Name("/Font")); + ("/Subtype" , Pdf.Name("/CIDFontType0")); + ("/BaseFont" , Pdf.Name("/" ^ (add_subset_tag subset_tag_opt base_font))); + ("/CIDSystemInfo" , pdfdict_of_cid_system_info cidsysinfo); + ("/FontDescriptor", obj_descr); + ("/W" , obj_warr); + (* temporary; should add more; /W2 *) + ] |> add_entry_if_non_null "/DW" (of_per_mille_opt pmoptdw) + |> add_entry_if_non_null "/DW2" (of_per_mille_pair_opt pmpairoptdw2)) + in + let ir_descend = Pdf.addobj pdf obj_descend in + return (Pdf.Indirect(ir_descend), subset_tag_opt) + + + (* Returns a descendant font dictionary of Type 2 CIDFont as an indirect reference. *) + let pdfobject_of_cid_type_2 (pdf : Pdf.t) cidty2font (dcdr : decoder) : (Pdf.pdfobject * string option) ok = + let open ResultMonad in + let units_per_em = dcdr.units_per_em in + let cidsysinfo = cidty2font.CIDFontType2.cid_system_info in + let base_font = cidty2font.CIDFontType2.base_font in + let fontdescr = cidty2font.CIDFontType2.font_descriptor in + let font_file = + (* Probably such conditional branching is not appropriate; should always choose true-branch *) + if cidty2font.CIDFontType2.is_pure_truetype then + FontFile2 + else + FontFile3("OpenType") + in + let* (obj_descr, subset_tag_opt) = pdfobject_of_font_descriptor pdf dcdr fontdescr base_font font_file in + let obj_cid_to_gid_map = + match cidty2font.CIDFontType2.cid_to_gid_map with + | CIDToGIDIdentity -> Pdf.Name("/Identity") + | _ -> remains_to_be_implemented "/CIDToGIDMap other than /Identity" + in + let dwpm_opt = + cidty2font.CIDFontType2.dw |> Option.map (fun dw -> per_mille ~units_per_em dw) + in (* Per mille *) + let dw2pmpair_opt = + cidty2font.CIDFontType2.dw2 |> Option.map (fun (a, b) -> + (per_mille ~units_per_em a, per_mille ~units_per_em b) + ) + in + let* obj_warr = pdfobject_of_width_array pdf dcdr in + let obj_descend = + Pdf.Dictionary([ + ("/Type" , Pdf.Name("/Font")); + ("/Subtype" , Pdf.Name("/CIDFontType2")); + ("/BaseFont" , Pdf.Name("/" ^ (add_subset_tag subset_tag_opt base_font))); + ("/CIDSystemInfo" , pdfdict_of_cid_system_info cidsysinfo); + ("/FontDescriptor", obj_descr); + ("/W" , obj_warr); + ("/CIDToGIDMap" , obj_cid_to_gid_map); + (* should add more; /W2 *) + ] |> add_entry_if_non_null "/DW" (of_per_mille_opt dwpm_opt) + |> add_entry_if_non_null "/DW2" (of_per_mille_pair_opt dw2pmpair_opt)) + in + let ir_descend = Pdf.addobj pdf obj_descend in + return (Pdf.Indirect(ir_descend), subset_tag_opt) + + + let to_pdfdict (pdf : Pdf.t) ty0font (dcdr : decoder) : Pdf.pdfobject ok = + let open ResultMonad in + let cidfont = ty0font.descendant_fonts in + let base_font_ty0 = ty0font.base_font in + let cmap = ty0font.encoding in + let* (objdescend, subset_tag_opt) = + match cidfont with + | CIDFontType0(cidty0font) -> pdfobject_of_cid_type_0 pdf cidty0font dcdr + | CIDFontType2(cidty2font) -> pdfobject_of_cid_type_2 pdf cidty2font dcdr + in + let pdfobjtouc = pdfobject_of_to_unicode_cmap pdf dcdr in + return @@ Pdf.Dictionary[ + ("/Type" , Pdf.Name("/Font")); + ("/Subtype" , Pdf.Name("/Type0")); + ("/Encoding" , pdfobject_of_cmap pdf cmap); + ("/BaseFont" , Pdf.Name("/" ^ (add_subset_tag subset_tag_opt base_font_ty0))); (* Can be arbitrary name. *) + ("/DescendantFonts", Pdf.Array[objdescend]); + ("/ToUnicode" , pdfobjtouc); + ] + +end - end type font = | Type0 of Type0.font -let make_dictionary (pdf : Pdf.t) (font : font) (dcdr : decoder) : Pdf.pdfobject = +let make_dictionary (pdf : Pdf.t) (font : font) (dcdr : decoder) : Pdf.pdfobject ok = match font with | Type0(ty0font) -> Type0.to_pdfdict pdf ty0font dcdr +let make_dictionary_exn (pdf : Pdf.t) (font : font) (dcdr : decoder) : Pdf.pdfobject = + raise_if_err @@ make_dictionary pdf font dcdr + + let make_decoder (abspath : abs_path) (d : D.source) : decoder ok = let open ResultMonad in let* cmapsubtbl = get_cmap_subtable ~file_path:abspath d in @@ -1840,9 +1831,9 @@ let make_decoder (abspath : abs_path) (d : D.source) : decoder ok = |> Result.map_error (fun e -> FailedToDecodeFont(abspath, e)) in let* postscript_name = get_postscript_name ~file_path:abspath d in - let kerntbl = get_kerning_table abspath d in - let ligtbl = get_ligature_table abspath submap d in - let mktbl = get_mark_table abspath units_per_em d in + let* kerntbl = get_kerning_table ~file_path:abspath d in + let* ligtbl = get_ligature_table ~file_path:abspath submap d in + let* mktbl = get_mark_table ~file_path:abspath ~units_per_em d in return { file_path = abspath; postscript_name = postscript_name; @@ -1870,30 +1861,34 @@ let cid_font_type_2 cidty2font fontname cmap = Type0(Type0.of_cid_font (CIDFontType2(cidty2font)) fontname cmap) -let get_font (dcdr : decoder) (fontreg : font_registration) : font = +let get_font (dcdr : decoder) (fontreg : font_registration) : font ok = + let open ResultMonad in let cmap = PredefinedCMap("Identity-H") in match fontreg with | CIDFontType0Registration(cidsysinfo, _embedW) -> - let cidty0font = CIDFontType0.of_decoder dcdr cidsysinfo in - (cid_font_type_0 cidty0font dcdr.postscript_name cmap) + let* cidty0font = CIDFontType0.of_decoder dcdr cidsysinfo in + return (cid_font_type_0 cidty0font dcdr.postscript_name cmap) | CIDFontType2OTRegistration(cidsysinfo, _embedW) -> - let cidty2font = CIDFontType2.of_decoder dcdr cidsysinfo true (* temporary *) in - (cid_font_type_2 cidty2font dcdr.postscript_name cmap) + let is_pure_truetype = true in (* TODO: fix this *) + let* cidty2font = CIDFontType2.of_decoder ~is_pure_truetype dcdr cidsysinfo in + return (cid_font_type_2 cidty2font dcdr.postscript_name cmap) let get_decoder_single (abspath : abs_path) : (decoder * font) ok = let open ResultMonad in let* (d, fontreg) = get_main_decoder_single abspath in let* dcdr = make_decoder abspath d in - return (dcdr, get_font dcdr fontreg) + let* font = get_font dcdr fontreg in + return (dcdr, font) let get_decoder_ttc (abspath :abs_path) (index : int) : (decoder * font) ok = let open ResultMonad in let* (d, fontreg) = get_main_decoder_ttc abspath index in let* dcdr = make_decoder abspath d in - return (dcdr, get_font dcdr fontreg) + let* font = get_font dcdr fontreg in + return (dcdr, font) let convert_to_ligatures (dcdr : decoder) (seglst : glyph_segment list) : (glyph_synthesis list) ok = @@ -1912,14 +1907,16 @@ let convert_to_ligatures (dcdr : decoder) (seglst : glyph_segment list) : (glyph | ReachEnd -> return @@ Alist.to_list acc - | Match(gidorglig, markorginfolst, segorgrest) -> + | Match(gidorg_lig, markorginfolst, segorgrest) -> let* markinfolst = markorginfolst |> mapM (fun (gidorg, v) -> - let* (w, _, _) = get_glyph_metrics dcdr (intf gidorg) in - return @@ Mark(intf gidorg, w, v) + let* gid = intf gidorg in + let* (w, _, _) = get_glyph_metrics dcdr gid in + return @@ Mark(gid, w, v) ) in - aux (Alist.extend acc (intf gidorglig, markinfolst)) segorgrest + let* gid_lig = intf gidorg_lig in + aux (Alist.extend acc (gid_lig, markinfolst)) segorgrest in let segorglst = seglst |> List.map orgsegf in aux Alist.empty segorglst @@ -2021,6 +2018,9 @@ let assoc_to_map f gidassoc = let make_math_decoder_from_decoder (abspath : abs_path) (dcdr : decoder) (font : font) : (math_decoder * font) ok = let open ResultMonad in + let inject res = + res |> Result.map_error (fun e -> FailedToDecodeFont(abspath, e)) + in let units_per_em = dcdr.units_per_em in let d = dcdr.main in let* mathraw_opt = @@ -2059,31 +2059,17 @@ let make_math_decoder_from_decoder (abspath : abs_path) (dcdr : decoder) (font : ) in let* ssty_opt = - let res = - let open ResultMonad in - inject @@ D.Gsub.get d >>= function - | None -> - err MissingScript - - | Some(igsub) -> - inject @@ D.Gsub.scripts igsub >>= fun scripts -> - pickup scripts - (fun gs -> String.equal (D.Gsub.get_script_tag gs) "math") MissingScript >>= fun script_math -> - inject @@ select_gsub_langsys script_math >>= fun langsys -> - inject @@ D.Gsub.features langsys >>= fun (_, features) -> - pickup features - (fun gf -> String.equal (D.Gsub.get_feature_tag gf) "ssty") MissingFeature - in - match res with - | Ok(feature_ssty) -> - return @@ Some(feature_ssty) - - | Error(MissingScript) - | Error(MissingFeature) -> + inject @@ D.Gsub.get d >>= function + | None -> return None - | Error(GeneralError(e)) -> - err @@ FailedToDecodeFont(abspath, e) + | Some(igsub) -> + inject @@ D.Gsub.scripts igsub >>= fun scripts -> + pickup scripts (fun gs -> String.equal (D.Gsub.get_script_tag gs) "math") None <| fun script_math -> + inject @@ select_gsub_langsys script_math >>= fun langsys -> + inject @@ D.Gsub.features langsys >>= fun (_, features) -> + pickup features (fun gf -> String.equal (D.Gsub.get_feature_tag gf) "ssty") None <| fun ssty -> + return @@ Some(ssty) in let md = { @@ -2112,14 +2098,16 @@ let get_math_decoder_ttc (abspath : abs_path) (index : int) : (math_decoder * fo make_math_decoder_from_decoder abspath dcdr font -let get_math_script_variant (md : math_decoder) (gid : glyph_id) : glyph_id = +let get_math_script_variant (md : math_decoder) (gid : glyph_id) : glyph_id ok = + let open ResultMonad in match md.script_style_info with | None -> (* If the font does NOT have 'ssty' feature table: *) - gid + return gid | Some(feature_ssty) -> let dcdr = md.as_normal_font in + let abspath = dcdr.file_path in let gidorg = get_original_gid dcdr gid in let f_single opt (gidorgfrom, gidorgto) = match opt with @@ -2132,19 +2120,28 @@ let get_math_script_variant (md : math_decoder) (gid : glyph_id) : glyph_id = | (None, []) -> opt | (None, gidorgto :: _) -> if gidorgfrom = gidorg then Some(gidorgto) else opt in - let res = D.Gsub.fold_subtables ~single:f_single ~alt:f_alt feature_ssty None in - match res with - | Error(_oerr) -> gid (* temporary; maybe should emit an error *) - | Ok(None) -> gid - | Ok(Some(gidorgssty)) -> intern_gid dcdr gidorgssty + let* gidorg_ssty_opt = + D.Gsub.fold_subtables ~single:f_single ~alt:f_alt feature_ssty None + |> Result.map_error (fun e -> FailedToDecodeFont(abspath, e)) + in + match gidorg_ssty_opt with + | None -> return gid + | Some(gidorg_ssty) -> intern_gid dcdr gidorg_ssty + +let get_math_script_variant_exn (md : math_decoder) (gid : glyph_id) : glyph_id = + raise_if_err @@ get_math_script_variant md gid -let get_math_glyph_id (md : math_decoder) (uch : Uchar.t) : glyph_id option = +let get_math_glyph_id (md : math_decoder) (uch : Uchar.t) : (glyph_id option) ok = let dcdr = md.as_normal_font in get_glyph_id dcdr uch +let get_math_glyph_id_exn (md : math_decoder) (uch : Uchar.t) : glyph_id option = + raise_if_err @@ get_math_glyph_id md uch + + let truncate_negative (PerMille(x)) = PerMille(max 0 x) @@ -2175,24 +2172,39 @@ let get_math_correction_metrics (md : math_decoder) (gid : glyph_id) : per_mille (micopt, mkiopt) -let get_math_variants (md : math_decoder) (gid : glyph_id) (map : (math_variant_glyph list) MathInfoMap.t) : (glyph_id * float) list = +let get_math_variants (md : math_decoder) (gid : glyph_id) (map : (math_variant_glyph list) MathInfoMap.t) : ((glyph_id * float) list) ok = + let open ResultMonad in let dcdr = md.as_normal_font in let gidorg = get_original_gid dcdr gid in match map |> MathInfoMap.find_opt gidorg with - | None -> [] - | Some(assoc) -> assoc |> List.map (fun (gidorg, du) -> (intern_gid dcdr gidorg, to_ratio md du)) + | None -> + return [] + + | Some(assoc) -> + assoc |> mapM (fun (gidorg, du) -> + let* gid = intern_gid dcdr gidorg in + return (gid, to_ratio md du) + ) -let get_math_vertical_variants (md : math_decoder) (gid : glyph_id) : (glyph_id * float) list = +let get_math_vertical_variants (md : math_decoder) (gid : glyph_id) : ((glyph_id * float) list) ok = let mvertvarmap = md.math_vertical_variants in mvertvarmap |> get_math_variants md gid +let get_math_vertical_variants_exn (md : math_decoder) (gid : glyph_id) : (glyph_id * float) list = + raise_if_err @@ get_math_vertical_variants md gid + + let get_math_horizontal_variants (md : math_decoder) (gid : glyph_id) = let mhorzvarmap = md.math_horizontal_variants in mhorzvarmap |> get_math_variants md gid +let get_math_horizontal_variants_exn (md : math_decoder) (gid : glyph_id) : (glyph_id * float) list = + raise_if_err @@ get_math_horizontal_variants md gid + + type math_constants = { (* General: *) axis_height : float; diff --git a/src/backend/fontFormat.mli b/src/backend/fontFormat.mli index 65fab8ea5..d44374453 100644 --- a/src/backend/fontFormat.mli +++ b/src/backend/fontFormat.mli @@ -2,7 +2,6 @@ open MyUtil open FontError -exception BrokenFont of abs_path * string exception FontError of font_error type glyph_id @@ -37,7 +36,7 @@ type cmap = type font -val make_dictionary : Pdf.t -> font -> decoder -> Pdf.pdfobject +val make_dictionary_exn : Pdf.t -> font -> decoder -> Pdf.pdfobject val get_decoder_single : abs_path -> (decoder * font, font_error) result @@ -45,7 +44,7 @@ val get_decoder_ttc : abs_path -> int -> (decoder * font, font_error) result val get_glyph_metrics_exn : decoder -> glyph_id -> metrics -val get_glyph_id : decoder -> Uchar.t -> glyph_id option +val get_glyph_id_exn : decoder -> Uchar.t -> glyph_id option val convert_to_ligatures_exn : decoder -> glyph_segment list -> glyph_synthesis list @@ -69,17 +68,17 @@ val get_math_decoder_ttc : abs_path -> int -> (math_decoder * font, font_error) val math_base_font : math_decoder -> decoder -val get_math_glyph_id : math_decoder -> Uchar.t -> glyph_id option +val get_math_glyph_id_exn : math_decoder -> Uchar.t -> glyph_id option -val get_math_script_variant : math_decoder -> glyph_id -> glyph_id +val get_math_script_variant_exn : math_decoder -> glyph_id -> glyph_id val get_math_glyph_metrics_exn : math_decoder -> glyph_id -> metrics val get_math_correction_metrics : math_decoder -> glyph_id -> per_mille option * math_kern_info option -val get_math_vertical_variants : math_decoder -> glyph_id -> (glyph_id * float) list +val get_math_vertical_variants_exn : math_decoder -> glyph_id -> (glyph_id * float) list -val get_math_horizontal_variants : math_decoder -> glyph_id -> (glyph_id * float) list +val get_math_horizontal_variants_exn : math_decoder -> glyph_id -> (glyph_id * float) list type math_constants = { diff --git a/src/frontend/fontError.ml b/src/frontend/fontError.ml index 0ed883566..bf039cc1b 100644 --- a/src/frontend/fontError.ml +++ b/src/frontend/fontError.ml @@ -4,6 +4,7 @@ open MyUtil type font_error = | FailedToReadFont of abs_path * string | FailedToDecodeFont of abs_path * Otfed.Decode.Error.t + | FailedToMakeSubset of abs_path * Otfed.Subset.Error.t | NotASingleFont of abs_path | NotAFontCollectionElement of abs_path * int | CannotFindLibraryFileAsToFont of lib_path * abs_path list diff --git a/src/frontend/fontInfo.ml b/src/frontend/fontInfo.ml index 5da641e57..8034bc6fa 100644 --- a/src/frontend/fontInfo.ml +++ b/src/frontend/fontInfo.ml @@ -174,7 +174,7 @@ let convert_gid_list (metricsf : FontFormat.glyph_id -> FontFormat.metrics) (dcd let get_glyph_id dcdr uch = - match FontFormat.get_glyph_id dcdr uch with + match FontFormat.get_glyph_id_exn dcdr uch with | None -> (* TODO: fix this *) (* @@ -340,7 +340,7 @@ let get_math_char_info (mathkey : math_key) ~(is_in_base_level : bool) ~(is_in_d let gidlst = uchlst |> List.map (fun uch -> let gidraw = - match FontFormat.get_math_glyph_id md uch with + match FontFormat.get_math_glyph_id_exn md uch with | None -> (* Logging.warn_no_math_glyph mfabbrev uch; (* TODO: fix this *) @@ -354,11 +354,11 @@ let get_math_char_info (mathkey : math_key) ~(is_in_base_level : bool) ~(is_in_d if is_in_base_level then gidraw else - FontFormat.get_math_script_variant md gidraw + FontFormat.get_math_script_variant_exn md gidraw in let gid = if is_in_display && is_big then - match FontFormat.get_math_vertical_variants md gidsub with + match FontFormat.get_math_vertical_variants_exn md gidsub with | [] -> gidsub @@ -395,13 +395,13 @@ let get_font_dictionary (pdf : Pdf.t) : Pdf.pdfobject = let tag = dfn.font_tag in let font = dfn.font in let dcdr = dfn.decoder in - let obj = FontFormat.make_dictionary pdf font dcdr in + let obj = FontFormat.make_dictionary_exn pdf font dcdr in (tag, obj) :: acc ) |> MathFontHashTable.fold (fun _ mfdfn acc -> let tag = mfdfn.math_font_tag in let font = mfdfn.math_font in let md = mfdfn.math_decoder in - let obj = FontFormat.make_dictionary pdf font (FontFormat.math_base_font md) in + let obj = FontFormat.make_dictionary_exn pdf font (FontFormat.math_base_font md) in (tag, obj) :: acc ) in diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 6754efdf2..4d0bb5124 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1076,6 +1076,13 @@ let report_font_error : font_error -> unit = function NormalLine(Format.asprintf "%a" Otfed.Decode.Error.pp e); ] + | FailedToMakeSubset(abspath, e) -> + let fname = convert_abs_path_to_show abspath in + report_error Interface [ + NormalLine(Printf.sprintf "cannot make a subset of font file '%s';" fname); + NormalLine(Format.asprintf "%a" Otfed.Subset.Error.pp e); + ] + | NotASingleFont(abspath) -> let fname = convert_abs_path_to_show abspath in report_error Interface [ @@ -1157,13 +1164,6 @@ let error_log_environment (suspended : unit -> unit) : unit = | FontInfo.FontInfoError(e) -> report_font_error e - | FontFormat.BrokenFont(abspath, msg) -> - let fname = convert_abs_path_to_show abspath in - report_error Interface [ - NormalLine(Printf.sprintf "font file '%s' is broken;" fname); - DisplayLine(msg); - ] - | FontFormat.FontError(e) -> report_font_error e From ac0a37efeb8fc46e9ea341f1900c0a3cc9ec0af7 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 13 Nov 2022 05:08:24 +0900 Subject: [PATCH 149/288] refactor 'FontFormat' (mostly cosmetic changes) --- src/backend/fontFormat.ml | 182 +++++++++++++++++++------------------- 1 file changed, 90 insertions(+), 92 deletions(-) diff --git a/src/backend/fontFormat.ml b/src/backend/fontFormat.ml index 474d60195..a30930474 100644 --- a/src/backend/fontFormat.ml +++ b/src/backend/fontFormat.ml @@ -552,15 +552,15 @@ end let select_langsys gxxx_langsys script = let open ResultMonad in - gxxx_langsys script >>= fun langsys_res -> - let langsys = - match langsys_res with - | (Some(langsys), _) -> langsys - | (None, langsys :: _) -> langsys - | (None, []) -> remains_to_be_implemented "no langsys" - (* TODO: should depend on the current language system *) - in - return langsys + gxxx_langsys script >>= fun langsys_res -> + let langsys = + match langsys_res with + | (Some(langsys), _) -> langsys + | (None, langsys :: _) -> langsys + | (None, []) -> remains_to_be_implemented "no langsys" + (* TODO: should depend on the current language system *) + in + return langsys let select_gpos_langsys = select_langsys D.Gpos.langsyses @@ -824,7 +824,7 @@ end = struct begin match gomarks with | _ :: _ -> - (* temporary; should refer to MarkToMark table + (* TODO: should refer to MarkToMark table in order to handle diacritical marks after the first one *) begin match attach_marks false mktbl MarkTable.find_base_opt gobase gomarks with @@ -846,7 +846,7 @@ end = struct begin match lookup mktbl liginfolst segorgtail with | None -> Match(gobase, [], segorgtail) - | Some((golig, markinfolst, segorgrest)) -> Match(golig, markinfolst, segorgrest) (* temporary *) + | Some((golig, markinfolst, segorgrest)) -> Match(golig, markinfolst, segorgrest) (* TODO *) end end end @@ -1205,14 +1205,13 @@ type font_descriptor = { font_family : string; font_stretch : font_stretch option; font_weight : int option; (* Ranges only over {100, 200, ..., 900}. *) - flags : int option; (* temporary; maybe should be handled as a boolean record *) + flags : int option; (* TODO: handle this as a boolean record *) font_bbox : bbox; italic_angle : float; ascent : per_mille; descent : per_mille; stemv : float; font_data : (D.source resource) ref; - (* temporary; should contain more fields *) } @@ -1317,13 +1316,11 @@ let get_cmap_subtable ~(file_path : abs_path) (d : D.source) : V.Cmap.subtable o begin D.Cmap.get d >>= fun icmap -> D.Cmap.get_subtables icmap >>= fun isubtbls -> - isubtbls |> List.fold_left (fun res isubtbl -> (* TODO: refactor here by using `mapM` *) - res >>= fun acc -> + isubtbls |> mapM (fun isubtbl -> let format = D.Cmap.get_format_number isubtbl in D.Cmap.unmarshal_subtable isubtbl >>= fun subtbl -> - return (Alist.extend acc (subtbl, format)) - ) (return Alist.empty) >>= fun acc -> - let subtbls = Alist.to_list acc in + return (subtbl, format) + ) >>= fun subtbls -> let opt = List.fold_left (fun opt idspred -> match opt with @@ -1406,18 +1403,17 @@ let font_descriptor_of_decoder (dcdr : decoder) (font_name : string) : font_desc per_mille ~units_per_em head_derived.y_max) in return { - font_name = font_name; (* Same as `Otfm.postscript_name dcdr` *) - font_family = ""; (* temporary; should be gotten from decoder *) + font_name = font_name; (* PostScript name *) + font_family = ""; (* TODO: get this from decoder *) font_stretch = Some(font_stretch_of_width_class ios2.I.Os2.value.us_width_class); font_weight = Some(font_weight_of_weight_class ios2.I.Os2.value.us_weight_class); - flags = None; (* temporary; should be gotten from decoder *) + flags = None; (* TODO: get this from decoder *) font_bbox = bbox; - italic_angle = 0.; (* temporary; should be gotten from decoder; 'post.italicAngle' *) + italic_angle = 0.; (* TODO: get this from decoder; 'post.italicAngle' *) ascent = per_mille ~units_per_em ihhea.I.Hhea.value.ascender; descent = per_mille ~units_per_em ihhea.I.Hhea.value.descender; - stemv = 0.; (* temporary; should be gotten from decoder *) + stemv = 0.; (* TODO: get this from decoder *) font_data = ref (Data(d)); - (* temporary; should contain more fields *) } end |> Result.map_error (fun e -> FailedToDecodeFont(dcdr.file_path, e)) @@ -1466,16 +1462,16 @@ let font_file_info_of_embedding embedding = module CIDFontType0 = struct + type font = { - cid_system_info : cid_system_info; - base_font : string; - font_descriptor : font_descriptor; - dw : design_units option; (* Represented by units defined by head.unitsPerEm *) - dw2 : (int * int) option; - (* temporary; should contain more fields; /W2 *) - } + cid_system_info : cid_system_info; + base_font : string; + font_descriptor : font_descriptor; + dw : design_units option; + dw2 : (int * int) option; + } (* Doesn't have to contain information about /W entry; - the PDF file will be furnished with /W entry when outputted + the resulting PDF file will be furnished with /W entry when output according to the glyph metrics table. *) @@ -1490,16 +1486,18 @@ module CIDFontType0 = struct dw = None; (* temporary *) dw2 = None; (* temporary *) } + end (* -w -unused-constructor *) type[@ocaml.warning "-37"] cid_to_gid_map = | CIDToGIDIdentity - | CIDToGIDStream of (string resource) ref (* temporary *) + | CIDToGIDStream of (string resource) ref (* TODO *) module CIDFontType2 = struct + type font = { cid_system_info : cid_system_info; base_font : string; @@ -1508,10 +1506,9 @@ module CIDFontType2 = struct dw2 : (int * int) option; cid_to_gid_map : cid_to_gid_map; is_pure_truetype : bool; - (* temporary; should contain more fields; /W2 *) } (* Doesn't have to contain information about /W entry; - the /W entry will be added by using the glyph metrics table when the PDF file is outputted. *) + the /W entry will be added by using the glyph metrics table when outputting the PDF file. *) let of_decoder ~(is_pure_truetype : bool) (dcdr : decoder) (cidsysinfo : cid_system_info) : font ok = @@ -1522,11 +1519,12 @@ module CIDFontType2 = struct cid_system_info = cidsysinfo; base_font = base_font; font_descriptor = font_descriptor; - dw = None; (* temporary *) - dw2 = None; (* temporary *) + dw = None; (* TODO *) + dw2 = None; (* TODO *) is_pure_truetype = is_pure_truetype; - cid_to_gid_map = CIDToGIDIdentity; (* temporary *) + cid_to_gid_map = CIDToGIDIdentity; (* TODO *) } + end @@ -1546,63 +1544,64 @@ let pdfobject_of_bbox (PerMille(xmin), PerMille(ymin), PerMille(xmax), PerMille( Pdf.Array[Pdf.Integer(xmin); Pdf.Integer(ymin); Pdf.Integer(xmax); Pdf.Integer(ymax)] -module ToUnicodeCMap -: sig - type t - val create : unit -> t - val add_single : t -> subset_glyph_id -> Uchar.t list -> unit - val stringify : t -> string - end -= struct +module ToUnicodeCMap : sig + type t + val create : unit -> t + val add_single : t -> subset_glyph_id -> Uchar.t list -> unit + val stringify : t -> string +end = struct - type t = ((Uchar.t list) GSHt.t) array + type t = ((Uchar.t list) GSHt.t) array - let create () = - Array.init 1024 (fun _ -> GSHt.create 32) - - let add_single touccmap gid uchlst = - let i = match gid with SubsetNumber(n) -> n / 64 in - GSHt.add (touccmap.(i)) gid uchlst - - let stringify touccmap = - let prefix = - "/CIDInit/ProcSet findresource begin " - ^ "12 dict begin begincmap/CIDSystemInfo<<" - ^ "/Registry(Adobe)/Ordering(UCS)/Supplement 0>> def" - ^ "/CMapName/Adobe-Identity-UCS def/CMapType 2 def " - ^ "1 begincodespacerange<0000>endcodespacerange " - in - let postfix = - "endcmap CMapName currentdict/CMap defineresource pop end end" - in - let buf = Buffer.create ((15 + (6 + 512) * 64 + 10) * 1024) in - Array.iter (fun ht -> - let num = GSHt.length ht in - if num <= 0 then - () - else - begin - Printf.bprintf buf "%d beginbfchar" num; - GSHt.iter (fun (SubsetNumber(n)) uchlst -> - let dst = (InternalText.to_utf16be_hex (InternalText.of_uchar_list uchlst)) in - Printf.bprintf buf "<%04X><%s>" n dst - ) ht; - Printf.bprintf buf "endbfchar "; - end - ) touccmap; - let strmain = Buffer.contents buf in - let res = prefix ^ strmain ^ postfix in - res - end + let create () = + Array.init 1024 (fun _ -> GSHt.create 32) + + + let add_single touccmap gid uchlst = + let i = match gid with SubsetNumber(n) -> n / 64 in + GSHt.add (touccmap.(i)) gid uchlst + + + let stringify touccmap = + let prefix = + "/CIDInit/ProcSet findresource begin " + ^ "12 dict begin begincmap/CIDSystemInfo<<" + ^ "/Registry(Adobe)/Ordering(UCS)/Supplement 0>> def" + ^ "/CMapName/Adobe-Identity-UCS def/CMapType 2 def " + ^ "1 begincodespacerange<0000>endcodespacerange " + in + let postfix = + "endcmap CMapName currentdict/CMap defineresource pop end end" + in + let buf = Buffer.create ((15 + (6 + 512) * 64 + 10) * 1024) in + Array.iter (fun ht -> + let num = GSHt.length ht in + if num <= 0 then + () + else + begin + Printf.bprintf buf "%d beginbfchar" num; + GSHt.iter (fun (SubsetNumber(n)) uchlst -> + let dst = (InternalText.to_utf16be_hex (InternalText.of_uchar_list uchlst)) in + Printf.bprintf buf "<%04X><%s>" n dst + ) ht; + Printf.bprintf buf "endbfchar "; + end + ) touccmap; + let strmain = Buffer.contents buf in + let res = prefix ^ strmain ^ postfix in + res + +end module Type0 = struct type font = { - base_font : string; - encoding : cmap; - descendant_fonts : cid_font; (* Represented as a singleton list in PDF. *) - } + base_font : string; + encoding : cmap; + descendant_fonts : cid_font; (* Represented as a singleton list in PDF. *) + } let of_cid_font cidfont fontname cmap = @@ -1622,7 +1621,7 @@ module Type0 = struct Pdf.Dictionary[ ("/Type" , Pdf.Name("/FontDescriptor")); ("/FontName" , Pdf.Name("/" ^ (add_subset_tag subset_tag_opt base_font))); - ("/Flags" , Pdf.Integer(4)); (* temporary; should be variable *) + ("/Flags" , Pdf.Integer(4)); (* TODO: make this changeable *) ("/FontBBox" , pdfobject_of_bbox fontdescr.font_bbox); ("/ItalicAngle", Pdf.Real(fontdescr.italic_angle)); ("/Ascent" , of_per_mille fontdescr.ascent); @@ -1720,7 +1719,6 @@ module Type0 = struct ("/CIDSystemInfo" , pdfdict_of_cid_system_info cidsysinfo); ("/FontDescriptor", obj_descr); ("/W" , obj_warr); - (* temporary; should add more; /W2 *) ] |> add_entry_if_non_null "/DW" (of_per_mille_opt pmoptdw) |> add_entry_if_non_null "/DW2" (of_per_mille_pair_opt pmpairoptdw2)) in @@ -1994,7 +1992,7 @@ let convert_kern (mkopt : V.Math.math_kern option) : math_kern = match mk with | ([], kernlast :: []) -> (Alist.to_list acc, f kernlast) | (hgthead :: hgttail, kernhead :: kerntail) -> aux (Alist.extend acc (f hgthead, f kernhead)) (hgttail, kerntail) - | _ -> assert false (* temporary; should report error *) + | _ -> assert false (* TODO: report error *) in match mkopt with | None -> ([], 0) @@ -2076,7 +2074,7 @@ let make_math_decoder_from_decoder (abspath : abs_path) (dcdr : decoder) (font : as_normal_font = dcdr; math_constants = mathraw.V.Math.math_constants; math_italics_correction = micmap; - math_top_accent_attachment = MathInfoMap.empty; (* temporary *) + math_top_accent_attachment = MathInfoMap.empty; (* TODO *) math_vertical_variants = mvertvarmap; math_horizontal_variants = mhorzvarmap; math_kern_info = mkimap; From 5646c3e5cace7e95d69070d664a302e94dfe547b Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 13 Nov 2022 05:18:42 +0900 Subject: [PATCH 150/288] completely remove exceptions from 'FontFormat' --- src/backend/fontFormat.ml | 43 -------------------------------------- src/backend/fontFormat.mli | 28 ++++++++++++------------- src/frontend/fontInfo.ml | 28 +++++++++++++++++-------- src/frontend/main.ml | 3 --- 4 files changed, 33 insertions(+), 69 deletions(-) diff --git a/src/backend/fontFormat.ml b/src/backend/fontFormat.ml index a30930474..07736ccb0 100644 --- a/src/backend/fontFormat.ml +++ b/src/backend/fontFormat.ml @@ -7,8 +7,6 @@ module I = Otfed.Intermediate module D = Otfed.Decode -exception FontError of font_error - type original_glyph_id = V.glyph_id type 'a ok = ('a, font_error) result @@ -21,11 +19,6 @@ type per_mille = type metrics = per_mille * per_mille * per_mille -let raise_if_err = function - | Ok(v) -> v - | Error(e) -> raise (FontError(e)) - - let pickup (xs : 'a list) (predicate : 'a -> bool) (e : 'b) (k : 'a -> ('b, 'e) result) : ('b, 'e) result = let open ResultMonad in match xs |> List.filter predicate with @@ -1150,10 +1143,6 @@ let get_glyph_metrics (dcdr : decoder) (gid : glyph_id) : metrics ok = return (wid, hgt, dpt) -let get_glyph_metrics_exn (dcdr : decoder) (gid : glyph_id) : metrics = - raise_if_err @@ get_glyph_metrics dcdr gid - - type 'a resource = | Data of 'a | EmbeddedStream of int @@ -1362,10 +1351,6 @@ let get_glyph_id (dcdr : decoder) (uch : Uchar.t) : (glyph_id option) ok = return @@ Some(gid) -let get_glyph_id_exn (dcdr : decoder) (uch : Uchar.t) : glyph_id option = - raise_if_err @@ get_glyph_id dcdr uch - - let of_per_mille = function | PerMille(x) -> Pdf.Integer(x) @@ -1804,10 +1789,6 @@ let make_dictionary (pdf : Pdf.t) (font : font) (dcdr : decoder) : Pdf.pdfobject | Type0(ty0font) -> Type0.to_pdfdict pdf ty0font dcdr -let make_dictionary_exn (pdf : Pdf.t) (font : font) (dcdr : decoder) : Pdf.pdfobject = - raise_if_err @@ make_dictionary pdf font dcdr - - let make_decoder (abspath : abs_path) (d : D.source) : decoder ok = let open ResultMonad in let* cmapsubtbl = get_cmap_subtable ~file_path:abspath d in @@ -1920,10 +1901,6 @@ let convert_to_ligatures (dcdr : decoder) (seglst : glyph_segment list) : (glyph aux Alist.empty segorglst -let convert_to_ligatures_exn (dcdr : decoder) (segs : glyph_segment list) : glyph_synthesis list = - raise_if_err @@ convert_to_ligatures dcdr segs - - let find_kerning (dcdr : decoder) (gidprev : glyph_id) (gid : glyph_id) : per_mille option = let kerntbl = dcdr.kerning_table in let gidorgprev = get_original_gid dcdr gidprev in @@ -2127,19 +2104,11 @@ let get_math_script_variant (md : math_decoder) (gid : glyph_id) : glyph_id ok = | Some(gidorg_ssty) -> intern_gid dcdr gidorg_ssty -let get_math_script_variant_exn (md : math_decoder) (gid : glyph_id) : glyph_id = - raise_if_err @@ get_math_script_variant md gid - - let get_math_glyph_id (md : math_decoder) (uch : Uchar.t) : (glyph_id option) ok = let dcdr = md.as_normal_font in get_glyph_id dcdr uch -let get_math_glyph_id_exn (md : math_decoder) (uch : Uchar.t) : glyph_id option = - raise_if_err @@ get_math_glyph_id md uch - - let truncate_negative (PerMille(x)) = PerMille(max 0 x) @@ -2159,10 +2128,6 @@ let get_math_glyph_metrics (md : math_decoder) (gid : glyph_id) : metrics ok = return (wid, hgt, dpt) -let get_math_glyph_metrics_exn (md : math_decoder) (gid : glyph_id) : metrics = - raise_if_err @@ get_math_glyph_metrics md gid - - let get_math_correction_metrics (md : math_decoder) (gid : glyph_id) : per_mille option * math_kern_info option = let gidorg = get_original_gid md.as_normal_font gid in let micopt = md.math_italics_correction |> MathInfoMap.find_opt gidorg in @@ -2190,19 +2155,11 @@ let get_math_vertical_variants (md : math_decoder) (gid : glyph_id) : ((glyph_id mvertvarmap |> get_math_variants md gid -let get_math_vertical_variants_exn (md : math_decoder) (gid : glyph_id) : (glyph_id * float) list = - raise_if_err @@ get_math_vertical_variants md gid - - let get_math_horizontal_variants (md : math_decoder) (gid : glyph_id) = let mhorzvarmap = md.math_horizontal_variants in mhorzvarmap |> get_math_variants md gid -let get_math_horizontal_variants_exn (md : math_decoder) (gid : glyph_id) : (glyph_id * float) list = - raise_if_err @@ get_math_horizontal_variants md gid - - type math_constants = { (* General: *) axis_height : float; diff --git a/src/backend/fontFormat.mli b/src/backend/fontFormat.mli index d44374453..bebe9038d 100644 --- a/src/backend/fontFormat.mli +++ b/src/backend/fontFormat.mli @@ -2,7 +2,7 @@ open MyUtil open FontError -exception FontError of font_error +type 'a ok = ('a, font_error) result type glyph_id @@ -36,17 +36,17 @@ type cmap = type font -val make_dictionary_exn : Pdf.t -> font -> decoder -> Pdf.pdfobject +val make_dictionary : Pdf.t -> font -> decoder -> Pdf.pdfobject ok -val get_decoder_single : abs_path -> (decoder * font, font_error) result +val get_decoder_single : abs_path -> (decoder * font) ok -val get_decoder_ttc : abs_path -> int -> (decoder * font, font_error) result +val get_decoder_ttc : abs_path -> int -> (decoder * font) ok -val get_glyph_metrics_exn : decoder -> glyph_id -> metrics +val get_glyph_metrics : decoder -> glyph_id -> metrics ok -val get_glyph_id_exn : decoder -> Uchar.t -> glyph_id option +val get_glyph_id : decoder -> Uchar.t -> (glyph_id option) ok -val convert_to_ligatures_exn : decoder -> glyph_segment list -> glyph_synthesis list +val convert_to_ligatures : decoder -> glyph_segment list -> (glyph_synthesis list) ok val find_kerning : decoder -> glyph_id -> glyph_id -> per_mille option @@ -62,23 +62,23 @@ type math_kern_info = type math_decoder -val get_math_decoder_single : abs_path -> (math_decoder * font, font_error) result +val get_math_decoder_single : abs_path -> (math_decoder * font) ok -val get_math_decoder_ttc : abs_path -> int -> (math_decoder * font, font_error) result +val get_math_decoder_ttc : abs_path -> int -> (math_decoder * font) ok val math_base_font : math_decoder -> decoder -val get_math_glyph_id_exn : math_decoder -> Uchar.t -> glyph_id option +val get_math_glyph_id : math_decoder -> Uchar.t -> (glyph_id option) ok -val get_math_script_variant_exn : math_decoder -> glyph_id -> glyph_id +val get_math_script_variant : math_decoder -> glyph_id -> (glyph_id) ok -val get_math_glyph_metrics_exn : math_decoder -> glyph_id -> metrics +val get_math_glyph_metrics : math_decoder -> glyph_id -> metrics ok val get_math_correction_metrics : math_decoder -> glyph_id -> per_mille option * math_kern_info option -val get_math_vertical_variants_exn : math_decoder -> glyph_id -> (glyph_id * float) list +val get_math_vertical_variants : math_decoder -> glyph_id -> ((glyph_id * float) list) ok -val get_math_horizontal_variants_exn : math_decoder -> glyph_id -> (glyph_id * float) list +val get_math_horizontal_variants : math_decoder -> glyph_id -> ((glyph_id * float) list) ok type math_constants = { diff --git a/src/frontend/fontInfo.ml b/src/frontend/fontInfo.ml index 8034bc6fa..a0ded393f 100644 --- a/src/frontend/fontInfo.ml +++ b/src/frontend/fontInfo.ml @@ -23,6 +23,11 @@ type font_definition = { } +let raise_if_err = function + | Ok(v) -> v + | Error(e) -> raise (FontInfoError(e)) + + let resolve_lib_file (relpath : lib_path) = Config.resolve_lib_file relpath |> Result.map_error (fun candidates -> CannotFindLibraryFileAsToFont(relpath, candidates)) @@ -174,7 +179,7 @@ let convert_gid_list (metricsf : FontFormat.glyph_id -> FontFormat.metrics) (dcd let get_glyph_id dcdr uch = - match FontFormat.get_glyph_id_exn dcdr uch with + match raise_if_err @@ FontFormat.get_glyph_id dcdr uch with | None -> (* TODO: fix this *) (* @@ -198,8 +203,10 @@ let get_metrics_of_word (hsinfo : horz_string_info) (uchseglst : uchar_segment l (gbase, gmarks) ) in - let gsynlst = FontFormat.convert_to_ligatures_exn dcdr gseglst in - let (_, otxt, (rawwid, rawhgt, rawdpt)) = convert_gid_list (FontFormat.get_glyph_metrics_exn dcdr) dcdr gsynlst in + let gsynlst = raise_if_err @@ FontFormat.convert_to_ligatures dcdr gseglst in + let (_, otxt, (rawwid, rawhgt, rawdpt)) = + convert_gid_list (fun gid -> raise_if_err @@ FontFormat.get_glyph_metrics dcdr gid) dcdr gsynlst + in let wid = f_skip rawwid in let hgtsub = f_skip rawhgt in let dptsub = f_skip rawdpt in @@ -340,7 +347,7 @@ let get_math_char_info (mathkey : math_key) ~(is_in_base_level : bool) ~(is_in_d let gidlst = uchlst |> List.map (fun uch -> let gidraw = - match FontFormat.get_math_glyph_id_exn md uch with + match raise_if_err @@ FontFormat.get_math_glyph_id md uch with | None -> (* Logging.warn_no_math_glyph mfabbrev uch; (* TODO: fix this *) @@ -354,11 +361,11 @@ let get_math_char_info (mathkey : math_key) ~(is_in_base_level : bool) ~(is_in_d if is_in_base_level then gidraw else - FontFormat.get_math_script_variant_exn md gidraw + raise_if_err @@ FontFormat.get_math_script_variant md gidraw in let gid = if is_in_display && is_big then - match FontFormat.get_math_vertical_variants_exn md gidsub with + match raise_if_err @@ FontFormat.get_math_vertical_variants md gidsub with | [] -> gidsub @@ -373,7 +380,10 @@ let get_math_char_info (mathkey : math_key) ~(is_in_base_level : bool) ~(is_in_d ) in let (gidligedlst, otxt, (rawwid, rawhgt, rawdpt)) = - convert_gid_list (FontFormat.get_math_glyph_metrics_exn md) (FontFormat.math_base_font md) gidlst + convert_gid_list + (fun gid -> raise_if_err @@ FontFormat.get_math_glyph_metrics md gid) + (FontFormat.math_base_font md) + gidlst in let (rawmicopt, rawmkiopt) = match List.rev gidligedlst with @@ -395,13 +405,13 @@ let get_font_dictionary (pdf : Pdf.t) : Pdf.pdfobject = let tag = dfn.font_tag in let font = dfn.font in let dcdr = dfn.decoder in - let obj = FontFormat.make_dictionary_exn pdf font dcdr in + let obj = raise_if_err @@ FontFormat.make_dictionary pdf font dcdr in (tag, obj) :: acc ) |> MathFontHashTable.fold (fun _ mfdfn acc -> let tag = mfdfn.math_font_tag in let font = mfdfn.math_font in let md = mfdfn.math_decoder in - let obj = FontFormat.make_dictionary_exn pdf font (FontFormat.math_base_font md) in + let obj = raise_if_err @@ FontFormat.make_dictionary pdf font (FontFormat.math_base_font md) in (tag, obj) :: acc ) in diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 4d0bb5124..8bf53500b 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1164,9 +1164,6 @@ let error_log_environment (suspended : unit -> unit) : unit = | FontInfo.FontInfoError(e) -> report_font_error e - | FontFormat.FontError(e) -> - report_font_error e - | ImageHashTable.CannotLoadPdf(msg, abspath, pageno) -> let fname = convert_abs_path_to_show abspath in report_error Interface [ From 2f6479b717b1c478efb4348b2750b910f16312ac Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 13 Nov 2022 05:25:33 +0900 Subject: [PATCH 151/288] cosmetic changes --- src/backend/fontFormat.mli | 76 +++++++++++++++++++------------------- src/frontend/fontInfo.mli | 13 +++++-- 2 files changed, 47 insertions(+), 42 deletions(-) diff --git a/src/backend/fontFormat.mli b/src/backend/fontFormat.mli index bebe9038d..a3e7caefd 100644 --- a/src/backend/fontFormat.mli +++ b/src/backend/fontFormat.mli @@ -31,7 +31,7 @@ type 'a resource = type cmap = | PredefinedCMap of string (* - | CMapFile of (string resource) ref (* temporary;*) + | CMapFile of (string resource) ref (* TODO *) *) type font @@ -52,13 +52,12 @@ val find_kerning : decoder -> glyph_id -> glyph_id -> per_mille option type math_kern -type math_kern_info = - { - kernTR : math_kern; - kernTL : math_kern; - kernBR : math_kern; - kernBL : math_kern; - } +type math_kern_info = { + kernTR : math_kern; + kernTL : math_kern; + kernBR : math_kern; + kernBL : math_kern; +} type math_decoder @@ -80,37 +79,36 @@ val get_math_vertical_variants : math_decoder -> glyph_id -> ((glyph_id * float) val get_math_horizontal_variants : math_decoder -> glyph_id -> ((glyph_id * float) list) ok -type math_constants = - { - (* -- general -- *) - axis_height : float; - (* -- sub/superscripts -- *) - superscript_bottom_min : float; - superscript_shift_up : float; - superscript_baseline_drop_max : float; - subscript_top_max : float; - subscript_shift_down : float; - subscript_baseline_drop_min : float; - script_scale_down : float; - script_script_scale_down : float; - space_after_script : float; - sub_superscript_gap_min : float; - (* -- fractions -- *) - fraction_rule_thickness : float; - fraction_numer_d_shift_up : float; - fraction_numer_d_gap_min : float; - fraction_denom_d_shift_down : float; - fraction_denom_d_gap_min : float; - (* -- radicals -- *) - radical_extra_ascender : float; - radical_rule_thickness : float; - radical_d_vertical_gap : float; - (* -- limits -- *) - upper_limit_gap_min : float; - upper_limit_baseline_rise_min : float; - lower_limit_gap_min : float; - lower_limit_baseline_drop_min : float; - } +type math_constants = { +(* General: *) + axis_height : float; +(* Sub/superscripts: *) + superscript_bottom_min : float; + superscript_shift_up : float; + superscript_baseline_drop_max : float; + subscript_top_max : float; + subscript_shift_down : float; + subscript_baseline_drop_min : float; + script_scale_down : float; + script_script_scale_down : float; + space_after_script : float; + sub_superscript_gap_min : float; +(* Fractions: *) + fraction_rule_thickness : float; + fraction_numer_d_shift_up : float; + fraction_numer_d_gap_min : float; + fraction_denom_d_shift_down : float; + fraction_denom_d_gap_min : float; +(* Radicals: *) + radical_extra_ascender : float; + radical_rule_thickness : float; + radical_d_vertical_gap : float; +(* Limits: *) + upper_limit_gap_min : float; + upper_limit_baseline_rise_min : float; + lower_limit_gap_min : float; + lower_limit_baseline_drop_min : float; +} val get_axis_height_ratio : math_decoder -> float diff --git a/src/frontend/fontInfo.mli b/src/frontend/fontInfo.mli index 24d235efa..90a09c5f3 100644 --- a/src/frontend/fontInfo.mli +++ b/src/frontend/fontInfo.mli @@ -19,13 +19,20 @@ val add_single : abs_path -> key val add_ttc : abs_path -> int -> key -val add_math_single : abs_path -> key +val add_math_single : abs_path -> math_key -val add_math_ttc : abs_path -> int -> key +val add_math_ttc : abs_path -> int -> math_key val get_metrics_of_word : horz_string_info -> uchar_segment list -> OutputText.t * length * length * length -val get_math_char_info : math_key -> is_in_base_level:bool -> is_in_display:bool -> is_big:bool -> font_size:length -> Uchar.t list -> OutputText.t * length * length * length * length * FontFormat.math_kern_info option +val get_math_char_info : + math_key -> + is_in_base_level:bool -> + is_in_display:bool -> + is_big:bool -> + font_size:length -> + Uchar.t list -> + OutputText.t * length * length * length * length * FontFormat.math_kern_info option val get_font_tag : key -> tag From a8b54e4effa1f2c562591da1e5df4f281e2ea7f8 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 13 Nov 2022 06:15:50 +0900 Subject: [PATCH 152/288] add 'logging.mli' etc. --- src/backend/fontFormat.ml | 4 +++ src/backend/fontFormat.mli | 2 ++ src/frontend/fontInfo.ml | 12 +++---- src/frontend/logging.ml | 70 ++++++-------------------------------- src/frontend/logging.mli | 63 ++++++++++++++++++++++++++++++++++ src/frontend/main.ml | 2 +- tools/gencode/vminst.ml | 16 +-------- 7 files changed, 86 insertions(+), 83 deletions(-) create mode 100644 src/frontend/logging.mli diff --git a/src/backend/fontFormat.ml b/src/backend/fontFormat.ml index 07736ccb0..5d5039aac 100644 --- a/src/backend/fontFormat.ml +++ b/src/backend/fontFormat.ml @@ -1043,6 +1043,10 @@ type decoder = { } +let postscript_name (dcdr : decoder) : string = + dcdr.postscript_name + + let get_original_gid (_dcdr : decoder) (gid : glyph_id) : original_glyph_id = let SubsetGlyphID(gidorg, _) = gid in gidorg diff --git a/src/backend/fontFormat.mli b/src/backend/fontFormat.mli index a3e7caefd..8b5deb71f 100644 --- a/src/backend/fontFormat.mli +++ b/src/backend/fontFormat.mli @@ -24,6 +24,8 @@ val hex_of_glyph_id : glyph_id -> string type decoder +val postscript_name : decoder -> string + type 'a resource = | Data of 'a | EmbeddedStream of int diff --git a/src/frontend/fontInfo.ml b/src/frontend/fontInfo.ml index a0ded393f..12185e08f 100644 --- a/src/frontend/fontInfo.ml +++ b/src/frontend/fontInfo.ml @@ -178,13 +178,10 @@ let convert_gid_list (metricsf : FontFormat.glyph_id -> FontFormat.metrics) (dcd (gsynlst |> List.map (fun (gid, _) -> gid) (* temporary *), otxt, (FontFormat.PerMille(rawwid), FontFormat.PerMille(rawhgt), FontFormat.PerMille(rawdpt))) -let get_glyph_id dcdr uch = +let get_glyph_id (dcdr : FontFormat.decoder) (uch : Uchar.t) = match raise_if_err @@ FontFormat.get_glyph_id dcdr uch with | None -> - (* TODO: fix this *) -(* - Logging.warn_no_glyph font_abbrev uch; -*) + Logging.warn_no_glyph (FontFormat.postscript_name dcdr) uch; FontFormat.notdef | Some(gid) -> @@ -349,9 +346,8 @@ let get_math_char_info (mathkey : math_key) ~(is_in_base_level : bool) ~(is_in_d let gidraw = match raise_if_err @@ FontFormat.get_math_glyph_id md uch with | None -> -(* - Logging.warn_no_math_glyph mfabbrev uch; (* TODO: fix this *) -*) + let fontname = FontFormat.postscript_name (FontFormat.math_base_font md) in + Logging.warn_no_math_glyph fontname uch; FontFormat.notdef | Some(gid) -> diff --git a/src/frontend/logging.ml b/src/frontend/logging.ml index 9008768bf..d9dc6b0bc 100644 --- a/src/frontend/logging.ml +++ b/src/frontend/logging.ml @@ -84,18 +84,13 @@ let end_output file_name_out = print_endline (" output written on '" ^ (show_path file_name_out) ^ "'.") -let no_output () = - print_endline " ---- ---- ---- ----"; - print_endline " no output." - - let target_file file_name_out = print_endline (" ---- ---- ---- ----"); print_endline (" target file: '" ^ (show_path file_name_out) ^ "'") -let dump_file dump_file_exists dump_file = - if dump_file_exists then +let dump_file ~(already_exists : bool) dump_file = + if already_exists then print_endline (" dump file: '" ^ (show_path dump_file) ^ "' (already exists)") else print_endline (" dump file: '" ^ (show_path dump_file) ^ "' (will be created)") @@ -140,72 +135,29 @@ let end_lock_output file_name_out = print_endline (" output written on '" ^ (show_path file_name_out) ^ "'.") - -let show_single_font abbrev relpath = - print_endline (" * `" ^ abbrev ^ "`: '" ^ (get_lib_path_string relpath) ^ "'") - - -let show_collection_font abbrev relpath i = - print_endline (" * `" ^ abbrev ^ "`: '" ^ (get_lib_path_string relpath) ^ "' [" ^ (string_of_int i) ^ "]") - - -let show_fonts_main font_hash = - font_hash |> List.iter (fun (abbrev, data) -> - match data with - | FontAccess.Single(relpath) -> show_single_font abbrev relpath - | FontAccess.Collection(relpath, i) -> show_collection_font abbrev relpath i - ) - - -let show_fonts font_hash = - print_endline " all the available fonts:"; - show_fonts_main font_hash - - -let show_math_fonts font_hash = - print_endline " all the available math fonts:"; - show_fonts_main font_hash - - -let warn_deprecated msg = - print_endline (" [Warning] " ^ msg) - - let warn_cmyk_image file_name = print_endline (" [Warning] (" ^ (show_path file_name) ^ ") Jpeg images with CMYK color mode are not fully supported."); print_endline (" Please convert the image to a jpeg image with YCbCr (RGB) color model.") -let warn_math_script_without_brace rng = - Format.printf " [Warning] at %s: math script without brace.\n" (Range.to_string rng) - +let warn_noninjective_cmap (uch1 : Uchar.t) (uch2 : Uchar.t) (gidorg : Otfed.Value.glyph_id) = + Format.printf " [Warning] Multiple Unicode code points (U+%04X and U+%04X) are mapped to the same GID %d.\n" (Uchar.to_int uch1) (Uchar.to_int uch2) gidorg -let warn_noninjective_cmap uchpre uch gidorg = - Format.printf " [Warning] Multiple Unicode code points (U+%04X and U+%04X) are mapped to the same GID %d.\n" (Uchar.to_int uchpre) (Uchar.to_int uch) gidorg +let warn_noninjective_ligature (gidorg_lig : Otfed.Value.glyph_id) = + Format.printf " [Warning] GID %d is used as more than one kind of ligatures.\n" gidorg_lig -let warn_noninjective_ligature gidorglig = - Format.printf " [Warning] GID %d is used as more than one kind of ligatures.\n" gidorglig - -let warn_nonattachable_mark gomark gobase = +let warn_nonattachable_mark (gomark : Otfed.Value.glyph_id) (gobase : Otfed.Value.glyph_id) = Format.printf " [Warning] The combining diacritical mark of GID %d cannot be attached to the base glyph of GID %d.\n" gomark gobase -let warn_no_glyph abbrev uch = - Format.printf " [Warning] No glyph is provided for U+%04X by font `%s`.\n" (Uchar.to_int uch) abbrev - - -let warn_no_math_glyph mfabbrev uch = - Format.printf " [Warning] No glyph is provided for U+%04X by math font `%s`.\n" (Uchar.to_int uch) mfabbrev - - -let warn_duplicate_font_hash abbrev relpath = - Format.printf " [Warning] more than one font is named `%s`; '%s' will be associated with the font name.\n" abbrev (get_lib_path_string relpath) +let warn_no_glyph (fontname : string) (uch : Uchar.t) = + Format.printf " [Warning] No glyph is provided for U+%04X by font `%s`.\n" (Uchar.to_int uch) fontname -let warn_duplicate_math_font_hash mfabbrev relpath = - Format.printf " [Warning] more than one font is named `%s`; '%s' will be associated with the font name.\n" mfabbrev (get_lib_path_string relpath) +let warn_no_math_glyph (fontname : string) (uch : Uchar.t) = + Format.printf " [Warning] No glyph is provided for U+%04X by math font `%s`.\n" (Uchar.to_int uch) fontname let warn_number_sign_end rng = diff --git a/src/frontend/logging.mli b/src/frontend/logging.mli new file mode 100644 index 000000000..7f3427371 --- /dev/null +++ b/src/frontend/logging.mli @@ -0,0 +1,63 @@ + +open MyUtil +open PackageSystemBase + +val begin_to_typecheck_file : abs_path -> unit + +val begin_to_preprocess_file : abs_path -> unit + +val begin_to_eval_file : abs_path -> unit + +val begin_to_parse_file : abs_path -> unit + +val pass_type_check : string option -> unit + +val start_evaluation : int -> unit + +val end_evaluation : unit -> unit + +val start_page_break : unit -> unit + +val achieve_count_max : unit -> unit + +val achieve_fixpoint : string list -> unit + +val end_output : abs_path -> unit + +val target_file : abs_path -> unit + +val dump_file : already_exists:bool -> abs_path -> unit + +val lock_config_file : abs_path -> unit + +val show_package_dependency_before_solving : package_dependency list -> unit + +val show_package_dependency_solutions : package_solution list -> unit + +val begin_to_embed_fonts : unit -> unit + +val begin_to_write_page : unit -> unit + +val needs_another_trial : unit -> unit + +val end_lock_output : abs_path -> unit + +val warn_noninjective_cmap : Uchar.t -> Uchar.t -> Otfed.Value.glyph_id -> unit + +val warn_noninjective_ligature : Otfed.Value.glyph_id -> unit + +val warn_nonattachable_mark : Otfed.Value.glyph_id -> Otfed.Value.glyph_id -> unit + +val warn_no_glyph : string -> Uchar.t -> unit + +val warn_no_math_glyph : string -> Uchar.t -> unit + +val warn_cmyk_image : abs_path -> unit + +val warn_number_sign_end : Range.t -> unit + +val warn_overfull_line : int -> unit + +val warn_underfull_line : int -> unit + +val warn_unreachable : int -> unit diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 8bf53500b..c40d2ec20 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1485,7 +1485,7 @@ let build Logging.target_file abspath_out; let dump_file_exists = CrossRef.initialize abspath_dump in - Logging.dump_file dump_file_exists abspath_dump; + Logging.dump_file ~already_exists:dump_file_exists abspath_dump; (* Resolve dependency of the document and the local source files: *) let (_dep_main_module_names, sorted_locals, utdoc) = diff --git a/tools/gencode/vminst.ml b/tools/gencode/vminst.ml index cef4aa80d..0192538e9 100644 --- a/tools/gencode/vminst.ml +++ b/tools/gencode/vminst.ml @@ -273,7 +273,7 @@ make_math_boxes [ MathBoxFraction{ context = ictx; numerator = ms1; denominator ~is_text_mode_primitive:true ~code:{| let degree = get_option get_math_boxes value1mopt in -let radical = Primitives.default_radical in (* temporary; should be changeable *) +let radical = Primitives.default_radical in (* TODO: make this changeable *) make_math_boxes [ MathBoxRadical{ context; radical; degree; inner } ] |} ; inst "PrimitiveMathParen" @@ -937,20 +937,6 @@ make_text_mode_context (tctx, tctxsub) let width = ctx.HorzBox.paragraph_width in make_inline_boxes [ HorzEmbeddedVertBreakable{ width; contents } ] |} -(* - ; inst "PrimitiveFont" - ~fields:[ - ] - ~params:[ - param "abbrev" ~type_:"string"; - param "size_ratio" ~type_:"float"; - param "rising_ratio" ~type_:"float"; - ] - ~is_pdf_mode_primitive:true - ~code:{| -make_font_value (abbrev, size_ratio, rising_ratio) -|} -*) ; inst "PrimitiveLineBreak" ~name:"line-break" ~type_:Type.(tB @-> tB @-> tCTX @-> tIB @-> tBB) From 9d4568d60668b4245fcde004696554165edcc024 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sun, 13 Nov 2022 06:31:22 +0900 Subject: [PATCH 153/288] use '{,Math}FontIsNotSet' --- src/backend/horzBox.ml | 9 +++++++-- src/chardecoder/charBasis.ml | 6 +++--- src/frontend/context.ml | 4 +--- src/frontend/main.ml | 12 ++++++++++++ 4 files changed, 23 insertions(+), 8 deletions(-) diff --git a/src/backend/horzBox.ml b/src/backend/horzBox.ml index 5e7262ee8..81c4168e1 100644 --- a/src/backend/horzBox.ml +++ b/src/backend/horzBox.ml @@ -4,7 +4,12 @@ open LengthInterface open GraphicBase -exception NoFontIsSet of CharBasis.script * CharBasis.script +exception FontIsNotSet of { + raw : CharBasis.script; + normalized : CharBasis.script; +} + +exception MathFontIsNotSet type pure_badness = int @@ -518,7 +523,7 @@ let normalize_script ctx script_raw = let get_font_with_ratio ctx script_raw = let script = normalize_script ctx script_raw in match ctx.font_scheme |> CharBasis.ScriptSchemeMap.find_opt script with - | None -> raise (NoFontIsSet(script_raw, script)) + | None -> raise (FontIsNotSet{ raw = script_raw; normalized = script }) | Some(fontsch) -> fontsch diff --git a/src/chardecoder/charBasis.ml b/src/chardecoder/charBasis.ml index 93a4ce759..aa93f3d21 100644 --- a/src/chardecoder/charBasis.ml +++ b/src/chardecoder/charBasis.ml @@ -41,7 +41,6 @@ type east_asian_width = | EAWNeutral -(* for debug *) let show_script = function | CommonNarrow -> "Common (narrow)" | CommonWide -> "Common (wide)" @@ -51,8 +50,9 @@ let show_script = function | Latin -> "Latin" | OtherScript -> "Other" -(* for debug *) -let pp_script fmt script = Format.fprintf fmt "%s" (show_script script) + +let pp_script fmt script = + Format.fprintf fmt "%s" (show_script script) type language_system = diff --git a/src/frontend/context.ml b/src/frontend/context.ml index 0c49177ce..4df3d43c7 100644 --- a/src/frontend/context.ml +++ b/src/frontend/context.ml @@ -3,8 +3,6 @@ open Types open LengthInterface -exception MathFontIsNotSet - type t = input_context @@ -44,7 +42,7 @@ let font_size ((ctx, _) : t) = let math_font_key_exn ((ctx, _) : t) = match ctx.math_font_key with - | None -> raise MathFontIsNotSet + | None -> raise HorzBox.MathFontIsNotSet | Some(mathkey) -> mathkey diff --git a/src/frontend/main.ml b/src/frontend/main.ml index c40d2ec20..7d411723b 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1158,6 +1158,18 @@ let error_log_environment (suspended : unit -> unit) : unit = NormalLine("invalid string for hyphenation pattern."); ] + | HorzBox.FontIsNotSet{ raw; normalized } -> + report_error Interface [ + NormalLine("font is not set;"); + DisplayLine(Printf.sprintf "- raw script: %s" (CharBasis.show_script raw)); + DisplayLine(Printf.sprintf "- normalized script: %s" (CharBasis.show_script normalized)); + ] + + | HorzBox.MathFontIsNotSet -> + report_error Interface [ + NormalLine("math font is not set."); + ] + | ConfigError(e) -> report_config_error e From e450f24c2a45c89c8afe974760025b0225c51c5a Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 14 Nov 2022 23:15:59 +0900 Subject: [PATCH 154/288] add 'conversion' section to the format of 'satysfi.yaml' --- .../packages/md-ja/md-ja.0.0.1/satysfi.yaml | 76 ++++++--- src/frontend/configError.ml | 5 + src/frontend/main.ml | 3 + src/frontend/packageConfig.ml | 144 ++++++++++++++++++ src/frontend/packageConfig.mli | 4 + 5 files changed, 211 insertions(+), 21 deletions(-) diff --git a/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml index 9b893fea8..dc4e2cea0 100644 --- a/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml @@ -3,25 +3,59 @@ contents: type: "library" main_module: "MDJa" source_directories: - - "./src" + - "./src" dependencies: - - name: "stdlib" - requirements: [ "0.0.1" ] - - name: "math" - requirements: [ "0.0.1" ] - - name: "annot" - requirements: [ "0.0.1" ] - - name: "code" - requirements: [ "0.0.1" ] - - name: "footnote-scheme" - requirements: [ "0.0.1" ] - - name: "itemize" - requirements: [ "0.0.1" ] - - name: "font-junicode" - requirements: [ "0.0.1" ] - - name: "font-latin-modern" - requirements: [ "0.0.1" ] - - name: "font-ipa-ex" - requirements: [ "0.0.1" ] - - name: "font-latin-modern-math" - requirements: [ "0.0.1" ] + - name: "stdlib" + requirements: [ "0.0.1" ] + - name: "math" + requirements: [ "0.0.1" ] + - name: "annot" + requirements: [ "0.0.1" ] + - name: "code" + requirements: [ "0.0.1" ] + - name: "footnote-scheme" + requirements: [ "0.0.1" ] + - name: "itemize" + requirements: [ "0.0.1" ] + - name: "font-junicode" + requirements: [ "0.0.1" ] + - name: "font-latin-modern" + requirements: [ "0.0.1" ] + - name: "font-ipa-ex" + requirements: [ "0.0.1" ] + - name: "font-latin-modern-math" + requirements: [ "0.0.1" ] + conversion: + - type: "markdown" + document: "MDJa.document" + default_header: "(| title = {}, author = {} |)" + paragraph: "+MDJa.p" + hr: "+MDJa.hr" + h1: "+MDJa.h1" + h2: "+MDJa.h2" + h3: "+MDJa.h3" + h4: "+MDJa.h4" + h5: "+MDJa.h5" + h6: "+MDJa.h6" + ul_inline: "+MDJa.ul" + ul_block: "+MDJa.ul-block" + ol_inline: "+MDJa.ol" + ol_block: "+MDJa.ol-block" + code_block: + - name: "console" + command: "+MDJa.console" + default_code_block: "+MDJa.code" + blockquote: "+MDJa.quote" + error_block: "+MDJa.error" + + emph: "\\MDJa.emph" + bold: "\\MDJa.bold" + hard_break: + type: "none" + code: [] + default_code: "\\MDJa.code" + url: "\\MDJa.link" + reference: "\\MDJa.reference" + img: "\\MDJa.img" + embed_block: "\\MDJa.embed-block" + error_inline: "\\MDJa.error" diff --git a/src/frontend/configError.ml b/src/frontend/configError.ml index ac196ec67..147fcff7c 100644 --- a/src/frontend/configError.ml +++ b/src/frontend/configError.ml @@ -18,6 +18,11 @@ type yaml_error = context : YamlDecoder.context; package_name : string; } + | NotACommand of { + context : YamlDecoder.context; + prefix : char; + string : string; + } module YamlError = struct type t = yaml_error diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 7d411723b..2eee54e6f 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -820,6 +820,9 @@ let make_yaml_error_lines : yaml_error -> line list = function | MultiplePackageDefinition{ context = yctx; package_name } -> [ NormalLine(Printf.sprintf "More than one definition for package '%s'%s" package_name (show_yaml_context yctx)) ] + | NotACommand{ context = yctx; prefix = _; string = s } -> + [ NormalLine(Printf.sprintf "not a command: '%s'%s" s (show_yaml_context yctx)) ] + let report_document_attribute_error : DocumentAttribute.error -> unit = function | MoreThanOneDependencyAttribute(rng1, rng2) -> diff --git a/src/frontend/packageConfig.ml b/src/frontend/packageConfig.ml index 7bf143efa..789bfe741 100644 --- a/src/frontend/packageConfig.ml +++ b/src/frontend/packageConfig.ml @@ -16,11 +16,15 @@ type font_file_description = { used_as_math_font : bool; } +type package_conversion_spec = + | MarkdownConversion of DecodeMD.command_record + type package_contents = | Library of { main_module_name : module_name; source_directories : relative_path list; dependencies : package_dependency list; + conversion_specs : package_conversion_spec list; } | Font of { main_module_name : module_name; @@ -61,6 +65,144 @@ let font_file_description_decoder : font_file_description ConfigDecoder.t = } +let cut_module_names (s : string) : string list * string = + match List.rev (String.split_on_char '.' s) with + | varnm :: modnms_rev -> (List.rev modnms_rev, varnm) + | _ -> assert false (* `String.split_on_char` always returns a non-empty list *) + + +let command_decoder ~(prefix : char) : DecodeMD.command ConfigDecoder.t = + let open ConfigDecoder in + string >>= fun s -> + try + if Char.equal prefix (String.get s 0) then + let s_tail = (String.sub s 1 (String.length s - 1)) in + let (modnms, varnm) = cut_module_names s_tail in + succeed (Range.dummy "command_decoder", (modnms, varnm)) + else + failure (fun context -> NotACommand{ context; prefix; string = s }) + with + | Invalid_argument(_) -> + failure (fun context -> NotACommand{ context; prefix; string = s }) + + +let inline_command_decoder = + command_decoder ~prefix:'\\' + + +let block_command_decoder = + command_decoder ~prefix:'+' + + +let identifier_decoder : DecodeMD.command ConfigDecoder.t = + let open ConfigDecoder in + string >>= fun s -> + let (modnms, varnm) = cut_module_names s in + succeed (Range.dummy "identifier_decoder", (modnms, varnm)) + + +let hard_break_decoder : (DecodeMD.command option) ConfigDecoder.t = + let open ConfigDecoder in + branch "type" [ + "none" ==> begin + succeed None + end; + "some" ==> begin + get "command" inline_command_decoder >>= fun command -> + succeed @@ Some(command) + end; + ] + ~other:(fun tag -> + failure (fun context -> UnexpectedTag(context, tag)) + ) + + +let code_block_entry_decoder : (string * DecodeMD.command) ConfigDecoder.t = + let open ConfigDecoder in + get "name" string >>= fun name -> + get "command" block_command_decoder >>= fun command -> + succeed (name, command) + + +let code_entry_decoder : (string * DecodeMD.command) ConfigDecoder.t = + let open ConfigDecoder in + get "name" string >>= fun name -> + get "command" inline_command_decoder >>= fun command -> + succeed (name, command) + + +let conversion_spec_decoder : package_conversion_spec ConfigDecoder.t = + let open ConfigDecoder in + branch "type" [ + "markdown" ==> begin + get "document" identifier_decoder >>= fun document -> + get "default_header" string >>= fun header_default -> + get "paragraph" block_command_decoder >>= fun paragraph -> + get "hr" block_command_decoder >>= fun hr -> + get "h1" block_command_decoder >>= fun h1 -> + get "h2" block_command_decoder >>= fun h2 -> + get "h3" block_command_decoder >>= fun h3 -> + get "h4" block_command_decoder >>= fun h4 -> + get "h5" block_command_decoder >>= fun h5 -> + get "h6" block_command_decoder >>= fun h6 -> + get "ul_inline" block_command_decoder >>= fun ul_inline -> + get "ul_block" block_command_decoder >>= fun ul_block -> + get "ol_inline" block_command_decoder >>= fun ol_inline -> + get "ol_block" block_command_decoder >>= fun ol_block -> + get_or_else "code_block" (list code_block_entry_decoder) [] >>= fun code_block_entries -> + get "default_code_block" block_command_decoder >>= fun code_block_default -> + get "blockquote" block_command_decoder >>= fun blockquote -> + get "error_block" block_command_decoder >>= fun err_block -> + get "emph" inline_command_decoder >>= fun emph -> + get "bold" inline_command_decoder >>= fun bold -> + get "hard_break" hard_break_decoder >>= fun hard_break -> + get_or_else "code" (list code_entry_decoder) [] >>= fun code_entries -> + get "default_code" inline_command_decoder >>= fun code_default -> + get "url" inline_command_decoder >>= fun url -> + get "reference" inline_command_decoder >>= fun reference -> + get "img" inline_command_decoder >>= fun img -> + get "embed_block" inline_command_decoder >>= fun embed_block -> + get "error_inline" inline_command_decoder >>= fun err_inline -> + let code_block_map = + code_block_entries |> List.fold_left (fun code_block_map (name, command) -> + code_block_map |> DecodeMD.CodeNameMap.add name command + ) DecodeMD.CodeNameMap.empty + in + let code_map = + code_entries |> List.fold_left (fun code_block_map (name, command) -> + code_block_map |> DecodeMD.CodeNameMap.add name command + ) DecodeMD.CodeNameMap.empty + in + succeed @@ MarkdownConversion(DecodeMD.{ + document; + header_default; + + paragraph; + hr; + h1; h2; h3; h4; h5; h6; + ul_inline; ul_block; + ol_inline; ol_block; + code_block_map; code_block_default; + blockquote; + err_block; + + emph; + bold; + hard_break; + code_map; code_default; + url; + reference; + img; + embed_block; + err_inline; + }) + end; + ] + ~other:(fun tag -> + failure (fun context -> UnexpectedTag(context, tag)) + ) + + let contents_decoder : package_contents ConfigDecoder.t = let open ConfigDecoder in branch "type" [ @@ -68,10 +210,12 @@ let contents_decoder : package_contents ConfigDecoder.t = get "main_module" string >>= fun main_module_name -> get "source_directories" (list string) >>= fun source_directories -> get_or_else "dependencies" (list dependency_decoder) [] >>= fun dependencies -> + get_or_else "conversion" (list conversion_spec_decoder) [] >>= fun conversion_specs -> succeed @@ Library { main_module_name; source_directories; dependencies; + conversion_specs; } end; "font" ==> begin diff --git a/src/frontend/packageConfig.mli b/src/frontend/packageConfig.mli index 7c2ce2df6..15188776a 100644 --- a/src/frontend/packageConfig.mli +++ b/src/frontend/packageConfig.mli @@ -12,11 +12,15 @@ type font_file_description = { used_as_math_font : bool; } +type package_conversion_spec = + | MarkdownConversion of DecodeMD.command_record + type package_contents = | Library of { main_module_name : module_name; source_directories : relative_path list; dependencies : package_dependency list; + conversion_specs : package_conversion_spec list; } | Font of { main_module_name : module_name; From 865d7e48c24ce686cd2cd8e1e00474520dfb96f4 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 15 Nov 2022 01:57:26 +0900 Subject: [PATCH 155/288] migrate 'omd' from '1.3.1' to '2.0.0~alpha2' --- .../packages/md-ja/md-ja.0.0.1/satysfi.yaml | 1 - satysfi.opam | 2 +- src/frontend/loadMDSetting.ml | 6 - src/frontend/packageConfig.ml | 15 +- src/md/decodeMD.ml | 326 +++++++----------- src/md/decodeMD.mli | 1 - 6 files changed, 127 insertions(+), 224 deletions(-) diff --git a/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml index dc4e2cea0..d376f0441 100644 --- a/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml @@ -52,7 +52,6 @@ contents: bold: "\\MDJa.bold" hard_break: type: "none" - code: [] default_code: "\\MDJa.code" url: "\\MDJa.link" reference: "\\MDJa.reference" diff --git a/satysfi.opam b/satysfi.opam index feae54825..12e7662f0 100644 --- a/satysfi.opam +++ b/satysfi.opam @@ -35,7 +35,7 @@ depends: [ "re" {build} "uutf" "yojson-with-position" {= "1.4.2+satysfi"} - "omd" {< "2.0.0~"} + "omd" {>= "2.0.0~alpha" & < "3.0.0"} "ocamlgraph" "alcotest" {with-test & >= "1.4.0"} "yaml" {>= "2.1.0"} diff --git a/src/frontend/loadMDSetting.ml b/src/frontend/loadMDSetting.ml index 473e14bd9..a42d291a5 100644 --- a/src/frontend/loadMDSetting.ml +++ b/src/frontend/loadMDSetting.ml @@ -102,11 +102,6 @@ let read_assoc (assoc : MYU.assoc) = |> MYU.find "code-block" |> make_code_name_map pair_block in - let code assoc = - assoc - |> MYU.find "code" - |> make_code_name_map pair_inline - in let string k assoc = assoc |> MYU.find k @@ -137,7 +132,6 @@ let read_assoc (assoc : MYU.assoc) = emph = assoc |> inline "emph"; bold = assoc |> inline "bold"; hard_break = assoc |> inline_option "hard-break"; - code_map = assoc |> code; code_default = assoc |> inline "code-default"; url = assoc |> inline "url"; reference = assoc |> inline "reference"; diff --git a/src/frontend/packageConfig.ml b/src/frontend/packageConfig.ml index 789bfe741..95dad3864 100644 --- a/src/frontend/packageConfig.ml +++ b/src/frontend/packageConfig.ml @@ -124,13 +124,6 @@ let code_block_entry_decoder : (string * DecodeMD.command) ConfigDecoder.t = succeed (name, command) -let code_entry_decoder : (string * DecodeMD.command) ConfigDecoder.t = - let open ConfigDecoder in - get "name" string >>= fun name -> - get "command" inline_command_decoder >>= fun command -> - succeed (name, command) - - let conversion_spec_decoder : package_conversion_spec ConfigDecoder.t = let open ConfigDecoder in branch "type" [ @@ -156,7 +149,6 @@ let conversion_spec_decoder : package_conversion_spec ConfigDecoder.t = get "emph" inline_command_decoder >>= fun emph -> get "bold" inline_command_decoder >>= fun bold -> get "hard_break" hard_break_decoder >>= fun hard_break -> - get_or_else "code" (list code_entry_decoder) [] >>= fun code_entries -> get "default_code" inline_command_decoder >>= fun code_default -> get "url" inline_command_decoder >>= fun url -> get "reference" inline_command_decoder >>= fun reference -> @@ -168,11 +160,6 @@ let conversion_spec_decoder : package_conversion_spec ConfigDecoder.t = code_block_map |> DecodeMD.CodeNameMap.add name command ) DecodeMD.CodeNameMap.empty in - let code_map = - code_entries |> List.fold_left (fun code_block_map (name, command) -> - code_block_map |> DecodeMD.CodeNameMap.add name command - ) DecodeMD.CodeNameMap.empty - in succeed @@ MarkdownConversion(DecodeMD.{ document; header_default; @@ -189,7 +176,7 @@ let conversion_spec_decoder : package_conversion_spec ConfigDecoder.t = emph; bold; hard_break; - code_map; code_default; + code_default; url; reference; img; diff --git a/src/md/decodeMD.ml b/src/md/decodeMD.ml index ecfb4c65a..86ebb7fad 100644 --- a/src/md/decodeMD.ml +++ b/src/md/decodeMD.ml @@ -9,13 +9,10 @@ type block_element = | Section of section_level * inline * block | Paragraph of inline | UlBlock of block list - | UlInline of inline list | OlBlock of block list - | OlInline of inline list | Blockquote of block - | CodeBlock of Omd.name * string + | CodeBlock of string * string | Hr - | BlockRaw of string and block = block_element list @@ -24,157 +21,125 @@ and inline_element = | Text of string | Emph of inline | Bold of inline - | Code of Omd.name * string + | Code of string | Br | Url of string * inline * string - | Ref of string * string * (string * string) option | Img of string * string * string - | InlineRaw of string - | EmbeddedBlock of block and inline = inline_element list -type middle_record = { - pre_contents : Omd.t; - current_heading : Omd.t; - current_accumulated : Omd.element Alist.t; - accumulated : (inline * Omd.t) Alist.t; -} -type accumulator = - | Beginning of Omd.element Alist.t - | Middle of middle_record +let rec make_inline_of_element (oi : Omd.attributes Omd.inline) = + let single ilne = [ ilne ] in + match oi with + | Omd.Concat(_attr, ois) -> + make_inline ois + | Omd.Text(_attr, s) -> + single @@ Text(s) -let rec make_inline_of_element (mde : Omd.element) = - let single ilne = [ilne] in - let empty = [] in - match mde with - | Omd.H1(_) | Omd.H2(_) | Omd.H3(_) | Omd.H4(_) | Omd.H5(_) | Omd.H6(_) - -> assert false (* -- should be omitted by 'normalize_section' -- *) - - | Omd.Paragraph(_) - | Omd.Code_block(_) - | Omd.Html_block(_) - | Omd.Blockquote(_) - | Omd.Hr - | Omd.Ul(_) - | Omd.Ulp(_) - | Omd.Ol(_) - | Omd.Olp(_) - | Omd.Raw_block(_) -> - single @@ EmbeddedBlock(make_block_of_element mde) - - | Omd.Html_comment(_) -> - empty - - | Omd.Html(_) -> - failwith ("HTML; remains to be supported: " ^ Omd.to_text [mde]) - - | Omd.X(_) -> - failwith ("extension; remains to be supported: " ^ Omd.to_text [mde]) - - | Omd.Text(s) -> single @@ Text(s) - | Omd.Emph(md) -> single @@ Emph(make_inline md) - | Omd.Bold(md) -> single @@ Bold(make_inline md) - | Omd.Code(name, s) -> single @@ Code(name, s) - | Omd.Br -> single @@ Br - | Omd.NL -> single @@ Br - - | Omd.Url(href, md, title) -> - single @@ Url(href, make_inline md, title) - - | Omd.Ref(container, tag, display, _) -> - let refopt = container#get_ref tag in - single @@ Ref(tag, display, refopt) -(* - failwith (Printf.sprintf "Ref; remains to be supported: name='%s', s='%s'" name s) -*) + | Omd.Emph(_attr, oi) -> + single @@ Emph(make_inline_of_element oi) + + | Omd.Strong(_attr, oi) -> + single @@ Bold(make_inline_of_element oi) + + | Omd.Code(_attr, s) -> + single @@ Code(s) + + | Omd.Hard_break(_attr) -> + single @@ Br - | Omd.Img(alt, src, title) -> - single @@ Img(alt, src, title) + | Omd.Soft_break(_attr) -> + single @@ Br - | Omd.Img_ref(_, name, alt, _) -> - failwith (Printf.sprintf "Img_ref; remains to be supported: name='%s', alt='%s'" name alt) + | Omd.Link(_attr, { label; destination; title = title_opt }) -> + let title = title_opt |> Option.value ~default:"" in (* TODO *) + single @@ Url(destination, make_inline_of_element label, title) - | Omd.Raw(s) -> - single @@ InlineRaw(s) + | Omd.Image(_attr, { label = _; destination; title = title_opt }) -> + let alt = "" in (* TODO *) + let title = title_opt |> Option.value ~default:"" in (* TODO *) + single @@ Img(alt, destination, title) + | Omd.Html(_attr, _s) -> + failwith "make_inline_of_element, Omd.Html" -and make_inline (md : Omd.t) : inline = + +and make_inline (md : (Omd.attributes Omd.inline) list) : inline = md |> List.map make_inline_of_element |> List.concat -and make_block_of_element (mde : Omd.element) = - let single blke = [blke] in - let empty = [] in - match mde with - | Omd.H1(_) | Omd.H2(_) | Omd.H3(_) | Omd.H4(_) | Omd.H5(_) | Omd.H6(_) -> - Format.printf "!!!! %s\n" (Omd.to_text [mde]); +and make_block_of_element (ob : Omd.attributes Omd.block) : block = + let single blke = [ blke ] in + match ob with + | Omd.Paragraph(_attr, oi) -> + single @@ Paragraph(make_inline_of_element oi) + + | Omd.List(_attr, list_type, _list_spacing, obss) -> + begin + match list_type with + | Omd.Ordered(_n, _ch) -> (* TODO *) + single @@ OlBlock(obss |> List.map make_block) + + | Omd.Bullet(_ch) -> + single @@ UlBlock(obss |> List.map make_block) + end + + | Omd.Blockquote(_attr, obs) -> + single @@ Blockquote(make_block obs) + + | Omd.Thematic_break(_attr) -> + single @@ Hr + + | Omd.Heading(_attr, _level, _oi) -> assert false - (* -- should be omitted by 'normalize_section' -- *) - - | Omd.Text(_) - | Omd.Emph(_) - | Omd.Bold(_) - | Omd.Code(_) - | Omd.Url(_) - | Omd.Ref(_) - | Omd.Img(_) - | Omd.Img_ref(_) - | Omd.Raw(_) - | Omd.Html(_) -> - Format.printf "! [Warning] not a block: %s@," (Omd.to_text [mde]); - (* temporary; should warn in a more sophisticated manner *) - single @@ Paragraph(make_inline [mde]) - - | Omd.Br - | Omd.NL -> - empty - - | Omd.Html_comment(s) -> - Format.printf " [Comment] %s@," s; (* TEMPORARY *) - empty - - | Omd.Html_block(_) -> - failwith ("HTML block; remains to be supported: " ^ Omd.to_text [mde]) - - | Omd.X(_) -> - failwith ("extension; remains to be supported: " ^ Omd.to_text [mde]) - - | Omd.Paragraph(md) -> single @@ Paragraph(make_inline md) - | Omd.Ul(mds) -> single @@ UlInline(List.map make_inline mds) - | Omd.Ulp(mds) -> single @@ UlBlock(List.map make_block mds) - | Omd.Ol(mds) -> single @@ OlInline(List.map make_inline mds) - | Omd.Olp(mds) -> single @@ OlBlock(List.map make_block mds) - | Omd.Code_block(name, s) -> single @@ CodeBlock(name, s) - | Omd.Hr -> single @@ Hr - | Omd.Blockquote(md) -> single @@ Blockquote(make_block md) - | Omd.Raw_block(s) -> single @@ BlockRaw(s) - - -and make_block (md : Omd.t) : block = + (* Must be omitted by `normalize_section` *) + + | Omd.Code_block(_attr, name, s) -> + single @@ CodeBlock(name, s) + + | Omd.Html_block(_attr, _s) -> + failwith "make_block_of_element, Omd.Html_block" + + | Omd.Definition_list(_attr, _defs) -> + failwith "make_block_of_element, Omd.Definition_list" + + +and make_block (md : (Omd.attributes Omd.block) list) : block = md |> List.map make_block_of_element |> List.concat -let finish_section (midrcd : middle_record) : (inline * Omd.t) Alist.t = +type middle_record = { + pre_contents : (Omd.attributes Omd.block) list; + current_heading : inline; + current_accumulated : (Omd.attributes Omd.block) Alist.t; + accumulated : (inline * (Omd.attributes Omd.block) list) Alist.t; +} + +type accumulator = + | Beginning of (Omd.attributes Omd.block) Alist.t + | Middle of middle_record + + +let finish_section (midrcd : middle_record) : (inline * (Omd.attributes Omd.block) list) Alist.t = let inner = Alist.to_list midrcd.current_accumulated in - let pair = (make_inline midrcd.current_heading, inner) in + let pair = (midrcd.current_heading, inner) in Alist.extend midrcd.accumulated pair -let normalize_section nomf (md : Omd.t) = +let normalize_section (nomf : Omd.attributes Omd.block -> (Omd.attributes Omd.inline) option) (obs : (Omd.attributes Omd.block) list) = let acc = - md |> List.fold_left (fun acc mde -> - match nomf mde with + obs |> List.fold_left (fun acc ob -> + match nomf ob with | Some(heading) -> begin match acc with | Beginning(eacc) -> Middle{ pre_contents = Alist.to_list eacc; - current_heading = heading; + current_heading = make_inline_of_element heading; current_accumulated = Alist.empty; accumulated = Alist.empty; } @@ -183,7 +148,7 @@ let normalize_section nomf (md : Omd.t) = let mainacc = finish_section midrcd in Middle{ pre_contents = midrcd.pre_contents; - current_heading = heading; + current_heading = make_inline_of_element heading; current_accumulated = Alist.empty; accumulated = mainacc; } @@ -193,11 +158,11 @@ let normalize_section nomf (md : Omd.t) = begin match acc with | Beginning(eacc) -> - Beginning(Alist.extend eacc mde) + Beginning(Alist.extend eacc ob) | Middle(midrcd) -> Middle({ midrcd with - current_accumulated = Alist.extend midrcd.current_accumulated mde; + current_accumulated = Alist.extend midrcd.current_accumulated ob; }) end @@ -212,17 +177,28 @@ let normalize_section nomf (md : Omd.t) = (midrcd.pre_contents, Alist.to_list mainacc) -let normalize_h seclev nomf subf md = +let normalize_h (seclev : section_level) (nomf : Omd.attributes Omd.block -> (Omd.attributes Omd.inline) option) (subf : (Omd.attributes Omd.block) list -> block) md = let (pre, inner) = normalize_section nomf md in List.append (subf pre) (inner |> List.map (fun (heading, mdsub) -> Section(seclev, heading, subf mdsub))) -let normalize_h6 = normalize_h H6 (function Omd.H6(heading) -> Some(heading) | _ -> None) make_block -let normalize_h5 = normalize_h H5 (function Omd.H5(heading) -> Some(heading) | _ -> None) normalize_h6 -let normalize_h4 = normalize_h H4 (function Omd.H4(heading) -> Some(heading) | _ -> None) normalize_h5 -let normalize_h3 = normalize_h H3 (function Omd.H3(heading) -> Some(heading) | _ -> None) normalize_h4 -let normalize_h2 = normalize_h H2 (function Omd.H2(heading) -> Some(heading) | _ -> None) normalize_h3 -let normalize_h1 = normalize_h H1 (function Omd.H1(heading) -> Some(heading) | _ -> None) normalize_h2 +let normalize_h6 = + normalize_h H6 (function Omd.Heading(_, 6, oi_heading) -> Some(oi_heading) | _ -> None) make_block + +let normalize_h5 = + normalize_h H5 (function Omd.Heading(_, 5, heading) -> Some(heading) | _ -> None) normalize_h6 + +let normalize_h4 = + normalize_h H4 (function Omd.Heading(_, 4, heading) -> Some(heading) | _ -> None) normalize_h5 + +let normalize_h3 = + normalize_h H3 (function Omd.Heading(_, 3, heading) -> Some(heading) | _ -> None) normalize_h4 + +let normalize_h2 = + normalize_h H2 (function Omd.Heading(_, 2, heading) -> Some(heading) | _ -> None) normalize_h3 + +let normalize_h1 = + normalize_h H1 (function Omd.Heading(_, 1, heading) -> Some(heading) | _ -> None) normalize_h2 module CodeNameMap = Map.Make(String) @@ -254,7 +230,6 @@ type command_record = { emph : command; bold : command; hard_break : command option; - code_map : command CodeNameMap.t; code_default : command; url : command; reference : command; @@ -299,20 +274,8 @@ let rec convert_inline_element (cmdrcd : command_record) (ilne : inline_element) make_inline_application cmdrcd.bold [utastarg] - | Code(name, s) -> - let cmd = - if String.equal name "" then - cmdrcd.code_default - else - match cmdrcd.code_map |> CodeNameMap.find_opt name with - | None -> - Format.printf "! Warning: unknown name '%s' for inline code\n" name; - (* -- temporary; should warn in a more sophisticated manner -- *) - cmdrcd.code_default - - | Some(cmd) -> - cmd - in + | Code(s) -> + let cmd = cmdrcd.code_default in let utastarg = (dummy_range, UTStringConstant(s)) in make_inline_application cmd [utastarg] @@ -328,37 +291,12 @@ let rec convert_inline_element (cmdrcd : command_record) (ilne : inline_element) let utastarg2 = convert_inline cmdrcd iln in make_inline_application cmdrcd.url [utastarg1; utastarg2] - | Ref(tag, display, refopt) -> - let utastarg1 = (dummy_range, UTStringConstant(tag)) in - let utastarg2 = (dummy_range, UTStringConstant(display)) in - let utastarg3 = - match refopt with - | None -> - (dummy_range, UTConstructor([], "None", (dummy_range, UTUnitConstant))) - - | Some((title, url)) -> - let u1 = (dummy_range, UTStringConstant(title)) in - let u2 = (dummy_range, UTStringConstant(url)) in - let upair = (dummy_range, UTTuple(TupleList.make u1 u2 [])) in - (dummy_range, UTConstructor([], "Some", upair)) - - in - make_inline_application cmdrcd.reference [utastarg1; utastarg2; utastarg3] - | Img(alt, src, title) -> let utastarg1 = (dummy_range, UTStringConstant(alt)) in let utastarg2 = (dummy_range, UTStringConstant(src)) in let utastarg3 = (dummy_range, UTStringConstant(title)) in make_inline_application cmdrcd.img [utastarg1; utastarg2; utastarg3] - | EmbeddedBlock(blk) -> - let utastarg = convert_block cmdrcd blk in - make_inline_application cmdrcd.embed_block [utastarg] - - | InlineRaw(s) -> - let utastarg = (dummy_range, UTStringConstant(s)) in - make_inline_application cmdrcd.err_inline [utastarg] - and convert_inline (cmdrcd : command_record) (iln : inline) : untyped_abstract_tree = let ibacc = @@ -393,21 +331,11 @@ and convert_block_element (cmdrcd : command_record) (blke : block_element) : unt | Hr -> make_block_application cmdrcd.hr [] - | OlInline(ilns) -> - let utastlst = List.map (convert_inline cmdrcd) ilns in - let utastarg = make_list_tree utastlst in - make_block_application cmdrcd.ol_inline [utastarg] - | OlBlock(blks) -> let utastlst = List.map (convert_block cmdrcd) blks in let utastarg = make_list_tree utastlst in make_block_application cmdrcd.ol_block [utastarg] - | UlInline(ilns) -> - let utastlst = List.map (convert_inline cmdrcd) ilns in - let utastarg = make_list_tree utastlst in - make_block_application cmdrcd.ul_inline [utastarg] - | UlBlock(blks) -> let utastlst = List.map (convert_block cmdrcd) blks in let utastarg = make_list_tree utastlst in @@ -434,10 +362,6 @@ and convert_block_element (cmdrcd : command_record) (blke : block_element) : unt let utastarg = convert_block cmdrcd blk in make_block_application cmdrcd.blockquote [utastarg] - | BlockRaw(s) -> - let cmd = cmdrcd.err_block in - make_block_application cmd [ (dummy_range, UTInlineText([ (dummy_range, UTInlineTextString(s)) ])) ] - and convert_block (cmdrcd : command_record) (blk : block) : untyped_abstract_tree = let bbacc = @@ -455,24 +379,24 @@ let decode (cmdrcd : command_record) (s : string) = let modidents = modnms |> List.map (fun modnm -> (rng, modnm)) in (rng, UTContentOf(modidents, (rng, varnm))) in - let md = Omd.of_string s in + let obs = Omd.of_string s in let (strheader, md) = - match md with - | Omd.Html_comment(s) :: md -> - let len = String.length s in - let s = - if len < 8 then - assert false - else - String.sub s 4 (len - 8) - in -(* - Format.printf " [Header] %s@," s; (* for debug *) - *) - (s, md) + match obs with + | Omd.Paragraph(_attr1, Omd.Html(_attr2, s)) :: obs -> + if Core.String.is_prefix s ~prefix:"" then + let len = String.length s in + let s = + if len < 8 then + failwith "TODO (error): not a comment" + else + String.sub s 4 (len - 8) + in + (s, obs) + else + failwith "TODO (error): not a comment" | _ -> - (cmdrcd.header_default, md) + (cmdrcd.header_default, obs) in let utasthead = match ParserInterface.process_text "(markdown)" strheader with diff --git a/src/md/decodeMD.mli b/src/md/decodeMD.mli index 91bb59ace..de3bb724f 100644 --- a/src/md/decodeMD.mli +++ b/src/md/decodeMD.mli @@ -29,7 +29,6 @@ type command_record = { emph : command; bold : command; hard_break : command option; - code_map : command CodeNameMap.t; code_default : command; url : command; reference : command; From 153e8363de3560a2479cc2f3cd97c4f12e50a65d Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 15 Nov 2022 03:10:50 +0900 Subject: [PATCH 156/288] modify how to decode Markdown documents --- src/frontend/openFileDependencyResolver.ml | 31 +++----- src/md/decodeMD.ml | 93 +++++++++++++++------- src/md/decodeMD.mli | 6 +- 3 files changed, 79 insertions(+), 51 deletions(-) diff --git a/src/frontend/openFileDependencyResolver.ml b/src/frontend/openFileDependencyResolver.ml index 3d81e7843..7da18bc3c 100644 --- a/src/frontend/openFileDependencyResolver.ml +++ b/src/frontend/openFileDependencyResolver.ml @@ -106,32 +106,21 @@ let register_document_file (extensions : string list) (abspath_in : abs_path) : return (package_names, graph, utdoc) -let register_markdown_file (setting : string) (abspath_in : abs_path) : (PackageNameSet.t * untyped_document_file) ok = +let register_markdown_file (abspath_in : abs_path) : untyped_document_file ok = let open ResultMonad in Logging.begin_to_parse_file abspath_in; - let* abspath = - let libpath = make_lib_path (Filename.concat "dist/md" (setting ^ ".satysfi-md")) in - Config.resolve_lib_file libpath - |> Result.map_error (fun candidates -> CannotFindLibraryFile(libpath, candidates)) - in - let (cmdrcd, depends) = LoadMDSetting.main abspath in (* TODO: make this monadic *) - let* utast = + let* (_docattr, main_module_name, md) = match read_file abspath_in with - | Ok(data) -> return (DecodeMD.decode cmdrcd data) + | Ok(data) -> return (DecodeMD.decode data) | Error(msg) -> err (CannotReadFileOwingToSystem(msg)) in - let package_names = - depends |> List.fold_left (fun package_names main_module_name -> - package_names |> PackageNameSet.add main_module_name - ) PackageNameSet.empty - in + let cmdrcd = failwith "TODO: register_markdown_file, cmdrcd" in + let utast = DecodeMD.convert cmdrcd md in let header = - depends |> List.map (fun main_module_name -> - HeaderUsePackage{ opening = false; module_name = (Range.dummy "md-header", main_module_name) } - ) + [ HeaderUsePackage{ opening = false; module_name = (Range.dummy "md-header", main_module_name) } ] in let utdoc = ([], header, utast) in - return (package_names, utdoc) + return utdoc let main ~(extensions : string list) (abspath_in : abs_path) : (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file) ok = @@ -142,9 +131,9 @@ let main ~(extensions : string list) (abspath_in : abs_path) : (PackageNameSet.t let* (package_names, graph, utdoc) = register_document_file extensions abspath_in in return (package_names, graph, utdoc) - | OptionState.Markdown(setting) -> - let* (package_names, utdoc) = register_markdown_file setting abspath_in in - return (package_names, FileDependencyGraph.empty, utdoc) + | OptionState.Markdown(_settings) -> + let* utdoc = register_markdown_file abspath_in in + return (PackageNameSet.empty, FileDependencyGraph.empty, utdoc) in let* sorted_locals = FileDependencyGraph.topological_sort graph diff --git a/src/md/decodeMD.ml b/src/md/decodeMD.ml index 86ebb7fad..5d857d80a 100644 --- a/src/md/decodeMD.ml +++ b/src/md/decodeMD.ml @@ -373,39 +373,74 @@ and convert_block (cmdrcd : command_record) (blk : block) : untyped_abstract_tre (dummy_range, UTBlockText(utiv)) -let decode (cmdrcd : command_record) (s : string) = - let utastdoccmd = - let (rng, (modnms, varnm)) = cmdrcd.document in - let modidents = modnms |> List.map (fun modnm -> (rng, modnm)) in - (rng, UTContentOf(modidents, (rng, varnm))) - in +let extract_comment (s : string) : string option = + if Core.String.is_prefix s ~prefix:"" then + let len = String.length s in + if len < 8 then + None + else + Some(String.trim (String.sub s 4 (len - 8))) + else + None + + +let parse_expression (s_expr : string) : untyped_abstract_tree = + match ParserInterface.process_text "(markdown)" s_expr with + | Ok(UTDocumentFile([], [], utast)) -> utast + | _ -> failwith "TODO (error): invalid header expression" + + +type t = { + extra_expression : untyped_abstract_tree; + main_contents : block; +} + + +let decode (s : string) : DocumentAttribute.t * module_name * t = let obs = Omd.of_string s in - let (strheader, md) = + let (s_dependencies, modnm, s_extra, obs) = match obs with - | Omd.Paragraph(_attr1, Omd.Html(_attr2, s)) :: obs -> - if Core.String.is_prefix s ~prefix:"" then - let len = String.length s in - let s = - if len < 8 then + | Omd.Html_block(_attr1, s1) :: Omd.Html_block(_attr2, s2) :: Omd.Html_block(_attr3, s3) :: obs -> + begin + match (extract_comment s1, extract_comment s2, extract_comment s3) with + | (Some(s_dependencies), Some(modnm), Some(s_extra)) -> + (s_dependencies, modnm, s_extra, obs) + + | _ -> failwith "TODO (error): not a comment" - else - String.sub s 4 (len - 8) - in - (s, obs) - else - failwith "TODO (error): not a comment" + end | _ -> - (cmdrcd.header_default, obs) + failwith "TODO (error): not a comment" + in + let utast_dependencies = parse_expression s_dependencies in + let utast_extra = parse_expression s_extra in + let main_contents = normalize_h1 obs in + let document_attributes_res = + DocumentAttribute.make [ + (dummy_range, UTAttribute("dependencies", utast_dependencies)) + ] in - let utasthead = - match ParserInterface.process_text "(markdown)" strheader with - | Ok(UTDocumentFile([], [], u)) -> u - | _ -> failwith "TODO (error): invalid header expression" + match document_attributes_res with + | Error(_) -> + failwith "TODO (error): failed to decode document attributes" + + | Ok(document_attributes) -> + let md = + { + extra_expression = utast_extra; + main_contents; + } + in + (document_attributes, modnm, md) + + +let convert (cmdrcd : command_record) (md : t) = + let utast_body = convert_block cmdrcd md.main_contents in + let utast_doccmd = + let (rng, (modnms, varnm)) = cmdrcd.document in + let modidents = modnms |> List.map (fun modnm -> (rng, modnm)) in + (rng, UTContentOf(modidents, (rng, varnm))) in - let blk = normalize_h1 md in -(* - Format.printf "BLOCK: %a\n" pp_block blk; (* for debug *) - *) - let utastbody = convert_block cmdrcd blk in - (dummy_range, UTApply([], (dummy_range, UTApply([], utastdoccmd, utasthead)), utastbody)) + let utast_extra = md.extra_expression in + (dummy_range, UTApply([], (dummy_range, UTApply([], utast_doccmd, utast_extra)), utast_body)) diff --git a/src/md/decodeMD.mli b/src/md/decodeMD.mli index de3bb724f..75b1c7673 100644 --- a/src/md/decodeMD.mli +++ b/src/md/decodeMD.mli @@ -37,4 +37,8 @@ type command_record = { err_inline : command; } -val decode : command_record -> string -> untyped_abstract_tree +type t + +val decode : string -> DocumentAttribute.t * module_name * t + +val convert : command_record -> t -> untyped_abstract_tree From 2babe4c7314f4c70e84b2876b13479868d66d368 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 15 Nov 2022 03:50:05 +0900 Subject: [PATCH 157/288] implement how to extract Markdown command records from configs --- src/frontend/closedLockDependencyResolver.ml | 11 +++-- src/frontend/configError.ml | 3 ++ src/frontend/main.ml | 42 +++++++++++++------ src/frontend/openFileDependencyResolver.ml | 44 +++++++++++++++++--- src/frontend/openFileDependencyResolver.mli | 2 +- src/frontend/packageReader.ml | 4 +- src/frontend/packageReader.mli | 2 +- 7 files changed, 81 insertions(+), 27 deletions(-) diff --git a/src/frontend/closedLockDependencyResolver.ml b/src/frontend/closedLockDependencyResolver.ml index 024119317..6dfcdd142 100644 --- a/src/frontend/closedLockDependencyResolver.ml +++ b/src/frontend/closedLockDependencyResolver.ml @@ -10,7 +10,7 @@ type 'a ok = ('a, config_error) result module LockDependencyGraph = DependencyGraph.Make(String) -let main ~(lock_config_dir : abs_path) ~(extensions : string list) (lock_config : LockConfig.t) : ((lock_name * untyped_package) list) ok = +let main ~(lock_config_dir : abs_path) ~(extensions : string list) (lock_config : LockConfig.t) : ((lock_name * (PackageConfig.t * untyped_package)) list) ok = let open ResultMonad in let locks = lock_config.LockConfig.locked_packages in @@ -32,9 +32,9 @@ let main ~(lock_config_dir : abs_path) ~(extensions : string list) (lock_config | LocalLocation{ path = s_relpath } -> return (make_abs_path (Filename.concat (get_abs_path_string lock_config_dir) s_relpath)) in - let* package = PackageReader.main ~extensions absdir_package in + let* package_with_config = PackageReader.main ~extensions absdir_package in let* (graph, vertex) = - graph |> LockDependencyGraph.add_vertex lock_name package + graph |> LockDependencyGraph.add_vertex lock_name package_with_config |> Result.map_error (fun _ -> LockNameConflict(lock_name)) in let lock_info = @@ -68,4 +68,7 @@ let main ~(lock_config_dir : abs_path) ~(extensions : string list) (lock_config ) graph in - LockDependencyGraph.topological_sort graph |> Result.map_error (fun cycle -> CyclicLockDependency(cycle)) + LockDependencyGraph.topological_sort graph + |> Result.map_error (fun cycle -> + CyclicLockDependency(cycle |> map_cycle (fun (lock_name, (_config, package)) -> (lock_name, package))) + ) diff --git a/src/frontend/configError.ml b/src/frontend/configError.ml index 147fcff7c..5e890c691 100644 --- a/src/frontend/configError.ml +++ b/src/frontend/configError.ml @@ -77,3 +77,6 @@ type config_error = } | CannotSolvePackageConstraints | DocumentAttributeError of DocumentAttribute.error + | MarkdownClassNotFound of module_name + | NoMarkdownConversion of module_name + | MoreThanOneMarkdownConversion of module_name diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 2eee54e6f..32660ebb2 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1063,6 +1063,21 @@ let report_config_error : config_error -> unit = function | DocumentAttributeError(e) -> report_document_attribute_error e + | MarkdownClassNotFound(modnm) -> + report_error Interface [ + NormalLine(Printf.sprintf "package '%s' not found; required for converting Markdown documents." modnm); + ] + + | NoMarkdownConversion(modnm) -> + report_error Interface [ + NormalLine(Printf.sprintf "package '%s' contains no Markdown conversion rule." modnm); + ] + + | MoreThanOneMarkdownConversion(modnm) -> + report_error Interface [ + NormalLine(Printf.sprintf "package '%s' contains more than one Markdown conversion rule." modnm); + ] + let report_font_error : font_error -> unit = function | FailedToReadFont(abspath, msg) -> @@ -1342,8 +1357,8 @@ let check_depended_packages ~(lock_config_dir : abs_path) ~(extensions : string in (* Typecheck every locked package: *) - let (genv, libacc) = - sorted_packages |> List.fold_left (fun (genv, libacc) (_lock_name, package) -> + let (genv, configenv, libacc) = + sorted_packages |> List.fold_left (fun (genv, configenv, libacc) (_lock_name, (config, package)) -> let main_module_name = match package with | UTLibraryPackage{ main_module_name; _ } -> main_module_name @@ -1355,11 +1370,12 @@ let check_depended_packages ~(lock_config_dir : abs_path) ~(extensions : string | Error(e) -> raise (ConfigError(e)) in let genv = genv |> GlobalTypeenv.add main_module_name ssig in + let configenv = configenv |> GlobalTypeenv.add main_module_name config in let libacc = Alist.append libacc libs in - (genv, libacc) - ) (GlobalTypeenv.empty, Alist.empty) + (genv, configenv, libacc) + ) (GlobalTypeenv.empty, GlobalTypeenv.empty, Alist.empty) in - (genv, Alist.to_list libacc) + (genv, configenv, Alist.to_list libacc) let make_package_lock_config_path (abspathstr_in : string) = @@ -1468,13 +1484,13 @@ let build | Error(e) -> raise (ConfigError(e)) in - let package = + let (_config, package) = match PackageReader.main ~extensions abspath_in with | Ok(package) -> package | Error(e) -> raise (ConfigError(e)) in - let (genv, _libs_dep) = + let (genv, _configenv, _libs_dep) = let lock_config_dir = make_abs_path (Filename.dirname (get_abs_path_string abspath_lock_config)) in check_depended_packages ~lock_config_dir ~extensions tyenv_prim lock_config in @@ -1502,18 +1518,18 @@ let build let dump_file_exists = CrossRef.initialize abspath_dump in Logging.dump_file ~already_exists:dump_file_exists abspath_dump; + let (genv, configenv, libs) = + let lock_config_dir = make_abs_path (Filename.dirname (get_abs_path_string abspath_lock_config)) in + check_depended_packages ~lock_config_dir ~extensions tyenv_prim lock_config + in + (* Resolve dependency of the document and the local source files: *) let (_dep_main_module_names, sorted_locals, utdoc) = - match OpenFileDependencyResolver.main ~extensions abspath_in with + match OpenFileDependencyResolver.main ~extensions configenv abspath_in with | Ok(triple) -> triple | Error(e) -> raise (ConfigError(e)) in - let (genv, libs) = - let lock_config_dir = make_abs_path (Filename.dirname (get_abs_path_string abspath_lock_config)) in - check_depended_packages ~lock_config_dir ~extensions tyenv_prim lock_config - in - (* Typechecking and elaboration: *) let (libs_local, ast_doc) = match PackageChecker.main_document tyenv_prim genv sorted_locals (abspath_in, utdoc) with diff --git a/src/frontend/openFileDependencyResolver.ml b/src/frontend/openFileDependencyResolver.ml index 7da18bc3c..f53d6a44e 100644 --- a/src/frontend/openFileDependencyResolver.ml +++ b/src/frontend/openFileDependencyResolver.ml @@ -106,24 +106,56 @@ let register_document_file (extensions : string list) (abspath_in : abs_path) : return (package_names, graph, utdoc) -let register_markdown_file (abspath_in : abs_path) : untyped_document_file ok = +let extract_markdown_command_record ~(module_name : module_name) (config : PackageConfig.t) : DecodeMD.command_record ok = + let open ResultMonad in + match config.PackageConfig.package_contents with + | PackageConfig.Library{ conversion_specs; _ } -> + begin + match + conversion_specs |> List.filter_map (function + | PackageConfig.MarkdownConversion(cmdrcd) -> + Some(cmdrcd) + ) + with + | [] -> + err @@ NoMarkdownConversion(module_name) + + | [ cmdrcd ] -> + return cmdrcd + + | _ :: _ -> + err @@ MoreThanOneMarkdownConversion(module_name) + end + + | _ -> + err @@ NoMarkdownConversion(module_name) + + +let register_markdown_file (configenv : PackageConfig.t GlobalTypeenv.t) (abspath_in : abs_path) : untyped_document_file ok = let open ResultMonad in Logging.begin_to_parse_file abspath_in; - let* (_docattr, main_module_name, md) = + let* (_docattr, main_module_name_class, md) = match read_file abspath_in with | Ok(data) -> return (DecodeMD.decode data) | Error(msg) -> err (CannotReadFileOwingToSystem(msg)) in - let cmdrcd = failwith "TODO: register_markdown_file, cmdrcd" in + let* cmdrcd = + match configenv |> GlobalTypeenv.find_opt main_module_name_class with + | None -> + err @@ MarkdownClassNotFound(main_module_name_class) + + | Some(config) -> + extract_markdown_command_record ~module_name:main_module_name_class config + in let utast = DecodeMD.convert cmdrcd md in let header = - [ HeaderUsePackage{ opening = false; module_name = (Range.dummy "md-header", main_module_name) } ] + [ HeaderUsePackage{ opening = false; module_name = (Range.dummy "md-header", main_module_name_class) } ] in let utdoc = ([], header, utast) in return utdoc -let main ~(extensions : string list) (abspath_in : abs_path) : (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file) ok = +let main ~(extensions : string list) (configenv : PackageConfig.t GlobalTypeenv.t) (abspath_in : abs_path) : (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file) ok = let open ResultMonad in let* (package_names, graph, utdoc) = match OptionState.get_input_kind () with @@ -132,7 +164,7 @@ let main ~(extensions : string list) (abspath_in : abs_path) : (PackageNameSet.t return (package_names, graph, utdoc) | OptionState.Markdown(_settings) -> - let* utdoc = register_markdown_file abspath_in in + let* utdoc = register_markdown_file configenv abspath_in in return (PackageNameSet.empty, FileDependencyGraph.empty, utdoc) in let* sorted_locals = diff --git a/src/frontend/openFileDependencyResolver.mli b/src/frontend/openFileDependencyResolver.mli index 7fdc7df99..070a72394 100644 --- a/src/frontend/openFileDependencyResolver.mli +++ b/src/frontend/openFileDependencyResolver.mli @@ -3,4 +3,4 @@ open MyUtil open Types open ConfigError -val main : extensions:(string list) -> abs_path -> (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file, config_error) result +val main : extensions:(string list) -> PackageConfig.t GlobalTypeenv.t -> abs_path -> (PackageNameSet.t * (abs_path * untyped_library_file) list * untyped_document_file, config_error) result diff --git a/src/frontend/packageReader.ml b/src/frontend/packageReader.ml index 68c954da9..3252cf519 100644 --- a/src/frontend/packageReader.ml +++ b/src/frontend/packageReader.ml @@ -17,7 +17,7 @@ let listup_sources_in_directory (extensions : string list) (absdir_src : abs_pat ) -let main ~(extensions : string list) (absdir_package : abs_path) : untyped_package ok = +let main ~(extensions : string list) (absdir_package : abs_path) : (PackageConfig.t * untyped_package) ok = let open ResultMonad in let* config = PackageConfig.load absdir_package in let* package = @@ -67,4 +67,4 @@ let main ~(extensions : string list) (absdir_package : abs_path) : untyped_packa font_files; } in - return package + return (config, package) diff --git a/src/frontend/packageReader.mli b/src/frontend/packageReader.mli index 78cdc3be3..59daa00aa 100644 --- a/src/frontend/packageReader.mli +++ b/src/frontend/packageReader.mli @@ -3,4 +3,4 @@ open MyUtil open Types open ConfigError -val main : extensions:(string list) -> abs_path -> (untyped_package, config_error) result +val main : extensions:(string list) -> abs_path -> (PackageConfig.t * untyped_package, config_error) result From 07a82c89c71f66c1533ddb3aebadffe5742ee969 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 15 Nov 2022 04:11:56 +0900 Subject: [PATCH 158/288] FIRST SUCCESS in using Markdown conversion rules given in package configs --- .../md-ja/md-ja.0.0.1/src/md-ja.satyh | 20 ++++++++++++++----- src/frontend/packageConfig.ml | 3 ++- src/md/decodeMD.ml | 13 +++++++++--- tests/md/test.md | 6 ++++++ 4 files changed, 33 insertions(+), 9 deletions(-) diff --git a/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/src/md-ja.satyh b/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/src/md-ja.satyh index 77b858fa2..58d25cd73 100644 --- a/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/src/md-ja.satyh +++ b/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/src/md-ja.satyh @@ -23,6 +23,7 @@ module MDJa :> sig val +ul : block [list inline-text] val +ul-block : block [list block-text] val +ol : block [list inline-text] + val +ol-block : block [list block-text] val +code : block [string] val +console : block [string] val +quote : block [block-text] @@ -266,19 +267,19 @@ end = struct (inline-skip indent-size ++ read-inline ctx it ++ inline-fil) + val inline ctx \embed-list-block bt = + embed-block-breakable ctx (read-block ctx bt) ++ inline-fil + + val block +ul its = let items = its |> List.map (fun it -> Item(it, [])) in '<+Itemize.listing?(break = true)(Item({}, items));> - val inline ctx \embed-ul-block bt = - embed-block-breakable ctx (read-block ctx bt) ++ inline-fil - - val block ctx +ul-block bts = let items = bts |> List.map (fun bt -> ( - Item({\embed-ul-block(bt);}, []) + Item({\embed-list-block(bt);}, []) )) in read-block ctx '<+Itemize.listing?(break = true)(Item({}, items));> @@ -289,6 +290,15 @@ end = struct '<+Itemize.enumerate(Item({}, items));> + val block ctx +ol-block bts = + let items = + bts |> List.map (fun bt -> ( + Item({\embed-list-block(bt);}, []) + )) + in + read-block ctx '<+Itemize.listing?(break = true)(Item({}, items));> + + val fix-block-code s = string-unexplode [0x0A] ^ s % dirty trick; should fix '+Code.code' and the parser of SATySFi diff --git a/src/frontend/packageConfig.ml b/src/frontend/packageConfig.ml index 95dad3864..ad5ec947a 100644 --- a/src/frontend/packageConfig.ml +++ b/src/frontend/packageConfig.ml @@ -78,7 +78,8 @@ let command_decoder ~(prefix : char) : DecodeMD.command ConfigDecoder.t = if Char.equal prefix (String.get s 0) then let s_tail = (String.sub s 1 (String.length s - 1)) in let (modnms, varnm) = cut_module_names s_tail in - succeed (Range.dummy "command_decoder", (modnms, varnm)) + let csnm = Printf.sprintf "%c%s" prefix varnm in + succeed (Range.dummy "command_decoder", (modnms, csnm)) else failure (fun context -> NotACommand{ context; prefix; string = s }) with diff --git a/src/md/decodeMD.ml b/src/md/decodeMD.ml index 5d857d80a..74c2a6288 100644 --- a/src/md/decodeMD.ml +++ b/src/md/decodeMD.ml @@ -374,6 +374,7 @@ and convert_block (cmdrcd : command_record) (blk : block) : untyped_abstract_tre let extract_comment (s : string) : string option = + let s = String.trim s in if Core.String.is_prefix s ~prefix:"" then let len = String.length s in if len < 8 then @@ -401,17 +402,23 @@ let decode (s : string) : DocumentAttribute.t * module_name * t = let (s_dependencies, modnm, s_extra, obs) = match obs with | Omd.Html_block(_attr1, s1) :: Omd.Html_block(_attr2, s2) :: Omd.Html_block(_attr3, s3) :: obs -> + Format.printf "**** STR: %s, %s, %s\n" s1 s2 s3; begin match (extract_comment s1, extract_comment s2, extract_comment s3) with | (Some(s_dependencies), Some(modnm), Some(s_extra)) -> + Format.printf "**** EXTR: %s, %s, %s\n" s_dependencies modnm s_extra; (s_dependencies, modnm, s_extra, obs) - | _ -> - failwith "TODO (error): not a comment" + | (opt1, opt2, opt3) -> + Format.printf "**** EXTR: %a, %a, %a\n" + Format.(pp_print_option pp_print_string) opt1 + Format.(pp_print_option pp_print_string) opt2 + Format.(pp_print_option pp_print_string) opt3; + failwith "TODO (error): not a comment 1" end | _ -> - failwith "TODO (error): not a comment" + failwith "TODO (error): not a comment 2" in let utast_dependencies = parse_expression s_dependencies in let utast_extra = parse_expression s_extra in diff --git a/tests/md/test.md b/tests/md/test.md index 58667e57c..63b54fe3d 100644 --- a/tests/md/test.md +++ b/tests/md/test.md @@ -1,3 +1,9 @@ + + + + - - v2 --> v3]. *) let create_graph1 () = let open ResultMonad in @@ -45,7 +53,7 @@ let create_graph1 () = graph |> DG.add_vertex 3 "three" >>= fun (graph, vertex3) -> let graph = graph |> DG.add_edge ~from:vertex1 ~to_:vertex2 in let graph = graph |> DG.add_edge ~from:vertex2 ~to_:vertex3 in - return graph + return (graph, (vertex1, vertex2, vertex3)) (** Creates a graph of structure [v1 --> v2 --> v4] and [v1 --> v3 --> v4]. *) @@ -89,8 +97,8 @@ let create_graph4 () = return graph -let test1 () = - create_graph1 () |> continue_if_ok "cannot construct graph1" (fun graph1 -> +let topological_sort_test_1 () = + create_graph1 () |> continue_if_ok "cannot construct graph1" (fun (graph1, _) -> DG.topological_sort graph1 |> continue_if_ok "cannot sort graph1" (fun got1 -> let expected1 = [ (3, "three"); (2, "two"); (1, "one") ] in Alcotest.(check (list (pair int string))) "should be [v3, v2, v1]" expected1 got1 @@ -98,7 +106,7 @@ let test1 () = ) -let test2 () = +let topological_sort_test_2 () = create_graph2 () |> continue_if_ok "cannot construct graph2" (fun graph2 -> DG.topological_sort graph2 |> continue_if_ok "cannot sort graph2" (fun got2 -> let pp = Format.pp_print_list pp_int_and_string in @@ -110,7 +118,7 @@ let test2 () = ) -let test3 () = +let topological_sort_test_3 () = create_graph3 () |> continue_if_ok "cannot construct graph3" (fun graph3 -> DG.topological_sort graph3 |> continue_if_error "cannot find cycle" (fun cycle -> let pp = pp_cycle pp_int_and_string in @@ -130,7 +138,7 @@ let test3 () = ) -let test4 () = +let topological_sort_test_4 () = create_graph4 () |> continue_if_ok "cannot construct graph4" (fun graph4 -> DG.topological_sort graph4 |> continue_if_error "cannot find cycle" (fun cycle -> let pp = pp_cycle pp_int_and_string in @@ -142,10 +150,20 @@ let test4 () = ) +let reachability_closure_test_1 () = + create_graph1 () |> continue_if_ok "cannot construct graph1" (fun (graph1, (_vertex1, vertex2, vertex3)) -> + let vertices_origin = DG.VertexSet.empty |> DG.VertexSet.add vertex2 in (* {2} *) + let got = DG.reachability_closure graph1 vertices_origin in + let expected = vertices_origin |> DG.VertexSet.add vertex3 in (* {2, 3} *) + Alcotest.(check (of_pp pp_vertex_set)) "vertex set equality" expected got + ) + + let test_cases = Alcotest.[ - test_case "IntDependencyGraph 1" `Quick test1; - test_case "IntDependencyGraph 2" `Quick test2; - test_case "IntDependencyGraph 3" `Quick test3; - test_case "IntDependencyGraph 4" `Quick test4; + test_case "topological sort 1" `Quick topological_sort_test_1; + test_case "topological sort 2" `Quick topological_sort_test_2; + test_case "topological sort 3" `Quick topological_sort_test_3; + test_case "topological sort 4" `Quick topological_sort_test_4; + test_case "reachability closure 1" `Quick reachability_closure_test_1; ] From bf1d1ccc95f71e2edce04bc729cbd5aff082ed0c Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 16 Nov 2022 02:33:14 +0900 Subject: [PATCH 175/288] develop tests for 'reachability_closure' --- test/misc/dependencyGraphTest.ml | 30 +++++++++++++++++++++++++----- 1 file changed, 25 insertions(+), 5 deletions(-) diff --git a/test/misc/dependencyGraphTest.ml b/test/misc/dependencyGraphTest.ml index b8ddca056..238d5c9d6 100644 --- a/test/misc/dependencyGraphTest.ml +++ b/test/misc/dependencyGraphTest.ml @@ -68,7 +68,7 @@ let create_graph2 () = let graph = graph |> DG.add_edge ~from:vertex1 ~to_:vertex3 in let graph = graph |> DG.add_edge ~from:vertex2 ~to_:vertex4 in let graph = graph |> DG.add_edge ~from:vertex3 ~to_:vertex4 in - return graph + return (graph, (vertex1, vertex2, vertex3, vertex4)) (** Creates a graph of structure [v1 --> v2 --> v3 --> v1] and [v3 --> v4], which has a cycle. *) @@ -107,7 +107,7 @@ let topological_sort_test_1 () = let topological_sort_test_2 () = - create_graph2 () |> continue_if_ok "cannot construct graph2" (fun graph2 -> + create_graph2 () |> continue_if_ok "cannot construct graph2" (fun (graph2, _) -> DG.topological_sort graph2 |> continue_if_ok "cannot sort graph2" (fun got2 -> let pp = Format.pp_print_list pp_int_and_string in got2 |> expect_pattern "v4 must be first, and v1 must be the last" pp (function @@ -152,9 +152,27 @@ let topological_sort_test_4 () = let reachability_closure_test_1 () = create_graph1 () |> continue_if_ok "cannot construct graph1" (fun (graph1, (_vertex1, vertex2, vertex3)) -> - let vertices_origin = DG.VertexSet.empty |> DG.VertexSet.add vertex2 in (* {2} *) - let got = DG.reachability_closure graph1 vertices_origin in - let expected = vertices_origin |> DG.VertexSet.add vertex3 in (* {2, 3} *) + let input = DG.VertexSet.of_list [ vertex2 ] in + let expected = DG.VertexSet.of_list [ vertex2; vertex3 ] in + let got = DG.reachability_closure graph1 input in + Alcotest.(check (of_pp pp_vertex_set)) "vertex set equality" expected got + ) + + +let reachability_closure_test_2 () = + create_graph2 () |> continue_if_ok "cannot construct graph2" (fun (graph2, (vertex1, vertex2, vertex3, vertex4)) -> + let input = DG.VertexSet.of_list [ vertex1 ] in + let expected = DG.VertexSet.of_list [ vertex1; vertex2; vertex3; vertex4 ] in + let got = DG.reachability_closure graph2 input in + Alcotest.(check (of_pp pp_vertex_set)) "vertex set equality" expected got + ) + + +let reachability_closure_test_3 () = + create_graph2 () |> continue_if_ok "cannot construct graph2" (fun (graph2, (_vertex1, vertex2, vertex3, vertex4)) -> + let input = DG.VertexSet.of_list [ vertex2; vertex3 ] in + let expected = DG.VertexSet.of_list [ vertex2; vertex3; vertex4 ] in + let got = DG.reachability_closure graph2 input in Alcotest.(check (of_pp pp_vertex_set)) "vertex set equality" expected got ) @@ -166,4 +184,6 @@ let test_cases = test_case "topological sort 3" `Quick topological_sort_test_3; test_case "topological sort 4" `Quick topological_sort_test_4; test_case "reachability closure 1" `Quick reachability_closure_test_1; + test_case "reachability closure 2" `Quick reachability_closure_test_2; + test_case "reachability closure 3" `Quick reachability_closure_test_3; ] From 6f1104c4655ef9ee89f9364dafd1c77d5011f0ee Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 16 Nov 2022 03:12:08 +0900 Subject: [PATCH 176/288] use 'LockDependencyGraph' to compute source dependencies and test-only ones --- src/frontend/packageConstraintSolver.ml | 125 +++++++++++++++--------- 1 file changed, 80 insertions(+), 45 deletions(-) diff --git a/src/frontend/packageConstraintSolver.ml b/src/frontend/packageConstraintSolver.ml index c27d50125..8575b1cb9 100644 --- a/src/frontend/packageConstraintSolver.ml +++ b/src/frontend/packageConstraintSolver.ml @@ -240,20 +240,23 @@ end module InternalSolver = Zeroinstall_solver.Make(SolverInput) +module LockDependencyGraph = DependencyGraph.Make(String) -let get_flag (package_name : package_name) (flagmap : dependency_flag PackageNameMap.t) : dependency_flag = - match flagmap |> PackageNameMap.find_opt package_name with - | Some(flag) -> flag - | None -> SourceDependency (* Indirect dependencies *) +module VertexSet = LockDependencyGraph.VertexSet let solve (context : package_context) (dependencies_with_flags : (dependency_flag * package_dependency) list) : (package_solution list) option = - let (flagmap, dependency_acc) = - dependencies_with_flags |> List.fold_left (fun (flagmap, dependency_acc) (flag, dep) -> + let (explicit_source_dependencies, dependency_acc) = + dependencies_with_flags |> List.fold_left (fun (explicit_source_dependencies, dependency_acc) (flag, dep) -> match dep with | PackageDependency{ package_name; _ } -> - (flagmap |> PackageNameMap.add package_name flag, Alist.extend dependency_acc dep) - ) (PackageNameMap.empty, Alist.empty) + let explicit_source_dependencies = + match flag with + | SourceDependency -> explicit_source_dependencies |> PackageNameSet.add package_name + | TestOnlyDependency -> explicit_source_dependencies + in + (explicit_source_dependencies, Alist.extend dependency_acc dep) + ) (PackageNameSet.empty, Alist.empty) in let requires = Alist.to_list dependency_acc in let output_opt = @@ -264,56 +267,88 @@ let solve (context : package_context) (dependencies_with_flags : (dependency_fla in output_opt |> Option.map (fun output -> let open InternalSolver in + + (* Adds vertices to the graph: *) let rolemap = output |> Output.to_map in - let (solmap, packages_depended_by_source) = + let (quad_acc, graph, explicit_vertices, name_to_vertex_map) = Output.RoleMap.fold (fun _role impl acc -> - let open SolverInput in - let (solmap, packages_depended_by_source) = acc in let impl = Output.unwrap impl in match impl with | DummyImpl | LocalImpl(_) -> acc | Impl{ package_name; version = locked_version; dependencies; _ } -> - let flag = flagmap |> get_flag package_name in - let (locked_dependency_acc, packages_depended_by_source) = - dependencies |> List.fold_left (fun (locked_dependency_acc, packages_depended_by_source) dep -> - let Dependency{ role = role_dep; _ } = dep in - match role_dep with - | Role{ package_name = package_name_dep; _ } -> - let locked_dependency_acc = - match rolemap |> Output.RoleMap.find_opt role_dep |> Option.map Output.unwrap with - | None | Some(DummyImpl) | Some(LocalImpl(_)) -> - locked_dependency_acc - - | Some(Impl{ version = version_dep; _ }) -> - Alist.extend locked_dependency_acc (package_name_dep, version_dep) - in - let packages_depended_by_source = - match flag with - | SourceDependency -> packages_depended_by_source |> PackageNameSet.add package_name_dep - | TestOnlyDependency -> packages_depended_by_source - in - (locked_dependency_acc, packages_depended_by_source) - - | LocalRole(_) -> - (locked_dependency_acc, packages_depended_by_source) - - ) (Alist.empty, packages_depended_by_source) + let (quad_acc, graph, explicit_vertices, name_to_vertex_map) = acc in + let (graph, vertex) = + match graph |> LockDependencyGraph.add_vertex package_name () with + | Error(_) -> assert false + | Ok(pair) -> pair + in + let quad_acc = Alist.extend quad_acc (package_name, locked_version, dependencies, vertex) in + let explicit_vertices = + if explicit_source_dependencies |> PackageNameSet.mem package_name then + explicit_vertices |> VertexSet.add vertex + else + explicit_vertices in - let locked_dependencies = Alist.to_list locked_dependency_acc in - let solmap = solmap |> PackageNameMap.add package_name (flag, locked_version, locked_dependencies) in - (solmap, packages_depended_by_source) + let name_to_vertex_map = name_to_vertex_map |> PackageNameMap.add package_name vertex in + (quad_acc, graph, explicit_vertices, name_to_vertex_map) - ) rolemap (PackageNameMap.empty, PackageNameSet.empty) + ) rolemap (Alist.empty, LockDependencyGraph.empty, VertexSet.empty, PackageNameMap.empty) in + + (* Add edges to the graph: *) + let (solmap, graph) = + quad_acc |> Alist.to_list |> List.fold_left (fun acc quad -> + let open SolverInput in + let (solmap, graph) = acc in + let (package_name, locked_version, dependencies, vertex) = quad in + let (locked_dependency_acc, graph) = + dependencies |> List.fold_left (fun (locked_dependency_acc, graph) dep -> + let Dependency{ role = role_dep; _ } = dep in + match role_dep with + | Role{ package_name = package_name_dep; _ } -> + let locked_dependency_acc = + match rolemap |> Output.RoleMap.find_opt role_dep |> Option.map Output.unwrap with + | None | Some(DummyImpl) | Some(LocalImpl(_)) -> + locked_dependency_acc + + | Some(Impl{ version = version_dep; _ }) -> + Alist.extend locked_dependency_acc (package_name_dep, version_dep) + in + let vertex_dep = + match name_to_vertex_map |> PackageNameMap.find_opt package_name with + | None -> assert false + | Some(v) -> v + in + let graph = graph |> LockDependencyGraph.add_edge ~from:vertex ~to_:vertex_dep in + (locked_dependency_acc, graph) + + | LocalRole(_) -> + (locked_dependency_acc, graph) + + ) (Alist.empty, graph) + in + let locked_dependencies = Alist.to_list locked_dependency_acc in + let solmap = solmap |> PackageNameMap.add package_name (locked_version, locked_dependencies) in + (solmap, graph) + + ) (PackageNameMap.empty, graph) + in + + (* Computes the set of source dependencies: *) + let resulting_source_dependencies = + LockDependencyGraph.reachability_closure graph explicit_vertices + in + let solution_acc = - PackageNameMap.fold (fun package_name (flag, locked_version, locked_dependencies) solution_acc -> - let used_in_test_only = - match (flag, packages_depended_by_source |> PackageNameSet.mem package_name) with - | (SourceDependency, _) | (_, true) -> false - | (TestOnlyDependency, false) -> true + PackageNameMap.fold (fun package_name (locked_version, locked_dependencies) solution_acc -> + let vertex = + match name_to_vertex_map |> PackageNameMap.find_opt package_name with + | None -> assert false + | Some(v) -> v in + let used_in_test_only = not (resulting_source_dependencies |> VertexSet.mem vertex) in Alist.extend solution_acc { package_name; locked_version; From 237a5cb80e8f37ae4f89ebc4ce2da47f7dc60268 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 16 Nov 2022 03:34:39 +0900 Subject: [PATCH 177/288] FIRST SUCCESS in distinguishing whether each dependency is for test only --- src/frontend/packageConstraintSolver.ml | 6 +++++- src/frontend/packageSystemBase.ml | 1 + 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/src/frontend/packageConstraintSolver.ml b/src/frontend/packageConstraintSolver.ml index 8575b1cb9..f2dcb93ed 100644 --- a/src/frontend/packageConstraintSolver.ml +++ b/src/frontend/packageConstraintSolver.ml @@ -255,6 +255,7 @@ let solve (context : package_context) (dependencies_with_flags : (dependency_fla | SourceDependency -> explicit_source_dependencies |> PackageNameSet.add package_name | TestOnlyDependency -> explicit_source_dependencies in + Format.printf "**** FLAG %s (%a)\n" package_name pp_dependency_flag flag; (* TODO: remove this *) (explicit_source_dependencies, Alist.extend dependency_acc dep) ) (PackageNameSet.empty, Alist.empty) in @@ -278,6 +279,7 @@ let solve (context : package_context) (dependencies_with_flags : (dependency_fla acc | Impl{ package_name; version = locked_version; dependencies; _ } -> + Format.printf "**** VERTEX %s\n" package_name; (* TODO: remove this *) let (quad_acc, graph, explicit_vertices, name_to_vertex_map) = acc in let (graph, vertex) = match graph |> LockDependencyGraph.add_vertex package_name () with @@ -317,10 +319,11 @@ let solve (context : package_context) (dependencies_with_flags : (dependency_fla Alist.extend locked_dependency_acc (package_name_dep, version_dep) in let vertex_dep = - match name_to_vertex_map |> PackageNameMap.find_opt package_name with + match name_to_vertex_map |> PackageNameMap.find_opt package_name_dep with | None -> assert false | Some(v) -> v in + Format.printf "**** DEP %s ---> %s\n" package_name package_name_dep; (* TODO: remove this *) let graph = graph |> LockDependencyGraph.add_edge ~from:vertex ~to_:vertex_dep in (locked_dependency_acc, graph) @@ -349,6 +352,7 @@ let solve (context : package_context) (dependencies_with_flags : (dependency_fla | Some(v) -> v in let used_in_test_only = not (resulting_source_dependencies |> VertexSet.mem vertex) in + Format.printf "**** RESULT %B <- %s\n" used_in_test_only package_name; (* TODO: remove this *) Alist.extend solution_acc { package_name; locked_version; diff --git a/src/frontend/packageSystemBase.ml b/src/frontend/packageSystemBase.ml index 1191069bc..8928f232c 100644 --- a/src/frontend/packageSystemBase.ml +++ b/src/frontend/packageSystemBase.ml @@ -41,3 +41,4 @@ type input_kind = type dependency_flag = | SourceDependency | TestOnlyDependency +[@@deriving show { with_path = false }] From c88ee48788d7dd767d3bafe5558dad45a653a319 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 16 Nov 2022 03:51:15 +0900 Subject: [PATCH 178/288] update tests --- demo/demo.satysfi-lock-expected | 13 +++++ doc/doc-lang.satysfi-lock-expected | 9 +++ doc/doc-primitives.satysfi-lock-expected | 11 ++++ doc/math1.satysfi-lock-expected | 11 ++++ tests/Makefile | 1 + tests/clip.satysfi-lock-expected | 6 ++ tests/glue1.satysfi-lock-expected | 6 ++ tests/images/test.satysfi-lock-expected | 10 ++++ tests/macro1.satysfi-lock-expected | 10 ++++ tests/math2.satysfi-lock-expected | 6 ++ tests/md/test.satysfi-lock | 72 ------------------------ tests/md/test.satysfi-lock-expected | 11 ++++ tests/refactor1.satysfi-lock-expected | 5 ++ tests/refactor2.satysfi-lock-expected | 3 + tests/refactor3.satysfi-lock-expected | 3 + tests/refactor5.satysfi-lock-expected | 3 + tests/staged1.satysfi-lock-expected | 9 +++ 17 files changed, 117 insertions(+), 72 deletions(-) delete mode 100644 tests/md/test.satysfi-lock diff --git a/demo/demo.satysfi-lock-expected b/demo/demo.satysfi-lock-expected index 141e11fcd..d6a41e519 100644 --- a/demo/demo.satysfi-lock-expected +++ b/demo/demo.satysfi-lock-expected @@ -5,6 +5,7 @@ locks: path: ./dist/packages/annot/annot.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: code.0.0.1 location: type: global @@ -12,50 +13,59 @@ locks: dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 + test_only: false - name: font-ipa-ex.0.0.1 location: type: global path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ dependencies: [] + test_only: false - name: font-junicode.0.0.1 location: type: global path: ./dist/packages/font-junicode/font-junicode.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern.0.0.1 location: type: global path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern-math.0.0.1 location: type: global path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ dependencies: [] + test_only: false - name: footnote-scheme.0.0.1 location: type: global path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: itemize.0.0.1 location: type: global path: ./dist/packages/itemize/itemize.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: math.0.0.1 location: type: global path: ./dist/packages/math/math.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: proof.0.0.1 location: type: global path: ./dist/packages/proof/proof.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: std-ja-book.0.0.1 location: type: global @@ -70,14 +80,17 @@ locks: - font-latin-modern.0.0.1 - font-ipa-ex.0.0.1 - font-latin-modern-math.0.0.1 + test_only: false - name: stdlib.0.0.1 location: type: global path: ./dist/packages/stdlib/stdlib.0.0.1/ dependencies: [] + test_only: false - name: tabular.0.0.1 location: type: global path: ./dist/packages/tabular/tabular.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false diff --git a/doc/doc-lang.satysfi-lock-expected b/doc/doc-lang.satysfi-lock-expected index 3ec050ba9..fa57d1904 100644 --- a/doc/doc-lang.satysfi-lock-expected +++ b/doc/doc-lang.satysfi-lock-expected @@ -5,6 +5,7 @@ locks: path: ./dist/packages/annot/annot.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: code.0.0.1 location: type: global @@ -12,32 +13,38 @@ locks: dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 + test_only: false - name: font-ipa-ex.0.0.1 location: type: global path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ dependencies: [] + test_only: false - name: font-junicode.0.0.1 location: type: global path: ./dist/packages/font-junicode/font-junicode.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern.0.0.1 location: type: global path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern-math.0.0.1 location: type: global path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ dependencies: [] + test_only: false - name: math.0.0.1 location: type: global path: ./dist/packages/math/math.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: std-ja.0.0.1 location: type: global @@ -51,8 +58,10 @@ locks: - font-latin-modern.0.0.1 - font-ipa-ex.0.0.1 - font-latin-modern-math.0.0.1 + test_only: false - name: stdlib.0.0.1 location: type: global path: ./dist/packages/stdlib/stdlib.0.0.1/ dependencies: [] + test_only: false diff --git a/doc/doc-primitives.satysfi-lock-expected b/doc/doc-primitives.satysfi-lock-expected index c027aab20..c366a425e 100644 --- a/doc/doc-primitives.satysfi-lock-expected +++ b/doc/doc-primitives.satysfi-lock-expected @@ -5,6 +5,7 @@ locks: path: ./dist/packages/annot/annot.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: code.0.0.1 location: type: global @@ -12,44 +13,52 @@ locks: dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 + test_only: false - name: font-ipa-ex.0.0.1 location: type: global path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ dependencies: [] + test_only: false - name: font-junicode.0.0.1 location: type: global path: ./dist/packages/font-junicode/font-junicode.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern.0.0.1 location: type: global path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern-math.0.0.1 location: type: global path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ dependencies: [] + test_only: false - name: footnote-scheme.0.0.1 location: type: global path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: itemize.0.0.1 location: type: global path: ./dist/packages/itemize/itemize.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: math.0.0.1 location: type: global path: ./dist/packages/math/math.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: std-ja-book.0.0.1 location: type: global @@ -64,8 +73,10 @@ locks: - font-latin-modern.0.0.1 - font-ipa-ex.0.0.1 - font-latin-modern-math.0.0.1 + test_only: false - name: stdlib.0.0.1 location: type: global path: ./dist/packages/stdlib/stdlib.0.0.1/ dependencies: [] + test_only: false diff --git a/doc/math1.satysfi-lock-expected b/doc/math1.satysfi-lock-expected index 25a88e979..3aa031e32 100644 --- a/doc/math1.satysfi-lock-expected +++ b/doc/math1.satysfi-lock-expected @@ -5,6 +5,7 @@ locks: path: ./dist/packages/annot/annot.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: code.0.0.1 location: type: global @@ -12,38 +13,45 @@ locks: dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 + test_only: false - name: font-ipa-ex.0.0.1 location: type: global path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ dependencies: [] + test_only: false - name: font-junicode.0.0.1 location: type: global path: ./dist/packages/font-junicode/font-junicode.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern.0.0.1 location: type: global path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern-math.0.0.1 location: type: global path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ dependencies: [] + test_only: false - name: math.0.0.1 location: type: global path: ./dist/packages/math/math.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: proof.0.0.1 location: type: global path: ./dist/packages/proof/proof.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: std-ja.0.0.1 location: type: global @@ -57,14 +65,17 @@ locks: - font-latin-modern.0.0.1 - font-ipa-ex.0.0.1 - font-latin-modern-math.0.0.1 + test_only: false - name: stdlib.0.0.1 location: type: global path: ./dist/packages/stdlib/stdlib.0.0.1/ dependencies: [] + test_only: false - name: tabular.0.0.1 location: type: global path: ./dist/packages/tabular/tabular.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false diff --git a/tests/Makefile b/tests/Makefile index 6b5c66fde..630feb8f0 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -55,6 +55,7 @@ promote:: $(EXPECTED_LOCKS) promote:: (cd images; make promote) (cd text_mode; make promote) + (cd md; make promote) clean:: rm -f *.pdf *.satysfi-aux diff --git a/tests/clip.satysfi-lock-expected b/tests/clip.satysfi-lock-expected index 436f4709a..aeacb20d5 100644 --- a/tests/clip.satysfi-lock-expected +++ b/tests/clip.satysfi-lock-expected @@ -4,29 +4,35 @@ locks: type: global path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ dependencies: [] + test_only: false - name: font-junicode.0.0.1 location: type: global path: ./dist/packages/font-junicode/font-junicode.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern.0.0.1 location: type: global path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern-math.0.0.1 location: type: global path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ dependencies: [] + test_only: false - name: math.0.0.1 location: type: global path: ./dist/packages/math/math.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: stdlib.0.0.1 location: type: global path: ./dist/packages/stdlib/stdlib.0.0.1/ dependencies: [] + test_only: false diff --git a/tests/glue1.satysfi-lock-expected b/tests/glue1.satysfi-lock-expected index 436f4709a..aeacb20d5 100644 --- a/tests/glue1.satysfi-lock-expected +++ b/tests/glue1.satysfi-lock-expected @@ -4,29 +4,35 @@ locks: type: global path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ dependencies: [] + test_only: false - name: font-junicode.0.0.1 location: type: global path: ./dist/packages/font-junicode/font-junicode.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern.0.0.1 location: type: global path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern-math.0.0.1 location: type: global path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ dependencies: [] + test_only: false - name: math.0.0.1 location: type: global path: ./dist/packages/math/math.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: stdlib.0.0.1 location: type: global path: ./dist/packages/stdlib/stdlib.0.0.1/ dependencies: [] + test_only: false diff --git a/tests/images/test.satysfi-lock-expected b/tests/images/test.satysfi-lock-expected index 10aae1dc5..4d923b2e0 100644 --- a/tests/images/test.satysfi-lock-expected +++ b/tests/images/test.satysfi-lock-expected @@ -5,6 +5,7 @@ locks: path: ./dist/packages/annot/annot.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: code.0.0.1 location: type: global @@ -12,38 +13,45 @@ locks: dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 + test_only: false - name: font-ipa-ex.0.0.1 location: type: global path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ dependencies: [] + test_only: false - name: font-junicode.0.0.1 location: type: global path: ./dist/packages/font-junicode/font-junicode.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern.0.0.1 location: type: global path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern-math.0.0.1 location: type: global path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ dependencies: [] + test_only: false - name: itemize.0.0.1 location: type: global path: ./dist/packages/itemize/itemize.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: math.0.0.1 location: type: global path: ./dist/packages/math/math.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: std-ja.0.0.1 location: type: global @@ -57,8 +65,10 @@ locks: - font-latin-modern.0.0.1 - font-ipa-ex.0.0.1 - font-latin-modern-math.0.0.1 + test_only: false - name: stdlib.0.0.1 location: type: global path: ./dist/packages/stdlib/stdlib.0.0.1/ dependencies: [] + test_only: false diff --git a/tests/macro1.satysfi-lock-expected b/tests/macro1.satysfi-lock-expected index b386d3a04..6430e66bb 100644 --- a/tests/macro1.satysfi-lock-expected +++ b/tests/macro1.satysfi-lock-expected @@ -5,6 +5,7 @@ locks: path: ./dist/packages/annot/annot.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: code.0.0.1 location: type: global @@ -12,38 +13,45 @@ locks: dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 + test_only: false - name: font-ipa-ex.0.0.1 location: type: global path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ dependencies: [] + test_only: false - name: font-junicode.0.0.1 location: type: global path: ./dist/packages/font-junicode/font-junicode.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern.0.0.1 location: type: global path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern-math.0.0.1 location: type: global path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ dependencies: [] + test_only: false - name: footnote-scheme.0.0.1 location: type: global path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: math.0.0.1 location: type: global path: ./dist/packages/math/math.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: std-ja-report.0.0.1 location: type: global @@ -58,8 +66,10 @@ locks: - font-latin-modern.0.0.1 - font-ipa-ex.0.0.1 - font-latin-modern-math.0.0.1 + test_only: false - name: stdlib.0.0.1 location: type: global path: ./dist/packages/stdlib/stdlib.0.0.1/ dependencies: [] + test_only: false diff --git a/tests/math2.satysfi-lock-expected b/tests/math2.satysfi-lock-expected index 436f4709a..aeacb20d5 100644 --- a/tests/math2.satysfi-lock-expected +++ b/tests/math2.satysfi-lock-expected @@ -4,29 +4,35 @@ locks: type: global path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ dependencies: [] + test_only: false - name: font-junicode.0.0.1 location: type: global path: ./dist/packages/font-junicode/font-junicode.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern.0.0.1 location: type: global path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern-math.0.0.1 location: type: global path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ dependencies: [] + test_only: false - name: math.0.0.1 location: type: global path: ./dist/packages/math/math.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: stdlib.0.0.1 location: type: global path: ./dist/packages/stdlib/stdlib.0.0.1/ dependencies: [] + test_only: false diff --git a/tests/md/test.satysfi-lock b/tests/md/test.satysfi-lock deleted file mode 100644 index fdcf76576..000000000 --- a/tests/md/test.satysfi-lock +++ /dev/null @@ -1,72 +0,0 @@ -locks: -- name: annot.0.0.1 - location: - type: global - path: ./dist/packages/annot/annot.0.0.1/ - dependencies: - - stdlib.0.0.1 -- name: code.0.0.1 - location: - type: global - path: ./dist/packages/code/code.0.0.1/ - dependencies: - - stdlib.0.0.1 - - font-latin-modern.0.0.1 -- name: font-ipa-ex.0.0.1 - location: - type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ - dependencies: [] -- name: font-junicode.0.0.1 - location: - type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1/ - dependencies: [] -- name: font-latin-modern.0.0.1 - location: - type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ - dependencies: [] -- name: font-latin-modern-math.0.0.1 - location: - type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ - dependencies: [] -- name: footnote-scheme.0.0.1 - location: - type: global - path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1/ - dependencies: - - stdlib.0.0.1 -- name: itemize.0.0.1 - location: - type: global - path: ./dist/packages/itemize/itemize.0.0.1/ - dependencies: - - stdlib.0.0.1 -- name: math.0.0.1 - location: - type: global - path: ./dist/packages/math/math.0.0.1/ - dependencies: - - stdlib.0.0.1 -- name: md-ja.0.0.1 - location: - type: global - path: ./dist/packages/md-ja/md-ja.0.0.1/ - dependencies: - - stdlib.0.0.1 - - math.0.0.1 - - annot.0.0.1 - - code.0.0.1 - - footnote-scheme.0.0.1 - - itemize.0.0.1 - - font-junicode.0.0.1 - - font-latin-modern.0.0.1 - - font-ipa-ex.0.0.1 - - font-latin-modern-math.0.0.1 -- name: stdlib.0.0.1 - location: - type: global - path: ./dist/packages/stdlib/stdlib.0.0.1/ - dependencies: [] diff --git a/tests/md/test.satysfi-lock-expected b/tests/md/test.satysfi-lock-expected index fdcf76576..1f15d14a7 100644 --- a/tests/md/test.satysfi-lock-expected +++ b/tests/md/test.satysfi-lock-expected @@ -5,6 +5,7 @@ locks: path: ./dist/packages/annot/annot.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: code.0.0.1 location: type: global @@ -12,44 +13,52 @@ locks: dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 + test_only: false - name: font-ipa-ex.0.0.1 location: type: global path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ dependencies: [] + test_only: false - name: font-junicode.0.0.1 location: type: global path: ./dist/packages/font-junicode/font-junicode.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern.0.0.1 location: type: global path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern-math.0.0.1 location: type: global path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ dependencies: [] + test_only: false - name: footnote-scheme.0.0.1 location: type: global path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: itemize.0.0.1 location: type: global path: ./dist/packages/itemize/itemize.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: math.0.0.1 location: type: global path: ./dist/packages/math/math.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: md-ja.0.0.1 location: type: global @@ -65,8 +74,10 @@ locks: - font-latin-modern.0.0.1 - font-ipa-ex.0.0.1 - font-latin-modern-math.0.0.1 + test_only: false - name: stdlib.0.0.1 location: type: global path: ./dist/packages/stdlib/stdlib.0.0.1/ dependencies: [] + test_only: false diff --git a/tests/refactor1.satysfi-lock-expected b/tests/refactor1.satysfi-lock-expected index 440316850..607c96b56 100644 --- a/tests/refactor1.satysfi-lock-expected +++ b/tests/refactor1.satysfi-lock-expected @@ -4,24 +4,29 @@ locks: type: global path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ dependencies: [] + test_only: false - name: font-junicode.0.0.1 location: type: global path: ./dist/packages/font-junicode/font-junicode.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern-math.0.0.1 location: type: global path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ dependencies: [] + test_only: false - name: math.0.0.1 location: type: global path: ./dist/packages/math/math.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: stdlib.0.0.1 location: type: global path: ./dist/packages/stdlib/stdlib.0.0.1/ dependencies: [] + test_only: false diff --git a/tests/refactor2.satysfi-lock-expected b/tests/refactor2.satysfi-lock-expected index 46ca436ae..b0560eef0 100644 --- a/tests/refactor2.satysfi-lock-expected +++ b/tests/refactor2.satysfi-lock-expected @@ -4,13 +4,16 @@ locks: type: global path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ dependencies: [] + test_only: false - name: font-junicode.0.0.1 location: type: global path: ./dist/packages/font-junicode/font-junicode.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern-math.0.0.1 location: type: global path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ dependencies: [] + test_only: false diff --git a/tests/refactor3.satysfi-lock-expected b/tests/refactor3.satysfi-lock-expected index 46ca436ae..b0560eef0 100644 --- a/tests/refactor3.satysfi-lock-expected +++ b/tests/refactor3.satysfi-lock-expected @@ -4,13 +4,16 @@ locks: type: global path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ dependencies: [] + test_only: false - name: font-junicode.0.0.1 location: type: global path: ./dist/packages/font-junicode/font-junicode.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern-math.0.0.1 location: type: global path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ dependencies: [] + test_only: false diff --git a/tests/refactor5.satysfi-lock-expected b/tests/refactor5.satysfi-lock-expected index 46ca436ae..b0560eef0 100644 --- a/tests/refactor5.satysfi-lock-expected +++ b/tests/refactor5.satysfi-lock-expected @@ -4,13 +4,16 @@ locks: type: global path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ dependencies: [] + test_only: false - name: font-junicode.0.0.1 location: type: global path: ./dist/packages/font-junicode/font-junicode.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern-math.0.0.1 location: type: global path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ dependencies: [] + test_only: false diff --git a/tests/staged1.satysfi-lock-expected b/tests/staged1.satysfi-lock-expected index 3ec050ba9..fa57d1904 100644 --- a/tests/staged1.satysfi-lock-expected +++ b/tests/staged1.satysfi-lock-expected @@ -5,6 +5,7 @@ locks: path: ./dist/packages/annot/annot.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: code.0.0.1 location: type: global @@ -12,32 +13,38 @@ locks: dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 + test_only: false - name: font-ipa-ex.0.0.1 location: type: global path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ dependencies: [] + test_only: false - name: font-junicode.0.0.1 location: type: global path: ./dist/packages/font-junicode/font-junicode.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern.0.0.1 location: type: global path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern-math.0.0.1 location: type: global path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ dependencies: [] + test_only: false - name: math.0.0.1 location: type: global path: ./dist/packages/math/math.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: std-ja.0.0.1 location: type: global @@ -51,8 +58,10 @@ locks: - font-latin-modern.0.0.1 - font-ipa-ex.0.0.1 - font-latin-modern-math.0.0.1 + test_only: false - name: stdlib.0.0.1 location: type: global path: ./dist/packages/stdlib/stdlib.0.0.1/ dependencies: [] + test_only: false From c61b4d59daf59ce5bca56eaa0678bce8d1ace897 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 16 Nov 2022 04:07:09 +0900 Subject: [PATCH 179/288] take 'test_only' in lock files into account when building --- src/frontend/closedLockDependencyResolver.ml | 57 ++++++++++---------- src/frontend/main.ml | 8 +-- 2 files changed, 34 insertions(+), 31 deletions(-) diff --git a/src/frontend/closedLockDependencyResolver.ml b/src/frontend/closedLockDependencyResolver.ml index 6dfcdd142..68ccbaf6c 100644 --- a/src/frontend/closedLockDependencyResolver.ml +++ b/src/frontend/closedLockDependencyResolver.ml @@ -10,7 +10,7 @@ type 'a ok = ('a, config_error) result module LockDependencyGraph = DependencyGraph.Make(String) -let main ~(lock_config_dir : abs_path) ~(extensions : string list) (lock_config : LockConfig.t) : ((lock_name * (PackageConfig.t * untyped_package)) list) ok = +let main ~(use_test_only_lock : bool) ~(lock_config_dir : abs_path) ~(extensions : string list) (lock_config : LockConfig.t) : ((lock_name * (PackageConfig.t * untyped_package)) list) ok = let open ResultMonad in let locks = lock_config.LockConfig.locked_packages in @@ -18,33 +18,36 @@ let main ~(lock_config_dir : abs_path) ~(extensions : string list) (lock_config (* Add vertices: *) let* (graph, entryacc) = locks |> foldM (fun (graph, entryacc) (lock : LockConfig.locked_package) -> - let lock_name = lock.lock_name in - let* absdir_package = - match lock.lock_location with - | GlobalLocation{ path = s_libpath } -> - let libpath = make_lib_path s_libpath in - begin - match Config.resolve_lib_file libpath with - | Ok(abspath) -> return abspath - | Error(candidates) -> err @@ LockedPackageNotFound(libpath, candidates) - end + let LockConfig.{ lock_name; lock_location; lock_dependencies; test_only_lock } = lock in + if test_only_lock && not use_test_only_lock then + return (graph, entryacc) + else + let* absdir_package = + match lock_location with + | GlobalLocation{ path = s_libpath } -> + let libpath = make_lib_path s_libpath in + begin + match Config.resolve_lib_file libpath with + | Ok(abspath) -> return abspath + | Error(candidates) -> err @@ LockedPackageNotFound(libpath, candidates) + end - | LocalLocation{ path = s_relpath } -> - return (make_abs_path (Filename.concat (get_abs_path_string lock_config_dir) s_relpath)) - in - let* package_with_config = PackageReader.main ~extensions absdir_package in - let* (graph, vertex) = - graph |> LockDependencyGraph.add_vertex lock_name package_with_config - |> Result.map_error (fun _ -> LockNameConflict(lock_name)) - in - let lock_info = - { - lock_name; - lock_directory = absdir_package; - lock_dependencies = lock.lock_dependencies; - } - in - return (graph, Alist.extend entryacc (lock_info, vertex)) + | LocalLocation{ path = s_relpath } -> + return (make_abs_path (Filename.concat (get_abs_path_string lock_config_dir) s_relpath)) + in + let* package_with_config = PackageReader.main ~extensions absdir_package in + let* (graph, vertex) = + graph |> LockDependencyGraph.add_vertex lock_name package_with_config + |> Result.map_error (fun _ -> LockNameConflict(lock_name)) + in + let lock_info = + { + lock_name; + lock_directory = absdir_package; + lock_dependencies; + } + in + return (graph, Alist.extend entryacc (lock_info, vertex)) ) (LockDependencyGraph.empty, Alist.empty) in diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 9bd954099..3594bbd8c 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1361,10 +1361,10 @@ let get_input_kind_from_extension (abspathstr_in : string) = | ext -> Error(ext) -let check_depended_packages ~(lock_config_dir : abs_path) ~(extensions : string list) (tyenv_prim : Typeenv.t) (lock_config : LockConfig.t) = +let check_depended_packages ~(use_test_only_lock : bool) ~(lock_config_dir : abs_path) ~(extensions : string list) (tyenv_prim : Typeenv.t) (lock_config : LockConfig.t) = (* Resolve dependency among locked packages: *) let sorted_packages = - match ClosedLockDependencyResolver.main ~lock_config_dir ~extensions lock_config with + match ClosedLockDependencyResolver.main ~use_test_only_lock ~lock_config_dir ~extensions lock_config with | Ok(sorted_packages) -> sorted_packages | Error(e) -> raise (ConfigError(e)) in @@ -1503,7 +1503,7 @@ let build let (genv, _configenv, _libs_dep) = let lock_config_dir = make_abs_path (Filename.dirname (get_abs_path_string abspath_lock_config)) in - check_depended_packages ~lock_config_dir ~extensions tyenv_prim lock_config + check_depended_packages ~use_test_only_lock:false ~lock_config_dir ~extensions tyenv_prim lock_config in begin @@ -1532,7 +1532,7 @@ let build let (genv, configenv, libs) = let lock_config_dir = make_abs_path (Filename.dirname (get_abs_path_string abspath_lock_config)) in - check_depended_packages ~lock_config_dir ~extensions tyenv_prim lock_config + check_depended_packages ~use_test_only_lock:false ~lock_config_dir ~extensions tyenv_prim lock_config in (* Resolve dependency of the document and the local source files: *) From c0fae46ebe2970123475d0f28ec617335de4df00 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 16 Nov 2022 04:10:10 +0900 Subject: [PATCH 180/288] update tests --- tests/math-typefaces.satysfi-lock-expected | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/tests/math-typefaces.satysfi-lock-expected b/tests/math-typefaces.satysfi-lock-expected index 3162e6d52..255558b23 100644 --- a/tests/math-typefaces.satysfi-lock-expected +++ b/tests/math-typefaces.satysfi-lock-expected @@ -5,6 +5,7 @@ locks: path: ./dist/packages/annot/annot.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: code.0.0.1 location: type: global @@ -12,44 +13,52 @@ locks: dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 + test_only: false - name: font-ipa-ex.0.0.1 location: type: global path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ dependencies: [] + test_only: false - name: font-junicode.0.0.1 location: type: global path: ./dist/packages/font-junicode/font-junicode.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern.0.0.1 location: type: global path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ dependencies: [] + test_only: false - name: font-latin-modern-math.0.0.1 location: type: global path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ dependencies: [] + test_only: false - name: footnote-scheme.0.0.1 location: type: global path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: itemize.0.0.1 location: type: global path: ./dist/packages/itemize/itemize.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: math.0.0.1 location: type: global path: ./dist/packages/math/math.0.0.1/ dependencies: - stdlib.0.0.1 + test_only: false - name: std-ja-report.0.0.1 location: type: global @@ -64,8 +73,10 @@ locks: - font-latin-modern.0.0.1 - font-ipa-ex.0.0.1 - font-latin-modern-math.0.0.1 + test_only: false - name: stdlib.0.0.1 location: type: global path: ./dist/packages/stdlib/stdlib.0.0.1/ dependencies: [] + test_only: false From 3f8ccf61371c91000b9529847fecc8dcc4028c6a Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 16 Nov 2022 04:10:41 +0900 Subject: [PATCH 181/288] remove printf for debugging --- src/frontend/packageConstraintSolver.ml | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/frontend/packageConstraintSolver.ml b/src/frontend/packageConstraintSolver.ml index f2dcb93ed..abdcb3500 100644 --- a/src/frontend/packageConstraintSolver.ml +++ b/src/frontend/packageConstraintSolver.ml @@ -255,7 +255,6 @@ let solve (context : package_context) (dependencies_with_flags : (dependency_fla | SourceDependency -> explicit_source_dependencies |> PackageNameSet.add package_name | TestOnlyDependency -> explicit_source_dependencies in - Format.printf "**** FLAG %s (%a)\n" package_name pp_dependency_flag flag; (* TODO: remove this *) (explicit_source_dependencies, Alist.extend dependency_acc dep) ) (PackageNameSet.empty, Alist.empty) in @@ -279,7 +278,6 @@ let solve (context : package_context) (dependencies_with_flags : (dependency_fla acc | Impl{ package_name; version = locked_version; dependencies; _ } -> - Format.printf "**** VERTEX %s\n" package_name; (* TODO: remove this *) let (quad_acc, graph, explicit_vertices, name_to_vertex_map) = acc in let (graph, vertex) = match graph |> LockDependencyGraph.add_vertex package_name () with @@ -323,7 +321,6 @@ let solve (context : package_context) (dependencies_with_flags : (dependency_fla | None -> assert false | Some(v) -> v in - Format.printf "**** DEP %s ---> %s\n" package_name package_name_dep; (* TODO: remove this *) let graph = graph |> LockDependencyGraph.add_edge ~from:vertex ~to_:vertex_dep in (locked_dependency_acc, graph) @@ -352,7 +349,6 @@ let solve (context : package_context) (dependencies_with_flags : (dependency_fla | Some(v) -> v in let used_in_test_only = not (resulting_source_dependencies |> VertexSet.mem vertex) in - Format.printf "**** RESULT %B <- %s\n" used_in_test_only package_name; (* TODO: remove this *) Alist.extend solution_acc { package_name; locked_version; From 6cd9ed6c2e74563554e4649801b51920f88673ee Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 16 Nov 2022 05:32:39 +0900 Subject: [PATCH 182/288] make 'val' bindings support attributes --- src/frontend/moduleTypechecker.ml | 6 ++--- src/frontend/parser.mly | 20 ++++++++-------- src/frontend/types.cppo.ml | 10 ++++---- test/parsing/parser.expected | 38 +++++++++++++++---------------- 4 files changed, 37 insertions(+), 37 deletions(-) diff --git a/src/frontend/moduleTypechecker.ml b/src/frontend/moduleTypechecker.ml index c912ecd36..14e9c4101 100644 --- a/src/frontend/moduleTypechecker.ml +++ b/src/frontend/moduleTypechecker.ml @@ -733,7 +733,7 @@ and typecheck_binding (tyenv : Typeenv.t) (utbind : untyped_binding) : (binding let open ResultMonad in let (_, utbindmain) = utbind in match utbindmain with - | UTBindValue(stage, valbind) -> + | UTBindValue(_attrs, stage, valbind) -> let pre = { stage = stage; @@ -869,7 +869,7 @@ and typecheck_binding (tyenv : Typeenv.t) (utbind : untyped_binding) : (binding err (NotAStructureSignature(rng_mod, fsig)) end - | UTBindInlineMacro((rng_cs, csnm), macparams, utast1) -> + | UTBindInlineMacro(_attrs, (rng_cs, csnm), macparams, utast1) -> let pre = { stage = Stage1; @@ -896,7 +896,7 @@ and typecheck_binding (tyenv : Typeenv.t) (utbind : untyped_binding) : (binding let binds = [ Bind(Stage0, NonRec(evid, abstraction_list evids (Next(e1)))) ] in return (binds, (OpaqueIDMap.empty, ssig)) - | UTBindBlockMacro((rng_cs, csnm), macparams, utast1) -> + | UTBindBlockMacro(_attrs, (rng_cs, csnm), macparams, utast1) -> let pre = { stage = Stage1; diff --git a/src/frontend/parser.mly b/src/frontend/parser.mly index 36f9f1f37..b6f4d1e9d 100644 --- a/src/frontend/parser.mly +++ b/src/frontend/parser.mly @@ -432,21 +432,21 @@ mod_chain: } ; bind: - | tokL=VAL; valbind=bind_value - { (tokL, UTBindValue(Stage1, valbind)) } - | tokL=VAL; EXACT_TILDE; valbind=bind_value - { (tokL, UTBindValue(Stage0, valbind)) } - | tokL=VAL; PERSISTENT; EXACT_TILDE; valbind=bind_value - { (tokL, UTBindValue(Persistent0, valbind)) } - | tokL=VAL; INLINE; imacrobind=bind_inline_macro + | attrs=list(attribute); tokL=VAL; valbind=bind_value + { (tokL, UTBindValue(attrs, Stage1, valbind)) } + | attrs=list(attribute); tokL=VAL; EXACT_TILDE; valbind=bind_value + { (tokL, UTBindValue(attrs, Stage0, valbind)) } + | attrs=list(attribute); tokL=VAL; PERSISTENT; EXACT_TILDE; valbind=bind_value + { (tokL, UTBindValue(attrs, Persistent0, valbind)) } + | attrs=list(attribute); tokL=VAL; INLINE; imacrobind=bind_inline_macro { let (rng_cs, csnm, macparams, utast1) = imacrobind in - (tokL, UTBindInlineMacro((rng_cs, csnm), macparams, utast1)) + (tokL, UTBindInlineMacro(attrs, (rng_cs, csnm), macparams, utast1)) } - | tokL=VAL; BLOCK; bmacrobind=bind_block_macro + | attrs=list(attribute); tokL=VAL; BLOCK; bmacrobind=bind_block_macro { let (rng_cs, csnm, macparams, utast1) = bmacrobind in - (tokL, UTBindBlockMacro((rng_cs, csnm), macparams, utast1)) + (tokL, UTBindBlockMacro(attrs, (rng_cs, csnm), macparams, utast1)) } | tokL=TYPE; uttypebind=bind_type { (tokL, UTBindType(uttypebind)) } diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index be34bda99..d898f5184 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -362,13 +362,13 @@ type untyped_binding = untyped_binding_main ranged and untyped_binding_main = - | UTBindValue of stage * untyped_rec_or_nonrec + | UTBindValue of untyped_attribute list * stage * untyped_rec_or_nonrec | UTBindType of untyped_type_binding list | UTBindModule of module_name ranged * untyped_signature option * untyped_module | UTBindSignature of signature_name ranged * untyped_signature | UTBindInclude of untyped_module - | UTBindInlineMacro of command_name ranged * untyped_macro_parameter list * untyped_abstract_tree - | UTBindBlockMacro of command_name ranged * untyped_macro_parameter list * untyped_abstract_tree + | UTBindInlineMacro of untyped_attribute list * command_name ranged * untyped_macro_parameter list * untyped_abstract_tree + | UTBindBlockMacro of untyped_attribute list * command_name ranged * untyped_macro_parameter list * untyped_abstract_tree and untyped_module = untyped_module_main ranged @@ -580,11 +580,11 @@ and untyped_parameter_unit = | UTParameterUnit of (label ranged * var_name ranged) list * untyped_pattern_tree * manual_type option [@@deriving show { with_path = false; }] -type untyped_attribute_main = +and untyped_attribute_main = | UTAttribute of attribute_name * untyped_abstract_tree [@@deriving show { with_path = false; }] -type untyped_attribute = +and untyped_attribute = untyped_attribute_main ranged [@@deriving show { with_path = false; }] diff --git a/test/parsing/parser.expected b/test/parsing/parser.expected index c34444624..8b5e9458c 100644 --- a/test/parsing/parser.expected +++ b/test/parsing/parser.expected @@ -6,7 +6,7 @@ ([], [], (((Range.Normal ), "Nx"), None, [((Range.Normal ), - (UTBindValue (Stage1, + (UTBindValue ([], Stage1, (UTNonRec (((Range.Normal ), "xs"), (UTListCons ((UTIntegerConstant 1), @@ -15,7 +15,7 @@ )))) ))); ((Range.Normal ), - (UTBindValue (Stage1, + (UTBindValue ([], Stage1, (UTNonRec (((Range.Normal ), "ys"), (UTListCons ((UTIntegerConstant 1), @@ -24,11 +24,11 @@ )))) ))); ((Range.Normal ), - (UTBindValue (Stage1, + (UTBindValue ([], Stage1, (UTNonRec (((Range.Normal ), "r0"), (UTRecord []))) ))); ((Range.Normal ), - (UTBindValue (Stage1, + (UTBindValue ([], Stage1, (UTNonRec (((Range.Normal ), "r1"), (UTRecord @@ -36,7 +36,7 @@ (UTIntegerConstant 1))]))) ))); ((Range.Normal ), - (UTBindValue (Stage1, + (UTBindValue ([], Stage1, (UTNonRec (((Range.Normal ), "r2"), (UTRecord @@ -47,7 +47,7 @@ ]))) ))); ((Range.Normal ), - (UTBindValue (Stage1, + (UTBindValue ([], Stage1, (UTNonRec (((Range.Normal ), "r2semi"), (UTRecord @@ -58,20 +58,20 @@ ]))) ))); ((Range.Normal ), - (UTBindValue (Stage1, + (UTBindValue ([], Stage1, (UTNonRec (((Range.Normal ), "tp2"), (UTTuple (UTIntegerConstant 1) (UTIntegerConstant 2) ))) ))); ((Range.Normal ), - (UTBindValue (Stage1, + (UTBindValue ([], Stage1, (UTNonRec (((Range.Normal ), "tp3"), (UTTuple (UTIntegerConstant 1) (UTIntegerConstant 2) (UTIntegerConstant 3)))) ))); ((Range.Normal ), - (UTBindValue (Stage1, + (UTBindValue ([], Stage1, (UTNonRec (((Range.Normal ), "op-test"), (UTTuple @@ -619,7 +619,7 @@ ))))) ))); ((Range.Normal ), - (UTBindValue (Stage1, + (UTBindValue ([], Stage1, (UTNonRec (((Range.Normal ), "uminus"), (UTTuple @@ -851,7 +851,7 @@ ([], [], (((Range.Normal ), "Pats"), None, [((Range.Normal ), - (UTBindValue (Stage1, + (UTBindValue ([], Stage1, (UTNonRec (((Range.Normal ), "pats-test1"), (UTPatternMatch ( @@ -866,7 +866,7 @@ )))) ))); ((Range.Normal ), - (UTBindValue (Stage1, + (UTBindValue ([], Stage1, (UTNonRec (((Range.Normal ), "pats-test2"), (UTPatternMatch ( @@ -887,7 +887,7 @@ ([], [], (((Range.Normal ), "Pattuple"), None, [((Range.Normal ), - (UTBindValue (Stage1, + (UTBindValue ([], Stage1, (UTNonRec (((Range.Normal ), "pattuple-test"), (UTPatternMatch ( @@ -914,7 +914,7 @@ ([], [], (((Range.Normal ), "Patlist"), None, [((Range.Normal ), - (UTBindValue (Stage1, + (UTBindValue ([], Stage1, (UTNonRec (((Range.Normal ), "pat-test"), (UTPatternMatch ( @@ -969,11 +969,11 @@ ([], [], (((Range.Normal ), "Sxlist"), None, [((Range.Normal ), - (UTBindValue (Stage1, + (UTBindValue ([], Stage1, (UTNonRec (((Range.Normal ), "x"), UTEndOfList)) ))); ((Range.Normal ), - (UTBindValue (Stage1, + (UTBindValue ([], Stage1, (UTNonRec (((Range.Normal ), "y"), (UTListCons ((UTInlineText [IT:aa]), @@ -986,12 +986,12 @@ ([], [], (((Range.Normal ), "Mathlist"), None, [((Range.Normal ), - (UTBindValue (Stage1, + (UTBindValue ([], Stage1, (UTNonRec (((Range.Normal ), "x"), UTEndOfList)) ))); ((Range.Normal ), - (UTBindValue (Stage1, + (UTBindValue ([], Stage1, (UTNonRec (((Range.Normal ), "y"), (UTListCons ( @@ -1013,7 +1013,7 @@ )))) ))); ((Range.Normal ), - (UTBindValue (Stage1, + (UTBindValue ([], Stage1, (UTNonRec (((Range.Normal ), "z"), (UTBlockText From aa6840d0700e1f6d22b438586fbab440a6580b67 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 16 Nov 2022 06:30:58 +0900 Subject: [PATCH 183/288] make 'val' bindings support '#[test]' attributes --- src/frontend/documentAttribute.ml | 6 +- src/frontend/evaluator.cppo.ml | 83 ++++++++------- src/frontend/evaluator.mli | 2 +- src/frontend/main.ml | 30 ++++-- src/frontend/moduleTypechecker.ml | 166 +++++++++++++++++------------- src/frontend/parser.mly | 7 +- src/frontend/typeError.ml | 2 + src/frontend/types.cppo.ml | 5 +- src/frontend/valueAttribute.ml | 23 +++++ src/md/markdownParser.ml | 2 +- 10 files changed, 206 insertions(+), 120 deletions(-) create mode 100644 src/frontend/valueAttribute.ml diff --git a/src/frontend/documentAttribute.ml b/src/frontend/documentAttribute.ml index fb656c602..c1edf8cd8 100644 --- a/src/frontend/documentAttribute.ml +++ b/src/frontend/documentAttribute.ml @@ -4,6 +4,7 @@ open PackageSystemBase type error = + | NoDependencyList of Range.t | MoreThanOneDependencyAttribute of Range.t * Range.t | NotASemanticVersion of Range.t * string | NotAPackageDependency of Range.t @@ -75,9 +76,12 @@ let make (attrs : untyped_attribute list) : t ok = | [] -> return { dependencies = [] } - | [ (_, utast) ] -> + | [ (_, Some(utast)) ] -> let* dependencies = decode_dependencies utast in return { dependencies } + | [ (rng, None) ] -> + err @@ NoDependencyList(rng) + | (rng1, _) :: (rng2, _) :: _ -> err @@ MoreThanOneDependencyAttribute(rng1, rng2) diff --git a/src/frontend/evaluator.cppo.ml b/src/frontend/evaluator.cppo.ml index 090ba3e65..6696f9ed0 100644 --- a/src/frontend/evaluator.cppo.ml +++ b/src/frontend/evaluator.cppo.ml @@ -1166,45 +1166,58 @@ and interpret_letrec_bindings_1 (env : environment) (recbinds : letrec_binding l (env, cdrecbinds) -let interpret_bindings_0 (env : environment) (binds : binding list) : environment * code_rec_or_nonrec list = +let interpret_bindings_0 ~(run_tests : bool) (env : environment) (binds : binding list) : environment * code_rec_or_nonrec list = let (env, acc) = - binds |> List.fold_left (fun (env, acc) (Bind(stage, rec_or_nonrec)) -> - match stage with - | Persistent0 | Stage0 -> - let env = - match rec_or_nonrec with - | NonRec(evid, ast) -> - let value = interpret_0 env ast in - add_to_environment env evid (ref value) - - | Rec(recbinds) -> - add_letrec_bindings_to_environment env recbinds - - | Mutable(evid, ast_ini) -> - let value_ini = interpret_0 env ast_ini in - let stid = register_location env value_ini in - add_to_environment env evid (ref (Location(stid))) - in - (env, acc) - - | Stage1 -> + binds |> List.fold_left (fun (env, acc) bind -> + match bind with + | Bind(stage, rec_or_nonrec) -> begin - match rec_or_nonrec with - | NonRec(evid, ast) -> - let code = interpret_1 env ast in - let (env, symb) = generate_symbol_for_eval_var_id evid env in - (env, Alist.extend acc (CdNonRec(symb, code))) - - | Rec(recbinds) -> - let (env, cdrecbinds) = interpret_letrec_bindings_1 env recbinds in - (env, Alist.extend acc (CdRec(cdrecbinds))) - - | Mutable(evid, ast) -> - let code = interpret_1 env ast in - let (env, symb) = generate_symbol_for_eval_var_id evid env in - (env, Alist.extend acc (CdMutable(symb, code))) + match stage with + | Persistent0 | Stage0 -> + let env = + match rec_or_nonrec with + | NonRec(evid, ast) -> + let value = interpret_0 env ast in + add_to_environment env evid (ref value) + + | Rec(recbinds) -> + add_letrec_bindings_to_environment env recbinds + + | Mutable(evid, ast_ini) -> + let value_ini = interpret_0 env ast_ini in + let stid = register_location env value_ini in + add_to_environment env evid (ref (Location(stid))) + in + (env, acc) + + | Stage1 -> + let (env, cdbind) = + match rec_or_nonrec with + | NonRec(evid, ast) -> + let code = interpret_1 env ast in + let (env, symb) = generate_symbol_for_eval_var_id evid env in + (env, CdNonRec(symb, code)) + + | Rec(recbinds) -> + let (env, cdrecbinds) = interpret_letrec_bindings_1 env recbinds in + (env, CdRec(cdrecbinds)) + + | Mutable(evid, ast) -> + let code = interpret_1 env ast in + let (env, symb) = generate_symbol_for_eval_var_id evid env in + (env, CdMutable(symb, code)) + in + (env, Alist.extend acc cdbind) end + | BindTest(evid, ast) -> + if run_tests then + let code = interpret_1 env ast in + let (env, symb) = generate_symbol_for_eval_var_id evid env in + (env, Alist.extend acc (CdNonRec(symb, code))) + else + (env, acc) + ) (env, Alist.empty) in (env, acc |> Alist.to_list) diff --git a/src/frontend/evaluator.mli b/src/frontend/evaluator.mli index cb17a1be0..966b9285a 100644 --- a/src/frontend/evaluator.mli +++ b/src/frontend/evaluator.mli @@ -6,6 +6,6 @@ val interpret_0 : environment -> abstract_tree -> syntactic_value val interpret_1 : environment -> abstract_tree -> code_value -val interpret_bindings_0 : environment -> binding list -> environment * code_rec_or_nonrec list +val interpret_bindings_0 : run_tests:bool -> environment -> binding list -> environment * code_rec_or_nonrec list val select_pattern : Range.t -> environment -> syntactic_value -> pattern_branch list -> syntactic_value diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 3594bbd8c..d9e485920 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -84,7 +84,7 @@ let output_text (abspath_out : abs_path) (data : string) : unit = Core.Out_channel.write_all (get_abs_path_string abspath_out) ~data -let eval_library_file (env : environment) (abspath : abs_path) (binds : binding list) : environment = +let eval_library_file ~(run_tests : bool) (env : environment) (abspath : abs_path) (binds : binding list) : environment = Logging.begin_to_eval_file abspath; if OptionState.is_bytecomp_mode () then failwith "TODO: eval_libary_file, Bytecomp" @@ -93,7 +93,7 @@ let eval_library_file (env : environment) (abspath : abs_path) (binds : binding add_to_environment env evid (ref value) *) else - let (env, _) = Evaluator.interpret_bindings_0 env binds in + let (env, _) = Evaluator.interpret_bindings_0 ~run_tests env binds in env @@ -179,7 +179,7 @@ let eval_document_file (env : environment) (ast : abstract_tree) (abspath_out : aux 1 -let preprocess_and_evaluate (env : environment) (libs : (abs_path * binding list) list) (ast_doc : abstract_tree) (_abspath_in : abs_path) (abspath_out : abs_path) (abspath_dump : abs_path) = +let preprocess_and_evaluate ~(run_tests : bool) (env : environment) (libs : (abs_path * binding list) list) (ast_doc : abstract_tree) (_abspath_in : abs_path) (abspath_out : abs_path) (abspath_dump : abs_path) = (* Performs preprecessing: each evaluation called in `preprocess` is run by the naive interpreter @@ -187,7 +187,7 @@ let preprocess_and_evaluate (env : environment) (libs : (abs_path * binding list let (env, codebindacc) = libs |> List.fold_left (fun (env, codebindacc) (abspath, binds) -> Logging.begin_to_preprocess_file abspath; - let (env, cd_rec_or_nonrecs) = Evaluator.interpret_bindings_0 env binds in + let (env, cd_rec_or_nonrecs) = Evaluator.interpret_bindings_0 ~run_tests env binds in (env, Alist.extend codebindacc (abspath, cd_rec_or_nonrecs)) ) (env, Alist.empty) in @@ -202,7 +202,7 @@ let preprocess_and_evaluate (env : environment) (libs : (abs_path * binding list Bind(Stage0, unlift_rec_or_nonrec cd_rec_or_nonrec) ) in - eval_library_file env abspath binds + eval_library_file ~run_tests env abspath binds ) env in let ast_doc = unlift_code code_doc in @@ -770,6 +770,18 @@ let report_type_error = function NormalLine(Printf.sprintf "synonym type '%s' is defined more than once." tynm); ] + | ValueAttributeError(ValueAttribute.Unexpected(rng)) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine("unexpected value attributes."); + ] + + | TestMustBeStage1NonRec(rng) -> + report_error Typechecker [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine("tests must be stage-1 non-recursive bindings."); + ] + let show_yaml_context (context : YamlDecoder.context) = match context with @@ -826,6 +838,12 @@ let make_yaml_error_lines : yaml_error -> line list = function let report_document_attribute_error : DocumentAttribute.error -> unit = function + | NoDependencyList(rng) -> + report_error Interface [ + NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); + NormalLine("no dependency is given."); + ] + | MoreThanOneDependencyAttribute(rng1, rng2) -> report_error Interface [ NormalLine("More than one attribute defines dependencies:"); @@ -1552,7 +1570,7 @@ let build if type_check_only then () else - preprocess_and_evaluate env libs ast_doc abspath_in abspath_out abspath_dump + preprocess_and_evaluate ~run_tests:false env libs ast_doc abspath_in abspath_out abspath_dump ) diff --git a/src/frontend/moduleTypechecker.ml b/src/frontend/moduleTypechecker.ml index 14e9c4101..4dc70d63a 100644 --- a/src/frontend/moduleTypechecker.ml +++ b/src/frontend/moduleTypechecker.ml @@ -729,11 +729,47 @@ and typecheck_binding_list (tyenv : Typeenv.t) (utbinds : untyped_binding list) return ((quant, ssig), binds) +and typecheck_nonrec (pre : pre) (tyenv : Typeenv.t) (ident : var_name ranged) (utast1 : untyped_abstract_tree) = + let open ResultMonad in + let presub = { pre with level = Level.succ pre.level; } in + let (_, varnm) = ident in + let evid = EvalVarID.fresh ident in + let* (e1_raw, ty1) = Typechecker.typecheck presub tyenv utast1 in + let e1 = e1_raw in +(* + tyannot |> Option.map (fun mnty -> + let tyA = decode_manual_type pre tyenv mnty in + unify ty1 tyA + ) |> ignore; +*) +(* + let should_be_polymorphic = is_nonexpansive_expression e1 in +*) + let should_be_polymorphic = true in + let ssig = + let pty = + if should_be_polymorphic then + TypeConv.generalize pre.level (TypeConv.erase_range_of_type ty1) + else + TypeConv.lift_poly (TypeConv.erase_range_of_type ty1) + in + let ventry = + { + val_type = pty; + val_name = Some(evid); + val_stage = pre.stage; + } + in + StructSig.empty |> StructSig.add_value varnm ventry + in + return (evid, e1, ssig) + + and typecheck_binding (tyenv : Typeenv.t) (utbind : untyped_binding) : (binding list * StructSig.t abstracted) ok = let open ResultMonad in let (_, utbindmain) = utbind in match utbindmain with - | UTBindValue(_attrs, stage, valbind) -> + | UTBindValue(attrs, stage, valbind) -> let pre = { stage = stage; @@ -743,81 +779,65 @@ and typecheck_binding (tyenv : Typeenv.t) (utbind : untyped_binding) : (binding level = Level.bottom; } in - let* (rec_or_nonrecs, ssig) = - match valbind with - | UTNonRec(ident, utast1) -> - let presub = { pre with level = Level.succ pre.level; } in - let (_, varnm) = ident in - let evid = EvalVarID.fresh ident in - let* (e1_raw, ty1) = Typechecker.typecheck presub tyenv utast1 in - let e1 = e1_raw in -(* - tyannot |> Option.map (fun mnty -> - let tyA = decode_manual_type pre tyenv mnty in - unify ty1 tyA - ) |> ignore; -*) -(* - let should_be_polymorphic = is_nonexpansive_expression e1 in -*) - let should_be_polymorphic = true in - let ssig = - let pty = - if should_be_polymorphic then - TypeConv.generalize pre.level (TypeConv.erase_range_of_type ty1) - else - TypeConv.lift_poly (TypeConv.erase_range_of_type ty1) - in - let ventry = - { - val_type = pty; - val_name = Some(evid); - val_stage = pre.stage; - } - in - StructSig.empty |> StructSig.add_value varnm ventry - in - return ([ NonRec(evid, e1) ], ssig) - - | UTRec(utrecbinds) -> - let* quints = Typechecker.typecheck_letrec pre tyenv utrecbinds in - let (recbindacc, ssig) = - quints |> List.fold_left (fun (recbindacc, ssig) quint -> - let (x, pty, evid, recbind) = quint in - let ssig = - let ventry = - { - val_type = pty; - val_name = Some(evid); - val_stage = stage; - } + let* valattr = + ValueAttribute.make attrs + |> Result.map_error (fun e -> ValueAttributeError(e)) + in + if valattr.ValueAttribute.is_test then + match (stage, valbind) with + | (Stage1, UTNonRec(ident, utast1)) -> + let* (evid, e1, ssig) = typecheck_nonrec pre tyenv ident utast1 in + return ([ BindTest(evid, e1) ], (OpaqueIDMap.empty, ssig)) + + | _ -> + let rng = Range.dummy "TODO (error): typecheck_binding, test" in + err @@ TestMustBeStage1NonRec(rng) + else + let* (rec_or_nonrecs, ssig) = + match valbind with + | UTNonRec(ident, utast1) -> + let* (evid, e1, ssig) = typecheck_nonrec pre tyenv ident utast1 in + return ([ NonRec(evid, e1) ], ssig) + + | UTRec(utrecbinds) -> + let* quints = Typechecker.typecheck_letrec pre tyenv utrecbinds in + let (recbindacc, ssig) = + quints |> List.fold_left (fun (recbindacc, ssig) quint -> + let (x, pty, evid, recbind) = quint in + let ssig = + let ventry = + { + val_type = pty; + val_name = Some(evid); + val_stage = stage; + } + in + ssig |> StructSig.add_value x ventry in - ssig |> StructSig.add_value x ventry + let recbindacc = Alist.extend recbindacc recbind in + (recbindacc, ssig) + ) (Alist.empty, StructSig.empty) + in + return ([ Rec(recbindacc |> Alist.to_list) ], ssig) + + | UTMutable((rng, varnm) as var, utastI) -> + let* (eI, tyI) = Typechecker.typecheck { pre with quantifiability = Unquantifiable; } tyenv utastI in + let evid = EvalVarID.fresh var in + let pty = TypeConv.lift_poly (rng, RefType(tyI)) in + let ssig = + let ventry = + { + val_type = pty; + val_name = Some(evid); + val_stage = pre.stage; + } in - let recbindacc = Alist.extend recbindacc recbind in - (recbindacc, ssig) - ) (Alist.empty, StructSig.empty) - in - return ([ Rec(recbindacc |> Alist.to_list) ], ssig) - - | UTMutable((rng, varnm) as var, utastI) -> - let* (eI, tyI) = Typechecker.typecheck { pre with quantifiability = Unquantifiable; } tyenv utastI in - let evid = EvalVarID.fresh var in - let pty = TypeConv.lift_poly (rng, RefType(tyI)) in - let ssig = - let ventry = - { - val_type = pty; - val_name = Some(evid); - val_stage = pre.stage; - } + StructSig.empty |> StructSig.add_value varnm ventry in - StructSig.empty |> StructSig.add_value varnm ventry - in - return ([ Mutable(evid, eI) ], ssig) - in - let binds = rec_or_nonrecs |> List.map (fun rec_or_nonrec -> Bind(stage, rec_or_nonrec)) in - return (binds, (OpaqueIDMap.empty, ssig)) + return ([ Mutable(evid, eI) ], ssig) + in + let binds = rec_or_nonrecs |> List.map (fun rec_or_nonrec -> Bind(stage, rec_or_nonrec)) in + return (binds, (OpaqueIDMap.empty, ssig)) | UTBindType([]) -> assert false diff --git a/src/frontend/parser.mly b/src/frontend/parser.mly index b6f4d1e9d..da7d23b80 100644 --- a/src/frontend/parser.mly +++ b/src/frontend/parser.mly @@ -390,10 +390,15 @@ optional_open: | { false } ; attribute: + | attr_left=ATTRIBUTE_L_SQUARE; tokR=R_SQUARE + { + let (tokL, attrnm) = attr_left in + make_standard (Tok tokL) (Tok tokR) (UTAttribute(attrnm, None)) + } | attr_left=ATTRIBUTE_L_SQUARE; utast=expr; tokR=R_SQUARE { let (tokL, attrnm) = attr_left in - make_standard (Tok tokL) (Tok tokR) (UTAttribute(attrnm, utast)) + make_standard (Tok tokL) (Tok tokR) (UTAttribute(attrnm, Some(utast))) } ; modexpr: diff --git a/src/frontend/typeError.ml b/src/frontend/typeError.ml index 8812df190..bbd86eb38 100644 --- a/src/frontend/typeError.ml +++ b/src/frontend/typeError.ml @@ -65,3 +65,5 @@ type type_error = | KindContradiction of Range.t * type_name * kind * kind | CyclicSynonymTypeDefinition of (type_name * SynonymDependencyGraph.data) cycle | MultipleSynonymTypeDefinition of type_name * Range.t * Range.t + | ValueAttributeError of ValueAttribute.error + | TestMustBeStage1NonRec of Range.t diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index d898f5184..f19fe7be0 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -581,7 +581,7 @@ and untyped_parameter_unit = [@@deriving show { with_path = false; }] and untyped_attribute_main = - | UTAttribute of attribute_name * untyped_abstract_tree + | UTAttribute of attribute_name * untyped_abstract_tree option [@@deriving show { with_path = false; }] and untyped_attribute = @@ -717,7 +717,8 @@ and rec_or_nonrec = | Mutable of EvalVarID.t * abstract_tree and binding = - | Bind of stage * rec_or_nonrec + | Bind of stage * rec_or_nonrec + | BindTest of EvalVarID.t * abstract_tree and environment = location EvalVarIDMap.t * (syntactic_value StoreIDHashTable.t) ref diff --git a/src/frontend/valueAttribute.ml b/src/frontend/valueAttribute.ml new file mode 100644 index 000000000..50175f066 --- /dev/null +++ b/src/frontend/valueAttribute.ml @@ -0,0 +1,23 @@ + +open Types + + +type error = + | Unexpected of Range.t + +type t = { + is_test : bool; +} + + +let make (attrs : untyped_attribute list) : (t, error) result = + let open ResultMonad in + match attrs with + | [] -> + return { is_test = false } + + | [ (_, UTAttribute("test", None)) ] -> + return { is_test = true } + + | (rng, _) :: _ -> + err @@ Unexpected(rng) diff --git a/src/md/markdownParser.ml b/src/md/markdownParser.ml index f19a5cb29..e15b71058 100644 --- a/src/md/markdownParser.ml +++ b/src/md/markdownParser.ml @@ -405,7 +405,7 @@ let decode (s : string) : (DocumentAttribute.t * module_name * t) ok = let main_contents = normalize_h1 obs in let document_attributes_res = DocumentAttribute.make [ - (dummy_range, UTAttribute("dependencies", utast_dependencies)) + (dummy_range, UTAttribute("dependencies", Some(utast_dependencies))) ] in match document_attributes_res with From 153fcbd5e290d4b29adb14e395dd66f74f7b9d46 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Thu, 17 Nov 2022 05:20:55 +0900 Subject: [PATCH 184/288] add the subcommand 'satysfi test' --- bin/satysfi.ml | 33 ++++++ src/backend/optionState.ml | 6 ++ src/backend/optionState.mli | 6 ++ src/frontend/main.ml | 197 +++++++++++++++++++++++++++++------- src/frontend/main.mli | 8 ++ 5 files changed, 215 insertions(+), 35 deletions(-) diff --git a/bin/satysfi.ml b/bin/satysfi.ml index a0f165712..f881f9a5d 100644 --- a/bin/satysfi.ml +++ b/bin/satysfi.ml @@ -36,6 +36,21 @@ let build ~no_default_config +let test + fpath_in + config_paths_str_opt + text_mode_formats_str_opt + show_full_path + no_default_config += + Main.test + ~fpath_in + ~config_paths_str_opt + ~text_mode_formats_str_opt + ~show_full_path + ~no_default_config + + let solve fpath_in show_full_path @@ -163,6 +178,23 @@ let command_build = Cmd.v info term +let command_test = + let open Cmdliner in + let term : unit Term.t = + Term.(const test + $ arg_in + $ flag_config + $ flag_text_mode + $ flag_full_path + $ flag_no_default_config + ) + in + let info : Cmd.info = + Cmd.info "test" + in + Cmd.v info term + + let command_solve = let open Cmdliner in let term : unit Term.t = @@ -190,6 +222,7 @@ let () = let subcommands = [ command_build; + command_test; command_solve; ] in diff --git a/src/backend/optionState.ml b/src/backend/optionState.ml index e994681be..81408fc06 100644 --- a/src/backend/optionState.ml +++ b/src/backend/optionState.ml @@ -19,8 +19,14 @@ type build_state = { bytecomp : bool; } +type test_state = { + input_file_to_test : abs_path; + output_mode_to_test : output_mode; +} + type command_state = | BuildState of build_state + | TestState of test_state | SolveState type state = { diff --git a/src/backend/optionState.mli b/src/backend/optionState.mli index 157e11f2b..ee903919c 100644 --- a/src/backend/optionState.mli +++ b/src/backend/optionState.mli @@ -19,8 +19,14 @@ type build_state = { bytecomp : bool; } +type test_state = { + input_file_to_test : abs_path; + output_mode_to_test : output_mode; +} + type command_state = | BuildState of build_state + | TestState of test_state | SolveState type state = { diff --git a/src/frontend/main.ml b/src/frontend/main.ml index d9e485920..381208d6a 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -179,11 +179,9 @@ let eval_document_file (env : environment) (ast : abstract_tree) (abspath_out : aux 1 -let preprocess_and_evaluate ~(run_tests : bool) (env : environment) (libs : (abs_path * binding list) list) (ast_doc : abstract_tree) (_abspath_in : abs_path) (abspath_out : abs_path) (abspath_dump : abs_path) = - - (* Performs preprecessing: - each evaluation called in `preprocess` is run by the naive interpreter - regardless of whether `--bytecomp` was specified. *) +(* Performs preprecessing. the evaluation is run by the naive interpreter + regardless of whether `--bytecomp` was specified. *) +let preprocess_bindings ~(run_tests : bool) (env : environment) (libs : (abs_path * binding list) list) : environment * (abs_path * code_rec_or_nonrec list) list = let (env, codebindacc) = libs |> List.fold_left (fun (env, codebindacc) (abspath, binds) -> Logging.begin_to_preprocess_file abspath; @@ -192,19 +190,28 @@ let preprocess_and_evaluate ~(run_tests : bool) (env : environment) (libs : (abs ) (env, Alist.empty) in let codebinds = Alist.to_list codebindacc in + (env, codebinds) + + +(* Performs evaluation and returns the resulting environment. *) +let evaluate_bindings ~(run_tests : bool) (env : environment) (codebinds : (abs_path * code_rec_or_nonrec list) list) : environment = + codebinds |> List.fold_left (fun env (abspath, cd_rec_or_nonrecs) -> + let binds = + cd_rec_or_nonrecs |> List.map (fun cd_rec_or_nonrec -> + Bind(Stage0, unlift_rec_or_nonrec cd_rec_or_nonrec) + ) + in + eval_library_file ~run_tests env abspath binds + ) env + + +let preprocess_and_evaluate ~(run_tests : bool) (env : environment) (libs : (abs_path * binding list) list) (ast_doc : abstract_tree) (_abspath_in : abs_path) (abspath_out : abs_path) (abspath_dump : abs_path) = + (* Performs preprocessing: *) + let (env, codebinds) = preprocess_bindings ~run_tests env libs in let code_doc = Evaluator.interpret_1 env ast_doc in (* Performs evaluation: *) - let env = - codebinds |> List.fold_left (fun env (abspath, cd_rec_or_nonrecs) -> - let binds = - cd_rec_or_nonrecs |> List.map (fun cd_rec_or_nonrec -> - Bind(Stage0, unlift_rec_or_nonrec cd_rec_or_nonrec) - ) - in - eval_library_file ~run_tests env abspath binds - ) env - in + let env = evaluate_bindings ~run_tests env codebinds in let ast_doc = unlift_code code_doc in eval_document_file env ast_doc abspath_out abspath_dump @@ -1417,6 +1424,24 @@ let make_document_lock_config_path (basename_without_extension : string) = make_abs_path (Printf.sprintf "%s.satysfi-lock" basename_without_extension) +let get_output_mode text_mode_formats_str_opt = + match text_mode_formats_str_opt with + | None -> OptionState.PdfMode + | Some(s) -> OptionState.TextMode(String.split_on_char ',' s) + + +let load_lock_config (abspath_lock_config : abs_path) : LockConfig.t = + match LockConfig.load abspath_lock_config with + | Ok(lock_config) -> lock_config + | Error(e) -> raise (ConfigError(e)) + + +let load_package ~(extensions : string list) (abspath_in : abs_path) = + match PackageReader.main ~extensions abspath_in with + | Ok(pair) -> pair + | Error(e) -> raise (ConfigError(e)) + + let build ~(fpath_in : string) ~(fpath_out_opt : string option) @@ -1439,11 +1464,7 @@ let build let input_file = make_absolute_if_relative ~origin:curdir fpath_in 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 = - match text_mode_formats_str_opt with - | None -> OptionState.PdfMode - | Some(s) -> OptionState.TextMode(String.split_on_char ',' s) - in + let output_mode = get_output_mode text_mode_formats_str_opt in OptionState.set OptionState.{ command_state = BuildState{ @@ -1507,17 +1528,9 @@ let build lock = abspath_lock_config; } -> Logging.lock_config_file abspath_lock_config; - let lock_config = - match LockConfig.load abspath_lock_config with - | Ok(lock_config) -> lock_config - | Error(e) -> raise (ConfigError(e)) - in + let lock_config = load_lock_config abspath_lock_config in - let (_config, package) = - match PackageReader.main ~extensions abspath_in with - | Ok(package) -> package - | Error(e) -> raise (ConfigError(e)) - in + let (_config, package) = load_package ~extensions abspath_in in let (genv, _configenv, _libs_dep) = let lock_config_dir = make_abs_path (Filename.dirname (get_abs_path_string abspath_lock_config)) in @@ -1537,11 +1550,7 @@ let build dump = abspath_dump; } -> Logging.lock_config_file abspath_lock_config; - let lock_config = - match LockConfig.load abspath_lock_config with - | Ok(lock_config) -> lock_config - | Error(e) -> raise (ConfigError(e)) - in + let lock_config = load_lock_config abspath_lock_config in Logging.target_file abspath_out; @@ -1574,6 +1583,124 @@ let build ) +type test_input = + | PackageTestInput of { + lock : abs_path; + } + | DocumentTestInput of { + kind : input_kind; + lock : abs_path; + } + + +let test + ~(fpath_in : string) + ~(config_paths_str_opt : string option) + ~(text_mode_formats_str_opt : string option) + ~(show_full_path : bool) + ~(no_default_config : bool) += + error_log_environment (fun () -> + let curdir = Sys.getcwd () in + + let input_file_to_test = make_absolute_if_relative ~origin:curdir fpath_in in + let extra_config_paths = config_paths_str_opt |> Option.map (String.split_on_char ':') in + let output_mode_to_test = get_output_mode text_mode_formats_str_opt in + OptionState.set OptionState.{ + command_state = + TestState{ + input_file_to_test; + output_mode_to_test; + }; + extra_config_paths; + show_full_path; + no_default_config; + }; + + setup_root_dirs ~no_default_config ~extra_config_paths curdir; + let abspath_in = input_file_to_test in + let test_input = + let abspathstr_in = get_abs_path_string abspath_in in + if Sys.is_directory abspathstr_in then + (* If the input is a package directory: *) + let abspath_lock_config = make_package_lock_config_path abspathstr_in in + PackageTestInput{ + lock = abspath_lock_config; + } + else + (* If the input is a document file: *) + let input_kind_res = get_input_kind_from_extension abspathstr_in in + match input_kind_res with + | Error(ext) -> + raise (UnexpectedExtension(ext)) + + | Ok(input_kind) -> + let basename_without_extension = Filename.remove_extension abspathstr_in in + let abspath_lock_config = make_document_lock_config_path basename_without_extension in + DocumentTestInput{ + kind = input_kind; + lock = abspath_lock_config; + } + in + + let extensions = get_candidate_file_extensions () in + let (tyenv_prim, env) = initialize () in + + match test_input with + | PackageTestInput{ + lock = abspath_lock_config; + } -> + Logging.lock_config_file abspath_lock_config; + let lock_config = load_lock_config abspath_lock_config in + + let (_config, package) = load_package ~extensions abspath_in in + + let (genv, _configenv, _libs_dep) = + let lock_config_dir = make_abs_path (Filename.dirname (get_abs_path_string abspath_lock_config)) in + check_depended_packages ~use_test_only_lock:false ~lock_config_dir ~extensions tyenv_prim lock_config + in + + let libs = + match PackageChecker.main tyenv_prim genv package with + | Ok((_ssig, libs)) -> libs + | Error(e) -> raise (ConfigError(e)) + in + let (env, codebinds) = preprocess_bindings ~run_tests:true env libs in + let _env = evaluate_bindings ~run_tests:true env codebinds in + () + + | DocumentTestInput{ + kind = input_kind; + lock = abspath_lock_config; + } -> + Logging.lock_config_file abspath_lock_config; + let lock_config = load_lock_config abspath_lock_config in + + let (genv, configenv, libs) = + let lock_config_dir = make_abs_path (Filename.dirname (get_abs_path_string abspath_lock_config)) in + check_depended_packages ~use_test_only_lock:true ~lock_config_dir ~extensions tyenv_prim lock_config + in + + (* Resolve dependency of the document and the local source files: *) + let (sorted_locals, utdoc) = + match OpenFileDependencyResolver.main ~extensions input_kind configenv abspath_in with + | Ok(pair) -> pair + | Error(e) -> raise (ConfigError(e)) + in + + (* Typechecking and elaboration: *) + let (libs_local, _ast_doc) = + match PackageChecker.main_document tyenv_prim genv sorted_locals (abspath_in, utdoc) with + | Ok(pair) -> pair + | Error(e) -> raise (ConfigError(e)) + in + let libs = List.append libs libs_local in + let (env, codebinds) = preprocess_bindings ~run_tests:true env libs in + let _env = evaluate_bindings ~run_tests:true env codebinds in + () + ) + + type solve_input = | PackageSolveInput of { root : abs_path; (* The absolute path of a directory used as the package root *) diff --git a/src/frontend/main.mli b/src/frontend/main.mli index 0a0741ae7..397b88571 100644 --- a/src/frontend/main.mli +++ b/src/frontend/main.mli @@ -16,6 +16,14 @@ val build : no_default_config:bool -> unit +val test : + fpath_in:string -> + config_paths_str_opt:(string option) -> + text_mode_formats_str_opt:(string option) -> + show_full_path:bool -> + no_default_config:bool -> + unit + val solve : fpath_in:string -> show_full_path:bool -> From a8ba9d759597fe88b41a95af28647e567e333c7c Mon Sep 17 00:00:00 2001 From: gfngfn Date: Thu, 17 Nov 2022 05:41:12 +0900 Subject: [PATCH 185/288] make package configs support the 'test_directories' section --- src/frontend/closedLockDependencyResolver.ml | 5 +++- src/frontend/main.ml | 8 +++--- src/frontend/packageConfig.ml | 3 +++ src/frontend/packageConfig.mli | 1 + src/frontend/packageReader.ml | 26 ++++++++++++++------ src/frontend/packageReader.mli | 5 +++- 6 files changed, 34 insertions(+), 14 deletions(-) diff --git a/src/frontend/closedLockDependencyResolver.ml b/src/frontend/closedLockDependencyResolver.ml index 68ccbaf6c..2cb7f9d0c 100644 --- a/src/frontend/closedLockDependencyResolver.ml +++ b/src/frontend/closedLockDependencyResolver.ml @@ -20,6 +20,7 @@ let main ~(use_test_only_lock : bool) ~(lock_config_dir : abs_path) ~(extensions locks |> foldM (fun (graph, entryacc) (lock : LockConfig.locked_package) -> let LockConfig.{ lock_name; lock_location; lock_dependencies; test_only_lock } = lock in if test_only_lock && not use_test_only_lock then + (* Skips test-only locks when using sources only: *) return (graph, entryacc) else let* absdir_package = @@ -35,7 +36,9 @@ let main ~(use_test_only_lock : bool) ~(lock_config_dir : abs_path) ~(extensions | LocalLocation{ path = s_relpath } -> return (make_abs_path (Filename.concat (get_abs_path_string lock_config_dir) s_relpath)) in - let* package_with_config = PackageReader.main ~extensions absdir_package in + let* package_with_config = + PackageReader.main ~use_test_files:use_test_only_lock ~extensions absdir_package + in let* (graph, vertex) = graph |> LockDependencyGraph.add_vertex lock_name package_with_config |> Result.map_error (fun _ -> LockNameConflict(lock_name)) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 381208d6a..974320bf0 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1436,8 +1436,8 @@ let load_lock_config (abspath_lock_config : abs_path) : LockConfig.t = | Error(e) -> raise (ConfigError(e)) -let load_package ~(extensions : string list) (abspath_in : abs_path) = - match PackageReader.main ~extensions abspath_in with +let load_package ~(use_test_files : bool) ~(extensions : string list) (abspath_in : abs_path) = + match PackageReader.main ~use_test_files ~extensions abspath_in with | Ok(pair) -> pair | Error(e) -> raise (ConfigError(e)) @@ -1530,7 +1530,7 @@ let build Logging.lock_config_file abspath_lock_config; let lock_config = load_lock_config abspath_lock_config in - let (_config, package) = load_package ~extensions abspath_in in + let (_config, package) = load_package ~use_test_files:false ~extensions abspath_in in let (genv, _configenv, _libs_dep) = let lock_config_dir = make_abs_path (Filename.dirname (get_abs_path_string abspath_lock_config)) in @@ -1653,7 +1653,7 @@ let test Logging.lock_config_file abspath_lock_config; let lock_config = load_lock_config abspath_lock_config in - let (_config, package) = load_package ~extensions abspath_in in + let (_config, package) = load_package ~use_test_files:true ~extensions abspath_in in let (genv, _configenv, _libs_dep) = let lock_config_dir = make_abs_path (Filename.dirname (get_abs_path_string abspath_lock_config)) in diff --git a/src/frontend/packageConfig.ml b/src/frontend/packageConfig.ml index 04c33e9d7..5abc0c5c6 100644 --- a/src/frontend/packageConfig.ml +++ b/src/frontend/packageConfig.ml @@ -23,6 +23,7 @@ type package_contents = | Library of { main_module_name : module_name; source_directories : relative_path list; + test_directories : relative_path list; dependencies : package_dependency list; test_dependencies : package_dependency list; conversion_specs : package_conversion_spec list; @@ -173,12 +174,14 @@ let contents_decoder : package_contents ConfigDecoder.t = "library" ==> begin get "main_module" string >>= fun main_module_name -> get "source_directories" (list string) >>= fun source_directories -> + get "test_directories" (list string) >>= fun test_directories -> get_or_else "dependencies" (list dependency_decoder) [] >>= fun dependencies -> get_or_else "test_dependencies" (list dependency_decoder) [] >>= fun test_dependencies -> get_or_else "conversion" (list conversion_spec_decoder) [] >>= fun conversion_specs -> succeed @@ Library { main_module_name; source_directories; + test_directories; dependencies; test_dependencies; conversion_specs; diff --git a/src/frontend/packageConfig.mli b/src/frontend/packageConfig.mli index 513004672..bc6896636 100644 --- a/src/frontend/packageConfig.mli +++ b/src/frontend/packageConfig.mli @@ -19,6 +19,7 @@ type package_contents = | Library of { main_module_name : module_name; source_directories : relative_path list; + test_directories : relative_path list; dependencies : package_dependency list; test_dependencies : package_dependency list; conversion_specs : package_conversion_spec list; diff --git a/src/frontend/packageReader.ml b/src/frontend/packageReader.ml index 3252cf519..c86856fc6 100644 --- a/src/frontend/packageReader.ml +++ b/src/frontend/packageReader.ml @@ -17,20 +17,30 @@ let listup_sources_in_directory (extensions : string list) (absdir_src : abs_pat ) -let main ~(extensions : string list) (absdir_package : abs_path) : (PackageConfig.t * untyped_package) ok = +let make_path_list_absolute ~(origin : abs_path) (reldirs : string list) : abs_path list = + reldirs |> List.map (fun reldir -> + make_abs_path (Filename.concat (get_abs_path_string origin) reldir) + ) + + +let main ~(use_test_files : bool) ~(extensions : string list) (absdir_package : abs_path) : (PackageConfig.t * untyped_package) ok = let open ResultMonad in let* config = PackageConfig.load absdir_package in let* package = match config.package_contents with - | PackageConfig.Library{ main_module_name; source_directories; _ } -> - let absdirs_src = - source_directories |> List.map (fun source_directory -> - make_abs_path (Filename.concat (get_abs_path_string absdir_package) source_directory) - ) - in + | PackageConfig.Library{ main_module_name; source_directories; test_directories; _ } -> + let absdirs_src = source_directories |> make_path_list_absolute ~origin:absdir_package in let abspaths_src = absdirs_src |> List.map (listup_sources_in_directory extensions) |> List.concat in + let abspaths = + if use_test_files then + let absdirs_test = test_directories |> make_path_list_absolute ~origin:absdir_package in + let abspaths_test = absdirs_test |> List.map (listup_sources_in_directory extensions) |> List.concat in + List.append abspaths_src abspaths_test + else + abspaths_src + in let* acc = - abspaths_src |> foldM (fun acc abspath_src -> + abspaths |> foldM (fun acc abspath_src -> let* utsrc = Logging.begin_to_parse_file abspath_src; ParserInterface.process_file abspath_src |> Result.map_error (fun e -> FailedToParse(e)) diff --git a/src/frontend/packageReader.mli b/src/frontend/packageReader.mli index 59daa00aa..d88185589 100644 --- a/src/frontend/packageReader.mli +++ b/src/frontend/packageReader.mli @@ -3,4 +3,7 @@ open MyUtil open Types open ConfigError -val main : extensions:(string list) -> abs_path -> (PackageConfig.t * untyped_package, config_error) result +val main : + use_test_files:bool -> + extensions:(string list) -> + abs_path -> (PackageConfig.t * untyped_package, config_error) result From 8d49cf0e1b1f410f3379d8c84a37063e8852b46a Mon Sep 17 00:00:00 2001 From: gfngfn Date: Thu, 17 Nov 2022 06:01:52 +0900 Subject: [PATCH 186/288] slight fixes on 'OptionState' --- src/backend/optionState.ml | 30 ++++++++++++++++++++++-------- src/backend/optionState.mli | 6 ------ src/frontend/main.ml | 14 +++++++------- src/frontend/packageConfig.ml | 2 +- 4 files changed, 30 insertions(+), 22 deletions(-) diff --git a/src/backend/optionState.ml b/src/backend/optionState.ml index 81408fc06..ea64b04d1 100644 --- a/src/backend/optionState.ml +++ b/src/backend/optionState.ml @@ -56,10 +56,20 @@ let get_build_state () = | _ -> assert false -let get_input_file () = (get_build_state ()).input_file -let get_output_file () = (get_build_state ()).output_file -let get_extra_config_paths () = (get ()).extra_config_paths -let get_output_mode () = (get_build_state ()).output_mode +let get_input_file () = + match (get ()).command_state with + | BuildState({ input_file; _ }) -> input_file + | TestState({ input_file_to_test; _}) -> input_file_to_test + | SolveState -> assert false + + +let get_output_mode () = + match (get ()).command_state with + | BuildState({ output_mode; _ }) -> output_mode + | TestState({ output_mode_to_test; _}) -> output_mode_to_test + | SolveState -> assert false + + let get_page_number_limit () = (get_build_state ()).page_number_limit let does_show_full_path () = (get ()).show_full_path let does_debug_show_bbox () = (get_build_state ()).debug_show_bbox @@ -67,9 +77,13 @@ let does_debug_show_space () = (get_build_state ()).debug_show_space let does_debug_show_block_bbox () = (get_build_state ()).debug_show_block_bbox let does_debug_show_block_space () = (get_build_state ()).debug_show_block_space let does_debug_show_overfull () = (get_build_state ()).debug_show_overfull -let is_type_check_only () = (get_build_state ()).type_check_only -let is_bytecomp_mode () = (get_build_state ()).bytecomp -let use_no_default_config () = (get ()).no_default_config + + +let is_bytecomp_mode () = + match (get ()).command_state with + | BuildState({ bytecomp; _ }) -> bytecomp + | TestState(_) -> false + | SolveState -> assert false let job_directory () = @@ -78,6 +92,6 @@ let job_directory () = let is_text_mode () = - match (get_build_state ()).output_mode with + match get_output_mode () with | TextMode(_) -> true | PdfMode -> false diff --git a/src/backend/optionState.mli b/src/backend/optionState.mli index ee903919c..5d642f98f 100644 --- a/src/backend/optionState.mli +++ b/src/backend/optionState.mli @@ -40,10 +40,6 @@ val set : state -> unit val get : unit -> state -val get_input_file : unit -> abs_path -val get_output_file : unit -> abs_path option -val get_extra_config_paths : unit -> string list option -val get_output_mode : unit -> output_mode val get_page_number_limit : unit -> int val does_show_full_path : unit -> bool val does_debug_show_bbox : unit -> bool @@ -51,9 +47,7 @@ val does_debug_show_space : unit -> bool val does_debug_show_block_bbox : unit -> bool val does_debug_show_block_space : unit -> bool val does_debug_show_overfull : unit -> bool -val is_type_check_only : unit -> bool val is_bytecomp_mode : unit -> bool -val use_no_default_config : unit -> bool val job_directory : unit -> string diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 974320bf0..8b6018404 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1361,8 +1361,8 @@ let make_absolute_if_relative ~(origin : string) (s : string) : abs_path = make_abs_path abspath_str -let get_candidate_file_extensions () = - match OptionState.get_output_mode () with +let get_candidate_file_extensions (output_mode : OptionState.output_mode) = + match output_mode with | PdfMode -> [ ".satyh"; ".satyg" ] | TextMode(formats) -> List.append (formats |> List.map (fun s -> ".satyh-" ^ s)) [ ".satyg" ] @@ -1424,7 +1424,7 @@ let make_document_lock_config_path (basename_without_extension : string) = make_abs_path (Printf.sprintf "%s.satysfi-lock" basename_without_extension) -let get_output_mode text_mode_formats_str_opt = +let make_output_mode text_mode_formats_str_opt = match text_mode_formats_str_opt with | None -> OptionState.PdfMode | Some(s) -> OptionState.TextMode(String.split_on_char ',' s) @@ -1464,7 +1464,7 @@ let build let input_file = make_absolute_if_relative ~origin:curdir fpath_in 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 = get_output_mode text_mode_formats_str_opt in + let output_mode = make_output_mode text_mode_formats_str_opt in OptionState.set OptionState.{ command_state = BuildState{ @@ -1520,7 +1520,7 @@ let build } in - let extensions = get_candidate_file_extensions () in + let extensions = get_candidate_file_extensions output_mode in let (tyenv_prim, env) = initialize () in match build_input with @@ -1605,7 +1605,7 @@ let test let input_file_to_test = make_absolute_if_relative ~origin:curdir fpath_in in let extra_config_paths = config_paths_str_opt |> Option.map (String.split_on_char ':') in - let output_mode_to_test = get_output_mode text_mode_formats_str_opt in + let output_mode_to_test = make_output_mode text_mode_formats_str_opt in OptionState.set OptionState.{ command_state = TestState{ @@ -1643,7 +1643,7 @@ let test } in - let extensions = get_candidate_file_extensions () in + let extensions = get_candidate_file_extensions output_mode_to_test in let (tyenv_prim, env) = initialize () in match test_input with diff --git a/src/frontend/packageConfig.ml b/src/frontend/packageConfig.ml index 5abc0c5c6..7e8d7c0d1 100644 --- a/src/frontend/packageConfig.ml +++ b/src/frontend/packageConfig.ml @@ -174,7 +174,7 @@ let contents_decoder : package_contents ConfigDecoder.t = "library" ==> begin get "main_module" string >>= fun main_module_name -> get "source_directories" (list string) >>= fun source_directories -> - get "test_directories" (list string) >>= fun test_directories -> + get_or_else "test_directories" (list string) [] >>= fun test_directories -> get_or_else "dependencies" (list dependency_decoder) [] >>= fun dependencies -> get_or_else "test_dependencies" (list dependency_decoder) [] >>= fun test_dependencies -> get_or_else "conversion" (list conversion_spec_decoder) [] >>= fun conversion_specs -> From 3be1f5528cc6da52a6cc7d933331e16c7e5ddd75 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Thu, 17 Nov 2022 06:35:38 +0900 Subject: [PATCH 187/288] add a small example unit test for 'stdlib' --- .../packages/stdlib/stdlib.0.0.1/satysfi.yaml | 4 +++- .../stdlib/stdlib.0.0.1/test/list-test.satyg | 15 +++++++++++++++ 2 files changed, 18 insertions(+), 1 deletion(-) create mode 100644 lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/test/list-test.satyg diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/satysfi.yaml index db40422ab..634302249 100644 --- a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/satysfi.yaml @@ -3,5 +3,7 @@ contents: type: "library" main_module: "Stdlib" source_directories: - - "./src" + - "./src" + test_directories: + - "./test" dependencies: [] diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/test/list-test.satyg b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/test/list-test.satyg new file mode 100644 index 000000000..326b5e7e9 --- /dev/null +++ b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/test/list-test.satyg @@ -0,0 +1,15 @@ +use List + +module ListTest = struct + + #[test] + val fold-left-test = + let input = [3, 1, 4, 1, 5, 9, 2] in + let expected = 25 in + let got = List.fold-left ( + ) 0 input in + if got == expected then + display-message `**** fold-left-test: OK` + else + display-message `**** fold-left-test: FAILED` + +end From ddec1cea9cbbbe984e090d46c9f289f6b2a71198 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Thu, 17 Nov 2022 23:23:17 +0900 Subject: [PATCH 188/288] make test result message printed, and set the exit status code to 1 when some test fails --- .../stdlib/stdlib.0.0.1/test/list-test.satyg | 8 +- src/frontend/bytecomp/ir.cppo.ml | 6 + src/frontend/evaluator.cppo.ml | 24 +++- src/frontend/logging.ml | 14 +++ src/frontend/logging.mli | 6 + src/frontend/main.ml | 107 ++++++++++-------- src/frontend/moduleTypechecker.ml | 44 +++---- src/frontend/state.ml | 13 +++ src/frontend/state.mli | 9 ++ src/frontend/types.cppo.ml | 5 + 10 files changed, 166 insertions(+), 70 deletions(-) diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/test/list-test.satyg b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/test/list-test.satyg index 326b5e7e9..59f9d112b 100644 --- a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/test/list-test.satyg +++ b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/test/list-test.satyg @@ -8,8 +8,12 @@ module ListTest = struct let expected = 25 in let got = List.fold-left ( + ) 0 input in if got == expected then - display-message `**** fold-left-test: OK` + None else - display-message `**** fold-left-test: FAILED` + Some(`FAILED: fold-left-test (expected: `# ^ (arabic expected) ^ `, got: `# ^ (arabic got) ^ `)`) + + #[test] + val abort-test = + abort-with-message `FAILED: abort` end diff --git a/src/frontend/bytecomp/ir.cppo.ml b/src/frontend/bytecomp/ir.cppo.ml index cdecf425d..e4a5b0338 100644 --- a/src/frontend/bytecomp/ir.cppo.ml +++ b/src/frontend/bytecomp/ir.cppo.ml @@ -577,6 +577,9 @@ and transform_1 (env : frame) (ast : abstract_tree) : ir * frame = | LoadCollectionFont(_) -> failwith "TODO: LoadCollectionFont" + | CatchTest(_) -> + assert false (* Cannot occur in input expressions. *) + #include "__ir_1.gen.ml" @@ -768,4 +771,7 @@ and transform_0 (env : frame) (ast : abstract_tree) : ir * frame = | LoadCollectionFont(_) -> failwith "TODO: LoadCollectionFont" + | CatchTest(_) -> + assert false (* Cannot occur in input expressions. *) + #include "__ir_0.gen.ml" diff --git a/src/frontend/evaluator.cppo.ml b/src/frontend/evaluator.cppo.ml index 6696f9ed0..cb5bc54a0 100644 --- a/src/frontend/evaluator.cppo.ml +++ b/src/frontend/evaluator.cppo.ml @@ -431,6 +431,23 @@ and interpret_0 (env : environment) (ast : abstract_tree) : syntactic_value = in BaseConstant(BCFontKey(fontkey)) + | CatchTest(ast) -> + let value = + try + interpret_0 env ast + with + | EvalError(msg) -> (* Catches aborts during tests. *) + Constructor("Some", BaseConstant(BCString(msg))) + in + let test_result = + match value with + | Constructor("None", BaseConstant(BCUnit)) -> State.Pass + | Constructor("Some", BaseConstant(BCString(msg))) -> State.Fail(msg) + | _ -> report_bug_value "unexpected test result" value + in + State.add_test_result test_result; + BaseConstant(BCUnit) + #include "__evaluator_0.gen.ml" @@ -610,6 +627,10 @@ and interpret_1 (env : environment) (ast : abstract_tree) : code_value = | LoadCollectionFont{ path; index; used_as_math_font } -> CdLoadCollectionFont{ path; index; used_as_math_font } + | CatchTest(ast1) -> + let code1 = interpret_1 env ast1 in + CdCatchTest(code1) + #include "__evaluator_1.gen.ml" @@ -1214,7 +1235,8 @@ let interpret_bindings_0 ~(run_tests : bool) (env : environment) (binds : bindin if run_tests then let code = interpret_1 env ast in let (env, symb) = generate_symbol_for_eval_var_id evid env in - (env, Alist.extend acc (CdNonRec(symb, code))) + let cdbind = CdNonRec(symb, CdCatchTest(code)) in + (env, Alist.extend acc cdbind) else (env, acc) diff --git a/src/frontend/logging.ml b/src/frontend/logging.ml index 3c2c9e167..a19430f53 100644 --- a/src/frontend/logging.ml +++ b/src/frontend/logging.ml @@ -184,3 +184,17 @@ let warn_underfull_line (pageno : int) = let warn_unreachable (pageno : int) = Format.printf " [Warning] a line unable to be broken into a paragraph occurs on page %d\n" pageno + + +let report_failed_test (msg : string) = + Printf.printf "! %s\n" msg + + +let all_tests_passed () = + print_endline " ---- ---- ---- ----"; + print_endline " all tests have passed." + + +let some_test_failed () = + print_endline " ---- ---- ---- ----"; + print_endline "! some test has failed." diff --git a/src/frontend/logging.mli b/src/frontend/logging.mli index 7731d6a0d..afe6fc2ac 100644 --- a/src/frontend/logging.mli +++ b/src/frontend/logging.mli @@ -61,3 +61,9 @@ val warn_overfull_line : int -> unit val warn_underfull_line : int -> unit val warn_unreachable : int -> unit + +val report_failed_test : string -> unit + +val all_tests_passed : unit -> unit + +val some_test_failed : unit -> unit diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 8b6018404..604b0ed77 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1646,58 +1646,75 @@ let test let extensions = get_candidate_file_extensions output_mode_to_test in let (tyenv_prim, env) = initialize () in - match test_input with - | PackageTestInput{ - lock = abspath_lock_config; - } -> - Logging.lock_config_file abspath_lock_config; - let lock_config = load_lock_config abspath_lock_config in + begin + match test_input with + | PackageTestInput{ + lock = abspath_lock_config; + } -> + Logging.lock_config_file abspath_lock_config; + let lock_config = load_lock_config abspath_lock_config in - let (_config, package) = load_package ~use_test_files:true ~extensions abspath_in in + let (_config, package) = load_package ~use_test_files:true ~extensions abspath_in in - let (genv, _configenv, _libs_dep) = - let lock_config_dir = make_abs_path (Filename.dirname (get_abs_path_string abspath_lock_config)) in - check_depended_packages ~use_test_only_lock:false ~lock_config_dir ~extensions tyenv_prim lock_config - in + let (genv, _configenv, _libs_dep) = + let lock_config_dir = make_abs_path (Filename.dirname (get_abs_path_string abspath_lock_config)) in + check_depended_packages ~use_test_only_lock:false ~lock_config_dir ~extensions tyenv_prim lock_config + in - let libs = - match PackageChecker.main tyenv_prim genv package with - | Ok((_ssig, libs)) -> libs - | Error(e) -> raise (ConfigError(e)) - in - let (env, codebinds) = preprocess_bindings ~run_tests:true env libs in - let _env = evaluate_bindings ~run_tests:true env codebinds in - () + let libs = + match PackageChecker.main tyenv_prim genv package with + | Ok((_ssig, libs)) -> libs + | Error(e) -> raise (ConfigError(e)) + in + let (env, codebinds) = preprocess_bindings ~run_tests:true env libs in + let _env = evaluate_bindings ~run_tests:true env codebinds in + () - | DocumentTestInput{ - kind = input_kind; - lock = abspath_lock_config; - } -> - Logging.lock_config_file abspath_lock_config; - let lock_config = load_lock_config abspath_lock_config in + | DocumentTestInput{ + kind = input_kind; + lock = abspath_lock_config; + } -> + Logging.lock_config_file abspath_lock_config; + let lock_config = load_lock_config abspath_lock_config in - let (genv, configenv, libs) = - let lock_config_dir = make_abs_path (Filename.dirname (get_abs_path_string abspath_lock_config)) in - check_depended_packages ~use_test_only_lock:true ~lock_config_dir ~extensions tyenv_prim lock_config - in + let (genv, configenv, libs) = + let lock_config_dir = make_abs_path (Filename.dirname (get_abs_path_string abspath_lock_config)) in + check_depended_packages ~use_test_only_lock:true ~lock_config_dir ~extensions tyenv_prim lock_config + in - (* Resolve dependency of the document and the local source files: *) - let (sorted_locals, utdoc) = - match OpenFileDependencyResolver.main ~extensions input_kind configenv abspath_in with - | Ok(pair) -> pair - | Error(e) -> raise (ConfigError(e)) - in + (* Resolve dependency of the document and the local source files: *) + let (sorted_locals, utdoc) = + match OpenFileDependencyResolver.main ~extensions input_kind configenv abspath_in with + | Ok(pair) -> pair + | Error(e) -> raise (ConfigError(e)) + in - (* Typechecking and elaboration: *) - let (libs_local, _ast_doc) = - match PackageChecker.main_document tyenv_prim genv sorted_locals (abspath_in, utdoc) with - | Ok(pair) -> pair - | Error(e) -> raise (ConfigError(e)) - in - let libs = List.append libs libs_local in - let (env, codebinds) = preprocess_bindings ~run_tests:true env libs in - let _env = evaluate_bindings ~run_tests:true env codebinds in - () + (* Typechecking and elaboration: *) + let (libs_local, _ast_doc) = + match PackageChecker.main_document tyenv_prim genv sorted_locals (abspath_in, utdoc) with + | Ok(pair) -> pair + | Error(e) -> raise (ConfigError(e)) + in + let libs = List.append libs libs_local in + let (env, codebinds) = preprocess_bindings ~run_tests:true env libs in + let _env = evaluate_bindings ~run_tests:true env codebinds in + () + end; + let test_results = State.get_all_test_results () in + let failure_found = + test_results |> List.fold_left (fun failure_found test_result -> + match test_result with + | State.Pass -> failure_found + | State.Fail(msg) -> Logging.report_failed_test msg; true + ) false + in + if failure_found then begin + Logging.some_test_failed (); + exit 1 + end else begin + Logging.all_tests_passed (); + () + end ) diff --git a/src/frontend/moduleTypechecker.ml b/src/frontend/moduleTypechecker.ml index 4dc70d63a..eb7aa2a48 100644 --- a/src/frontend/moduleTypechecker.ml +++ b/src/frontend/moduleTypechecker.ml @@ -729,40 +729,28 @@ and typecheck_binding_list (tyenv : Typeenv.t) (utbinds : untyped_binding list) return ((quant, ssig), binds) -and typecheck_nonrec (pre : pre) (tyenv : Typeenv.t) (ident : var_name ranged) (utast1 : untyped_abstract_tree) = +and typecheck_nonrec (pre : pre) (tyenv : Typeenv.t) (ident : var_name ranged) (utast1 : untyped_abstract_tree) (ty_expected_opt : mono_type option) = let open ResultMonad in let presub = { pre with level = Level.succ pre.level; } in - let (_, varnm) = ident in let evid = EvalVarID.fresh ident in let* (e1_raw, ty1) = Typechecker.typecheck presub tyenv utast1 in let e1 = e1_raw in -(* - tyannot |> Option.map (fun mnty -> - let tyA = decode_manual_type pre tyenv mnty in - unify ty1 tyA - ) |> ignore; -*) + let* () = + match ty_expected_opt with + | None -> return () + | Some(ty_expected) -> unify ty1 ty_expected + in (* let should_be_polymorphic = is_nonexpansive_expression e1 in *) let should_be_polymorphic = true in - let ssig = let pty = if should_be_polymorphic then TypeConv.generalize pre.level (TypeConv.erase_range_of_type ty1) else TypeConv.lift_poly (TypeConv.erase_range_of_type ty1) in - let ventry = - { - val_type = pty; - val_name = Some(evid); - val_stage = pre.stage; - } - in - StructSig.empty |> StructSig.add_value varnm ventry - in - return (evid, e1, ssig) + return (evid, e1, pty) and typecheck_binding (tyenv : Typeenv.t) (utbind : untyped_binding) : (binding list * StructSig.t abstracted) ok = @@ -786,8 +774,9 @@ and typecheck_binding (tyenv : Typeenv.t) (utbind : untyped_binding) : (binding if valattr.ValueAttribute.is_test then match (stage, valbind) with | (Stage1, UTNonRec(ident, utast1)) -> - let* (evid, e1, ssig) = typecheck_nonrec pre tyenv ident utast1 in - return ([ BindTest(evid, e1) ], (OpaqueIDMap.empty, ssig)) + let ty_expected = Primitives.option_type (Range.dummy "test-error", BaseType(StringType)) in + let* (evid, e1, _pty) = typecheck_nonrec pre tyenv ident utast1 (Some(ty_expected)) in + return ([ BindTest(evid, e1) ], (OpaqueIDMap.empty, StructSig.empty)) | _ -> let rng = Range.dummy "TODO (error): typecheck_binding, test" in @@ -796,7 +785,18 @@ and typecheck_binding (tyenv : Typeenv.t) (utbind : untyped_binding) : (binding let* (rec_or_nonrecs, ssig) = match valbind with | UTNonRec(ident, utast1) -> - let* (evid, e1, ssig) = typecheck_nonrec pre tyenv ident utast1 in + let* (evid, e1, pty) = typecheck_nonrec pre tyenv ident utast1 None in + let ssig = + let (_, varnm) = ident in + let ventry = + { + val_type = pty; + val_name = Some(evid); + val_stage = pre.stage; + } + in + StructSig.empty |> StructSig.add_value varnm ventry + in return ([ NonRec(evid, e1) ], ssig) | UTRec(utrecbinds) -> diff --git a/src/frontend/state.ml b/src/frontend/state.ml index c518fde6c..0248de50c 100644 --- a/src/frontend/state.ml +++ b/src/frontend/state.ml @@ -1,16 +1,29 @@ exception NotDuringPageBreak +type test_result = + | Pass + | Fail of string +(* TODO: extend this *) + type state = { mutable during_page_break : bool; + mutable test_result_acc : test_result Alist.t; } let state = { during_page_break = false; + test_result_acc = Alist.empty } let start_page_break () = state.during_page_break <- true let during_page_break () = state.during_page_break + +let add_test_result (r : test_result) = + state.test_result_acc <- Alist.extend state.test_result_acc r + +let get_all_test_results () = + Alist.to_list state.test_result_acc diff --git a/src/frontend/state.mli b/src/frontend/state.mli index 3e8d5722d..18e9b6912 100644 --- a/src/frontend/state.mli +++ b/src/frontend/state.mli @@ -1,6 +1,15 @@ exception NotDuringPageBreak +type test_result = + | Pass + | Fail of string +(* TODO: extend this *) + val start_page_break : unit -> unit val during_page_break : unit -> bool + +val add_test_result : test_result -> unit + +val get_all_test_results : unit -> test_result list diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index f19fe7be0..753d8f4f2 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -1052,6 +1052,7 @@ and abstract_tree = index : int; used_as_math_font : bool; } + | CatchTest of abstract_tree (* Primitive applications: *) #include "__attype.gen.ml" @@ -1232,6 +1233,7 @@ and code_value = index : int; used_as_math_font : bool; } + | CdCatchTest of code_value #include "__codetype.gen.ml" and code_inline_text_element = @@ -1478,6 +1480,9 @@ let rec unlift_code (code : code_value) : abstract_tree = | CdLoadCollectionFont{ path; index; used_as_math_font } -> LoadCollectionFont{ path; index; used_as_math_font } + + | CdCatchTest(code) -> + CatchTest(aux code) #include "__unliftcode.gen.ml" in aux code From a68885255856050310a54ebd745d3b72d7ee53d4 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 18 Nov 2022 00:12:55 +0900 Subject: [PATCH 189/288] change the result type of tests from 'option string' to 'unit' --- .../stdlib/stdlib.0.0.1/test/list-test.satyg | 6 ++--- src/frontend/evaluator.cppo.ml | 25 ++++++++++--------- src/frontend/logging.ml | 9 +++++-- src/frontend/logging.mli | 4 ++- src/frontend/main.ml | 4 +-- src/frontend/moduleTypechecker.ml | 5 ++-- src/frontend/state.ml | 10 +++++--- src/frontend/state.mli | 10 +++++--- src/frontend/types.cppo.ml | 17 +++++++++---- 9 files changed, 57 insertions(+), 33 deletions(-) diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/test/list-test.satyg b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/test/list-test.satyg index 59f9d112b..92d7e35a7 100644 --- a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/test/list-test.satyg +++ b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/test/list-test.satyg @@ -8,12 +8,12 @@ module ListTest = struct let expected = 25 in let got = List.fold-left ( + ) 0 input in if got == expected then - None + () else - Some(`FAILED: fold-left-test (expected: `# ^ (arabic expected) ^ `, got: `# ^ (arabic got) ^ `)`) + abort-with-message (`expected: `# ^ (arabic expected) ^ `, got: `# ^ (arabic got)) #[test] val abort-test = - abort-with-message `FAILED: abort` + abort-with-message `aborted` end diff --git a/src/frontend/evaluator.cppo.ml b/src/frontend/evaluator.cppo.ml index cb5bc54a0..232b7c088 100644 --- a/src/frontend/evaluator.cppo.ml +++ b/src/frontend/evaluator.cppo.ml @@ -431,19 +431,20 @@ and interpret_0 (env : environment) (ast : abstract_tree) : syntactic_value = in BaseConstant(BCFontKey(fontkey)) - | CatchTest(ast) -> - let value = + | CatchTest{ test_name; test_impl = ast } -> + let res = try - interpret_0 env ast + let value = interpret_0 env ast in + Ok(value) with | EvalError(msg) -> (* Catches aborts during tests. *) - Constructor("Some", BaseConstant(BCString(msg))) + Error(msg) in let test_result = - match value with - | Constructor("None", BaseConstant(BCUnit)) -> State.Pass - | Constructor("Some", BaseConstant(BCString(msg))) -> State.Fail(msg) - | _ -> report_bug_value "unexpected test result" value + match res with + | Ok(BaseConstant(BCUnit)) -> State.Pass{ test_name } + | Error(message) -> State.Fail{ test_name; message } + | Ok(value) -> report_bug_value "unexpected test result" value in State.add_test_result test_result; BaseConstant(BCUnit) @@ -627,9 +628,9 @@ and interpret_1 (env : environment) (ast : abstract_tree) : code_value = | LoadCollectionFont{ path; index; used_as_math_font } -> CdLoadCollectionFont{ path; index; used_as_math_font } - | CatchTest(ast1) -> + | CatchTest{ test_name; test_impl = ast1 } -> let code1 = interpret_1 env ast1 in - CdCatchTest(code1) + CdCatchTest{ test_name; test_impl = code1 } #include "__evaluator_1.gen.ml" @@ -1231,11 +1232,11 @@ let interpret_bindings_0 ~(run_tests : bool) (env : environment) (binds : bindin (env, Alist.extend acc cdbind) end - | BindTest(evid, ast) -> + | BindTest(evid, test_name, ast) -> if run_tests then let code = interpret_1 env ast in let (env, symb) = generate_symbol_for_eval_var_id evid env in - let cdbind = CdNonRec(symb, CdCatchTest(code)) in + let cdbind = CdNonRec(symb, CdCatchTest{ test_name; test_impl = code }) in (env, Alist.extend acc cdbind) else (env, acc) diff --git a/src/frontend/logging.ml b/src/frontend/logging.ml index a19430f53..36cffd322 100644 --- a/src/frontend/logging.ml +++ b/src/frontend/logging.ml @@ -186,8 +186,13 @@ let warn_unreachable (pageno : int) = pageno -let report_failed_test (msg : string) = - Printf.printf "! %s\n" msg +let report_passed_test ~(test_name : string) = + Printf.printf " OK: %s\n" test_name + + +let report_failed_test ~(test_name : string) ~(message : string) = + Printf.printf "! FAILED: %s\n" test_name; + Printf.printf " %s\n" message let all_tests_passed () = diff --git a/src/frontend/logging.mli b/src/frontend/logging.mli index afe6fc2ac..3ffd189c0 100644 --- a/src/frontend/logging.mli +++ b/src/frontend/logging.mli @@ -62,7 +62,9 @@ val warn_underfull_line : int -> unit val warn_unreachable : int -> unit -val report_failed_test : string -> unit +val report_passed_test : test_name:string -> unit + +val report_failed_test : test_name:string -> message:string -> unit val all_tests_passed : unit -> unit diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 604b0ed77..cfe388382 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1704,8 +1704,8 @@ let test let failure_found = test_results |> List.fold_left (fun failure_found test_result -> match test_result with - | State.Pass -> failure_found - | State.Fail(msg) -> Logging.report_failed_test msg; true + | State.Pass{ test_name } -> Logging.report_passed_test ~test_name; failure_found + | State.Fail{ test_name; message } -> Logging.report_failed_test ~test_name ~message; true ) false in if failure_found then begin diff --git a/src/frontend/moduleTypechecker.ml b/src/frontend/moduleTypechecker.ml index eb7aa2a48..11356a3a0 100644 --- a/src/frontend/moduleTypechecker.ml +++ b/src/frontend/moduleTypechecker.ml @@ -774,9 +774,10 @@ and typecheck_binding (tyenv : Typeenv.t) (utbind : untyped_binding) : (binding if valattr.ValueAttribute.is_test then match (stage, valbind) with | (Stage1, UTNonRec(ident, utast1)) -> - let ty_expected = Primitives.option_type (Range.dummy "test-error", BaseType(StringType)) in + let (_, test_name) = ident in + let ty_expected = (Range.dummy "test", BaseType(UnitType)) in let* (evid, e1, _pty) = typecheck_nonrec pre tyenv ident utast1 (Some(ty_expected)) in - return ([ BindTest(evid, e1) ], (OpaqueIDMap.empty, StructSig.empty)) + return ([ BindTest(evid, test_name, e1) ], (OpaqueIDMap.empty, StructSig.empty)) | _ -> let rng = Range.dummy "TODO (error): typecheck_binding, test" in diff --git a/src/frontend/state.ml b/src/frontend/state.ml index 0248de50c..a40f9d614 100644 --- a/src/frontend/state.ml +++ b/src/frontend/state.ml @@ -2,9 +2,13 @@ exception NotDuringPageBreak type test_result = - | Pass - | Fail of string -(* TODO: extend this *) + | Pass of { + test_name : string; + } + | Fail of { + test_name : string; + message : string; + } type state = { mutable during_page_break : bool; diff --git a/src/frontend/state.mli b/src/frontend/state.mli index 18e9b6912..5ac8c2a9a 100644 --- a/src/frontend/state.mli +++ b/src/frontend/state.mli @@ -2,9 +2,13 @@ exception NotDuringPageBreak type test_result = - | Pass - | Fail of string -(* TODO: extend this *) + | Pass of { + test_name : string; + } + | Fail of { + test_name : string; + message : string; + } val start_page_break : unit -> unit diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index 753d8f4f2..a7ed8df3d 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -718,7 +718,7 @@ and rec_or_nonrec = and binding = | Bind of stage * rec_or_nonrec - | BindTest of EvalVarID.t * abstract_tree + | BindTest of EvalVarID.t * string * abstract_tree and environment = location EvalVarIDMap.t * (syntactic_value StoreIDHashTable.t) ref @@ -1052,7 +1052,11 @@ and abstract_tree = index : int; used_as_math_font : bool; } - | CatchTest of abstract_tree +(* Tests: *) + | CatchTest of { + test_name : string; + test_impl : abstract_tree; + } (* Primitive applications: *) #include "__attype.gen.ml" @@ -1233,7 +1237,10 @@ and code_value = index : int; used_as_math_font : bool; } - | CdCatchTest of code_value + | CdCatchTest of { + test_name : string; + test_impl : code_value; + } #include "__codetype.gen.ml" and code_inline_text_element = @@ -1481,8 +1488,8 @@ let rec unlift_code (code : code_value) : abstract_tree = | CdLoadCollectionFont{ path; index; used_as_math_font } -> LoadCollectionFont{ path; index; used_as_math_font } - | CdCatchTest(code) -> - CatchTest(aux code) + | CdCatchTest{ test_name; test_impl = code } -> + CatchTest{ test_name; test_impl = aux code } #include "__unliftcode.gen.ml" in aux code From 848b94beb4358e0345aed4e4d94584a672e1c3a3 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 18 Nov 2022 00:43:09 +0900 Subject: [PATCH 190/288] fix how to run tests about 'use_test_only_lock' --- src/frontend/main.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index cfe388382..66ed7b903 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1658,7 +1658,7 @@ let test let (genv, _configenv, _libs_dep) = let lock_config_dir = make_abs_path (Filename.dirname (get_abs_path_string abspath_lock_config)) in - check_depended_packages ~use_test_only_lock:false ~lock_config_dir ~extensions tyenv_prim lock_config + check_depended_packages ~use_test_only_lock:true ~lock_config_dir ~extensions tyenv_prim lock_config in let libs = From 6828cfb241c75c5b26b19798c2ccdeaf3b28c035 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Fri, 18 Nov 2022 00:44:05 +0900 Subject: [PATCH 191/288] develop a new package 'testing' and use it in tests for 'stdlib' --- lib-satysfi/dist/cache/registry.yaml | 4 +++ .../stdlib/stdlib.0.0.1/package.satysfi-lock | 8 +++++- .../packages/stdlib/stdlib.0.0.1/satysfi.yaml | 3 +++ .../stdlib/stdlib.0.0.1/test/list-test.satyg | 20 ++++++++------- .../testing.0.0.1/package.satysfi-lock | 1 + .../testing/testing.0.0.1/satysfi.yaml | 7 ++++++ .../testing/testing.0.0.1/src/testing.satyg | 25 +++++++++++++++++++ 7 files changed, 58 insertions(+), 10 deletions(-) create mode 100644 lib-satysfi/dist/packages/testing/testing.0.0.1/package.satysfi-lock create mode 100644 lib-satysfi/dist/packages/testing/testing.0.0.1/satysfi.yaml create mode 100644 lib-satysfi/dist/packages/testing/testing.0.0.1/src/testing.satyg diff --git a/lib-satysfi/dist/cache/registry.yaml b/lib-satysfi/dist/cache/registry.yaml index 0fdb97f70..20cefacfa 100644 --- a/lib-satysfi/dist/cache/registry.yaml +++ b/lib-satysfi/dist/cache/registry.yaml @@ -1,4 +1,8 @@ packages: +- name: "testing" + implementations: + - version: "0.0.1" + dependencies: [] - name: "stdlib" implementations: - version: "0.0.1" diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/package.satysfi-lock b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/package.satysfi-lock index a2e98fa3c..ef9aff58e 100644 --- a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/package.satysfi-lock +++ b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/package.satysfi-lock @@ -1 +1,7 @@ -locks: [] +locks: +- name: testing.0.0.1 + location: + type: global + path: ./dist/packages/testing/testing.0.0.1/ + dependencies: [] + test_only: true diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/satysfi.yaml index 634302249..c43a5496f 100644 --- a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/satysfi.yaml +++ b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/satysfi.yaml @@ -7,3 +7,6 @@ contents: test_directories: - "./test" dependencies: [] + test_dependencies: + - name: "testing" + requirements: [ "0.0.1" ] diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/test/list-test.satyg b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/test/list-test.satyg index 92d7e35a7..4fbdabb77 100644 --- a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/test/list-test.satyg +++ b/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/test/list-test.satyg @@ -1,19 +1,21 @@ use List +use package Testing module ListTest = struct + module IntTarget = struct + type t = int + val equal m n = (m == n) + val show = arabic + end + module TEM = Testing.Equality.Make + module IntEquality = TEM IntTarget + #[test] val fold-left-test = let input = [3, 1, 4, 1, 5, 9, 2] in - let expected = 25 in + let expected = 24 in let got = List.fold-left ( + ) 0 input in - if got == expected then - () - else - abort-with-message (`expected: `# ^ (arabic expected) ^ `, got: `# ^ (arabic got)) - - #[test] - val abort-test = - abort-with-message `aborted` + IntEquality.assert-equal expected got end diff --git a/lib-satysfi/dist/packages/testing/testing.0.0.1/package.satysfi-lock b/lib-satysfi/dist/packages/testing/testing.0.0.1/package.satysfi-lock new file mode 100644 index 000000000..a2e98fa3c --- /dev/null +++ b/lib-satysfi/dist/packages/testing/testing.0.0.1/package.satysfi-lock @@ -0,0 +1 @@ +locks: [] diff --git a/lib-satysfi/dist/packages/testing/testing.0.0.1/satysfi.yaml b/lib-satysfi/dist/packages/testing/testing.0.0.1/satysfi.yaml new file mode 100644 index 000000000..4fcf1d6ca --- /dev/null +++ b/lib-satysfi/dist/packages/testing/testing.0.0.1/satysfi.yaml @@ -0,0 +1,7 @@ +language: "0.1.0" +contents: + type: "library" + main_module: "Testing" + source_directories: + - "./src" + dependencies: [] diff --git a/lib-satysfi/dist/packages/testing/testing.0.0.1/src/testing.satyg b/lib-satysfi/dist/packages/testing/testing.0.0.1/src/testing.satyg new file mode 100644 index 000000000..81940ecc4 --- /dev/null +++ b/lib-satysfi/dist/packages/testing/testing.0.0.1/src/testing.satyg @@ -0,0 +1,25 @@ +module Testing = struct + + module Equality = struct + + signature TargetType = sig + type t :: o + val equal : t -> t -> bool + val show : t -> string + end + + module Make = fun(Target : TargetType) -> struct + + val assert-equal (x1 : Target.t) (x2 : Target.t) = + if Target.equal x1 x2 then + () + else + let s1 = Target.show x1 in + let s2 = Target.show x2 in + abort-with-message (`expected: `# ^ s1 ^ `, got: `# ^ s2) + + end + + end + +end From 13bc074595b5557c90a6d076f4396b647417f627 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 19 Nov 2022 01:14:54 +0900 Subject: [PATCH 192/288] slight refactoring --- doc/local.satyh | 10 +--------- doc/paren.satyh | 6 +----- tests/Makefile | 1 - tests/head.satyh | 8 +------- 4 files changed, 3 insertions(+), 22 deletions(-) diff --git a/doc/local.satyh b/doc/local.satyh index 47d08f9dc..d3d0a1171 100644 --- a/doc/local.satyh +++ b/doc/local.satyh @@ -1,4 +1,4 @@ -use package Stdlib +use package open Stdlib use package Math use package StdJaBook use package FontLatinModern @@ -6,14 +6,6 @@ use LocalParen of `paren` module Local = struct - %- TODO: remove this by using 'open' - module List = Stdlib.List - module Pervasives = Stdlib.Pervasives - module Color = Stdlib.Color - module VDecoSet = Stdlib.VDecoSet - module HDecoSet = Stdlib.HDecoSet - - type type-syntax = | TypeName of inline-text | TypeConstructor of inline-text * list type-syntax diff --git a/doc/paren.satyh b/doc/paren.satyh index 4ae07a9d2..fc72ca66b 100644 --- a/doc/paren.satyh +++ b/doc/paren.satyh @@ -1,12 +1,8 @@ -use package Stdlib +use package open Stdlib use package Math module LocalParen = struct - %- TODO: remove this by using 'open' - module Gr = Stdlib.Gr - - val record-paren-left hgt dpt ctx = let fontsize = get-font-size ctx in let hgtaxis = fontsize *' get-math-axis-height-ratio ctx in diff --git a/tests/Makefile b/tests/Makefile index 630feb8f0..9255c82b2 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -49,7 +49,6 @@ all:: (cd md; make) # Entrypoint for promoting lock files: -# TODO: add `(cd md; make promote)` here promote:: $(EXPECTED_LOCKS) promote:: diff --git a/tests/head.satyh b/tests/head.satyh index d4dfac527..bc4e503b3 100644 --- a/tests/head.satyh +++ b/tests/head.satyh @@ -1,4 +1,4 @@ -use package Stdlib +use package open Stdlib use package Math use package FontJunicode @@ -8,12 +8,6 @@ use package FontLatinModernMath module Head = struct - %- TODO: remove this by using 'open' - module List = Stdlib.List - module Pervasives = Stdlib.Pervasives - module PaperSize = Stdlib.PaperSize - - val form-paragraph = line-break true true val gray x = Gray(x) From 4ea838344067b6f0814ef89c5cdc88fac5bb04eb Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 19 Nov 2022 04:24:00 +0900 Subject: [PATCH 193/288] extend the format of registry configs with sections about how to fetch sources --- lib-satysfi/dist/cache/registry.yaml | 33 ++++++++++++++++++++++++++++ src/frontend/packageRegistry.ml | 20 ++++++++++++++++- src/frontend/packageSystemBase.ml | 7 ++++++ 3 files changed, 59 insertions(+), 1 deletion(-) diff --git a/lib-satysfi/dist/cache/registry.yaml b/lib-satysfi/dist/cache/registry.yaml index 20cefacfa..58c23c375 100644 --- a/lib-satysfi/dist/cache/registry.yaml +++ b/lib-satysfi/dist/cache/registry.yaml @@ -6,16 +6,25 @@ packages: - name: "stdlib" implementations: - version: "0.0.1" + source: + type: "tar_gzip" + url: "https://gfngfn.github.io/temp/stdlib.0.0.1.tar.gz" dependencies: [] - name: "math" implementations: - version: "0.0.1" + source: + type: "tar_gzip" + url: "https://gfngfn.github.io/temp/math.0.0.1.tar.gz" dependencies: - name: "stdlib" requirements: [ "0.0.1" ] - name: "code" implementations: - version: "0.0.1" + source: + type: "tar_gzip" + url: "https://gfngfn.github.io/temp/code.0.0.1.tar.gz" dependencies: - name: "stdlib" requirements: [ "0.0.1" ] @@ -24,12 +33,18 @@ packages: - name: "annot" implementations: - version: "0.0.1" + source: + type: "tar_gzip" + url: "https://gfngfn.github.io/temp/annot.0.0.1.tar.gz" dependencies: - name: "stdlib" requirements: [ "0.0.1" ] - name: "itemize" implementations: - version: "0.0.1" + source: + type: "tar_gzip" + url: "https://gfngfn.github.io/temp/itemize.0.0.1.tar.gz" dependencies: - name: "stdlib" requirements: [ "0.0.1" ] @@ -48,6 +63,9 @@ packages: - name: "footnote-scheme" implementations: - version: "0.0.1" + source: + type: "tar_gzip" + url: "https://gfngfn.github.io/temp/footnote-scheme.0.0.1.tar.gz" dependencies: - name: "stdlib" requirements: [ "0.0.1" ] @@ -74,6 +92,9 @@ packages: - name: "std-ja-book" implementations: - version: "0.0.1" + source: + type: "tar_gzip" + url: "https://gfngfn.github.io/temp/std-ja-book.0.0.1.tar.gz" dependencies: - name: "stdlib" requirements: [ "0.0.1" ] @@ -142,16 +163,28 @@ packages: - name: "font-latin-modern" implementations: - version: "0.0.1" + source: + type: "tar_gzip" + url: "https://gfngfn.github.io/temp/font-latin-modern.0.0.1.tar.gz" dependencies: [] - name: "font-junicode" implementations: - version: "0.0.1" + source: + type: "tar_gzip" + url: "https://gfngfn.github.io/temp/font-junicode.0.0.1.tar.gz" dependencies: [] - name: "font-ipa-ex" implementations: - version: "0.0.1" + source: + type: "tar_gzip" + url: "https://gfngfn.github.io/temp/font-ipa-ex.0.0.1.tar.gz" dependencies: [] - name: "font-latin-modern-math" implementations: - version: "0.0.1" + source: + type: "tar_gzip" + url: "https://gfngfn.github.io/temp/font-latin-modern-math.0.0.1.tar.gz" dependencies: [] diff --git a/src/frontend/packageRegistry.ml b/src/frontend/packageRegistry.ml index 84e920570..7f503ca52 100644 --- a/src/frontend/packageRegistry.ml +++ b/src/frontend/packageRegistry.ml @@ -8,16 +8,34 @@ open PackageSystemBase type 'a ok = ('a, config_error) result +let source_decoder : implementation_source ConfigDecoder.t = + let open ConfigDecoder in + branch "type" [ + "tar_gzip" ==> begin + get "url" string >>= fun url -> + succeed @@ TarGzip{ url } + end; + ] + ~other:(fun tag -> + failure (fun context -> UnexpectedTag(context, tag)) + ) + + let implementation_decoder : implementation_record ConfigDecoder.t = let open ConfigDecoder in get "version" string >>= fun s_version -> + get_or_else "source" source_decoder NoSource >>= fun source -> get "dependencies" (list dependency_decoder) >>= fun dependencies -> match SemanticVersion.parse s_version with | None -> failure @@ (fun yctx -> NotASemanticVersion(yctx, s_version)) | Some(semver) -> - succeed { version = semver; requires = dependencies } + succeed { + version = semver; + source = source; + requires = dependencies; + } let package_decoder : (package_name * implementation_record list) ConfigDecoder.t = diff --git a/src/frontend/packageSystemBase.ml b/src/frontend/packageSystemBase.ml index 8928f232c..5793ead12 100644 --- a/src/frontend/packageSystemBase.ml +++ b/src/frontend/packageSystemBase.ml @@ -17,8 +17,15 @@ type package_dependency = } [@@deriving show { with_path = false }] +type implementation_source = + | NoSource + | TarGzip of { + url : string; + } + type implementation_record = { version : SemanticVersion.t; + source : implementation_source; requires : package_dependency list; } From 6335309854ce670b99267b6a3f3b999cb110c8b3 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 19 Nov 2022 04:46:47 +0900 Subject: [PATCH 194/288] extend 'package_solution' with 'locked_source' --- src/frontend/main.ml | 2 ++ src/frontend/packageConstraintSolver.ml | 26 +++++++++++++------------ src/frontend/packageRegistry.ml | 2 +- src/frontend/packageSystemBase.ml | 4 +++- 4 files changed, 20 insertions(+), 14 deletions(-) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 66ed7b903..44ddd5c8d 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1882,6 +1882,8 @@ let solve Logging.show_package_dependency_solutions solutions; + (* TODO: fetch package sources here based on `solutions` *) + let lock_config = convert_solutions_to_lock_config solutions in LockConfig.write abspath_lock_config lock_config; return () diff --git a/src/frontend/packageConstraintSolver.ml b/src/frontend/packageConstraintSolver.ml index abdcb3500..d8062c1ca 100644 --- a/src/frontend/packageConstraintSolver.ml +++ b/src/frontend/packageConstraintSolver.ml @@ -68,6 +68,7 @@ module SolverInput = struct | Impl of { package_name : package_name; version : SemanticVersion.t; + source : implementation_source; dependencies : dependency list; } @@ -149,9 +150,9 @@ module SolverInput = struct in let impls = impl_records |> List.map (fun impl_record -> - let version = impl_record.version in - let dependencies = make_internal_dependency context impl_record.requires in - Impl{ package_name; version; dependencies } + let ImplRecord{ version; source; requires } = impl_record in + let dependencies = make_internal_dependency context requires in + Impl{ package_name; version; source; dependencies } ) in { replacement = None; impls } @@ -270,21 +271,21 @@ let solve (context : package_context) (dependencies_with_flags : (dependency_fla (* Adds vertices to the graph: *) let rolemap = output |> Output.to_map in - let (quad_acc, graph, explicit_vertices, name_to_vertex_map) = + let (quint_acc, graph, explicit_vertices, name_to_vertex_map) = Output.RoleMap.fold (fun _role impl acc -> let impl = Output.unwrap impl in match impl with | DummyImpl | LocalImpl(_) -> acc - | Impl{ package_name; version = locked_version; dependencies; _ } -> - let (quad_acc, graph, explicit_vertices, name_to_vertex_map) = acc in + | Impl{ package_name; version = locked_version; source; dependencies } -> + let (quint_acc, graph, explicit_vertices, name_to_vertex_map) = acc in let (graph, vertex) = match graph |> LockDependencyGraph.add_vertex package_name () with | Error(_) -> assert false | Ok(pair) -> pair in - let quad_acc = Alist.extend quad_acc (package_name, locked_version, dependencies, vertex) in + let quint_acc = Alist.extend quint_acc (package_name, locked_version, source, dependencies, vertex) in let explicit_vertices = if explicit_source_dependencies |> PackageNameSet.mem package_name then explicit_vertices |> VertexSet.add vertex @@ -292,17 +293,17 @@ let solve (context : package_context) (dependencies_with_flags : (dependency_fla explicit_vertices in let name_to_vertex_map = name_to_vertex_map |> PackageNameMap.add package_name vertex in - (quad_acc, graph, explicit_vertices, name_to_vertex_map) + (quint_acc, graph, explicit_vertices, name_to_vertex_map) ) rolemap (Alist.empty, LockDependencyGraph.empty, VertexSet.empty, PackageNameMap.empty) in (* Add edges to the graph: *) let (solmap, graph) = - quad_acc |> Alist.to_list |> List.fold_left (fun acc quad -> + quint_acc |> Alist.to_list |> List.fold_left (fun acc quint -> let open SolverInput in let (solmap, graph) = acc in - let (package_name, locked_version, dependencies, vertex) = quad in + let (package_name, locked_version, source, dependencies, vertex) = quint in let (locked_dependency_acc, graph) = dependencies |> List.fold_left (fun (locked_dependency_acc, graph) dep -> let Dependency{ role = role_dep; _ } = dep in @@ -330,7 +331,7 @@ let solve (context : package_context) (dependencies_with_flags : (dependency_fla ) (Alist.empty, graph) in let locked_dependencies = Alist.to_list locked_dependency_acc in - let solmap = solmap |> PackageNameMap.add package_name (locked_version, locked_dependencies) in + let solmap = solmap |> PackageNameMap.add package_name (locked_version, source, locked_dependencies) in (solmap, graph) ) (PackageNameMap.empty, graph) @@ -342,7 +343,7 @@ let solve (context : package_context) (dependencies_with_flags : (dependency_fla in let solution_acc = - PackageNameMap.fold (fun package_name (locked_version, locked_dependencies) solution_acc -> + PackageNameMap.fold (fun package_name (locked_version, locked_source, locked_dependencies) solution_acc -> let vertex = match name_to_vertex_map |> PackageNameMap.find_opt package_name with | None -> assert false @@ -352,6 +353,7 @@ let solve (context : package_context) (dependencies_with_flags : (dependency_fla Alist.extend solution_acc { package_name; locked_version; + locked_source; locked_dependencies; used_in_test_only; } diff --git a/src/frontend/packageRegistry.ml b/src/frontend/packageRegistry.ml index 7f503ca52..4fa938925 100644 --- a/src/frontend/packageRegistry.ml +++ b/src/frontend/packageRegistry.ml @@ -31,7 +31,7 @@ let implementation_decoder : implementation_record ConfigDecoder.t = failure @@ (fun yctx -> NotASemanticVersion(yctx, s_version)) | Some(semver) -> - succeed { + succeed @@ ImplRecord{ version = semver; source = source; requires = dependencies; diff --git a/src/frontend/packageSystemBase.ml b/src/frontend/packageSystemBase.ml index 5793ead12..702fea8c7 100644 --- a/src/frontend/packageSystemBase.ml +++ b/src/frontend/packageSystemBase.ml @@ -22,8 +22,9 @@ type implementation_source = | TarGzip of { url : string; } +[@@deriving show { with_path = false }] -type implementation_record = { +type implementation_record = ImplRecord of { version : SemanticVersion.t; source : implementation_source; requires : package_dependency list; @@ -36,6 +37,7 @@ type package_context = { type package_solution = { package_name : package_name; locked_version : SemanticVersion.t; + locked_source : implementation_source; locked_dependencies : (package_name * SemanticVersion.t) list; used_in_test_only : bool; } From f0bea39e500cb196df13467c0be9e98c0a798cad Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 19 Nov 2022 15:51:00 +0900 Subject: [PATCH 195/288] introduce 'implementation_spec' --- src/frontend/closedLockDependencyResolver.ml | 1 + src/frontend/configError.ml | 1 + src/frontend/lockConfig.ml | 2 +- src/frontend/main.ml | 33 ++++++++++++++------ src/frontend/packageSystemBase.ml | 29 ++++++++++++++--- src/frontend/types.cppo.ml | 9 ------ 6 files changed, 51 insertions(+), 24 deletions(-) diff --git a/src/frontend/closedLockDependencyResolver.ml b/src/frontend/closedLockDependencyResolver.ml index 2cb7f9d0c..bc6fce5ac 100644 --- a/src/frontend/closedLockDependencyResolver.ml +++ b/src/frontend/closedLockDependencyResolver.ml @@ -1,5 +1,6 @@ open MyUtil +open PackageSystemBase open Types open ConfigError diff --git a/src/frontend/configError.ml b/src/frontend/configError.ml index 5b11172e6..84b058051 100644 --- a/src/frontend/configError.ml +++ b/src/frontend/configError.ml @@ -1,5 +1,6 @@ open MyUtil +open PackageSystemBase open Types diff --git a/src/frontend/lockConfig.ml b/src/frontend/lockConfig.ml index 9334c77a8..b54d5c0a6 100644 --- a/src/frontend/lockConfig.ml +++ b/src/frontend/lockConfig.ml @@ -1,6 +1,6 @@ open MyUtil -open Types +open PackageSystemBase open ConfigError open ConfigUtil diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 44ddd5c8d..40c03eedd 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1734,14 +1734,16 @@ let make_lock_name (package_name : package_name) (semver : SemanticVersion.t) : Printf.sprintf "%s.%s" package_name (SemanticVersion.to_string semver) -let convert_solutions_to_lock_config (solutions : package_solution list) : LockConfig.t = - let locked_packages = - solutions |> List.map (fun solution -> +let convert_solutions_to_lock_config (solutions : package_solution list) : LockConfig.t * implementation_spec list = + let (locked_package_acc, impl_spec_acc) = + solutions |> List.fold_left (fun (locked_package_acc, impl_spec_acc) solution -> let package_name = solution.package_name in let lock_name = make_lock_name package_name solution.locked_version in + let libpathstr_container = Printf.sprintf "./dist/packages/%s/" package_name in + let libpathstr_lock = Filename.concat libpathstr_container lock_name in let lock_location = LockConfig.GlobalLocation{ - path = Printf.sprintf "./dist/packages/%s/%s/" package_name lock_name; + path = libpathstr_lock; } in let lock_dependencies = @@ -1750,10 +1752,19 @@ let convert_solutions_to_lock_config (solutions : package_solution list) : LockC ) in let test_only_lock = solution.used_in_test_only in - LockConfig.{ lock_name; lock_location; lock_dependencies; test_only_lock } - ) + let locked_package = LockConfig.{ lock_name; lock_location; lock_dependencies; test_only_lock } in + let impl_spec = + ImplSpec{ + lock_name = lock_name; + container_directory = make_lib_path libpathstr_container; + source = solution.locked_source; + } + in + (Alist.extend locked_package_acc locked_package, Alist.extend impl_spec_acc impl_spec) + ) (Alist.empty, Alist.empty) in - LockConfig.{ locked_packages } + let lock_config = LockConfig.{ locked_packages = Alist.to_list locked_package_acc } in + (lock_config, Alist.to_list impl_spec_acc) let extract_attributes_from_document_file (input_kind : input_kind) (abspath_in : abs_path) : (DocumentAttribute.t, config_error) result = @@ -1882,9 +1893,13 @@ let solve Logging.show_package_dependency_solutions solutions; - (* TODO: fetch package sources here based on `solutions` *) + let (lock_config, impl_specs) = convert_solutions_to_lock_config solutions in + + impl_specs |> List.iter (fun _impl_spec -> + (* TODO: fetch package sources here based on `impl_spec` *) + () + ); - let lock_config = convert_solutions_to_lock_config solutions in LockConfig.write abspath_lock_config lock_config; return () end diff --git a/src/frontend/packageSystemBase.ml b/src/frontend/packageSystemBase.ml index 702fea8c7..6280ad6e8 100644 --- a/src/frontend/packageSystemBase.ml +++ b/src/frontend/packageSystemBase.ml @@ -1,4 +1,15 @@ +open MyUtil + +type lock_name = string [@@deriving show] + +type lock_info = { + lock_name : lock_name; + lock_dependencies : lock_name list; + lock_directory : abs_path; +} +[@@deriving show { with_path = false }] + module PackageNameMap = Map.Make(String) module PackageNameSet = Set.Make(String) @@ -24,11 +35,12 @@ type implementation_source = } [@@deriving show { with_path = false }] -type implementation_record = ImplRecord of { - version : SemanticVersion.t; - source : implementation_source; - requires : package_dependency list; -} +type implementation_record = + | ImplRecord of { + version : SemanticVersion.t; + source : implementation_source; + requires : package_dependency list; + } type package_context = { registry_contents : (implementation_record list) PackageNameMap.t; @@ -51,3 +63,10 @@ type dependency_flag = | SourceDependency | TestOnlyDependency [@@deriving show { with_path = false }] + +type implementation_spec = + | ImplSpec of { + lock_name : lock_name; + container_directory : lib_path; + source : implementation_source; + } diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index a7ed8df3d..6686b3177 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -41,8 +41,6 @@ type type_variable_name = string [@@deriving show] type row_variable_name = string [@@deriving show] type label = string [@@deriving show] -type lock_name = string [@@deriving show] - type attribute_name = string [@@deriving show] type input_position = { @@ -624,13 +622,6 @@ type untyped_package = } [@@deriving show { with_path = false }] -type lock_info = { - lock_name : lock_name; - lock_dependencies : lock_name list; - lock_directory : abs_path; -} -[@@deriving show { with_path = false }] - type untyped_letrec_pattern_branch = | UTLetRecPatternBranch of untyped_pattern_tree list * untyped_abstract_tree From 14d79ca57f3c0bc3972a4c6231f15f4aa8b27f60 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 19 Nov 2022 17:30:45 +0900 Subject: [PATCH 196/288] introduce 'primary_root_dir' for fetching package implementations --- src/frontend/main.ml | 27 ++++++++++++++++++++++++++- src/frontend/packageSystemBase.ml | 2 +- 2 files changed, 27 insertions(+), 2 deletions(-) diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 40c03eedd..620bf9f05 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -12,6 +12,7 @@ exception NoLibraryRootDesignation exception ShouldSpecifyOutputFile exception UnexpectedExtension of string exception ConfigError of config_error +exception CannotDeterminePrimaryRoot (* Initialization that should be performed before every cross-reference-solving loop *) @@ -1239,6 +1240,11 @@ let error_log_environment (suspended : unit -> unit) : unit = | ConfigError(e) -> report_config_error e + | CannotDeterminePrimaryRoot -> + report_error Interface [ + NormalLine("cannot determine the primary library root."); + ] + | FontInfo.FontInfoError(e) -> report_font_error e @@ -1356,6 +1362,21 @@ let setup_root_dirs ~(no_default_config : bool) ~(extra_config_paths : (string l | _ :: _ -> Config.initialize dirs +(* TODO: refine this *) +let primary_root_dir () : abs_path = + let abspathstr = + if Sys.os_type = "Win32" then + match Sys.getenv_opt "userprofile" with + | None -> raise CannotDeterminePrimaryRoot + | Some(s) -> Filename.concat s ".satysfi" + else + match Sys.getenv_opt "HOME" with + | None -> raise CannotDeterminePrimaryRoot + | Some(s) -> Filename.concat s ".satysfi" + in + make_abs_path abspathstr + + let make_absolute_if_relative ~(origin : string) (s : string) : abs_path = let abspath_str = if Filename.is_relative s then Filename.concat origin s else s in make_abs_path abspath_str @@ -1754,9 +1775,13 @@ let convert_solutions_to_lock_config (solutions : package_solution list) : LockC let test_only_lock = solution.used_in_test_only in let locked_package = LockConfig.{ lock_name; lock_location; lock_dependencies; test_only_lock } in let impl_spec = + let abspath_primary_root = primary_root_dir () in + let abspath_container = + make_abs_path (Filename.concat (get_abs_path_string abspath_primary_root) libpathstr_container) + in ImplSpec{ lock_name = lock_name; - container_directory = make_lib_path libpathstr_container; + container_directory = abspath_container; source = solution.locked_source; } in diff --git a/src/frontend/packageSystemBase.ml b/src/frontend/packageSystemBase.ml index 6280ad6e8..d23ddc5d1 100644 --- a/src/frontend/packageSystemBase.ml +++ b/src/frontend/packageSystemBase.ml @@ -67,6 +67,6 @@ type dependency_flag = type implementation_spec = | ImplSpec of { lock_name : lock_name; - container_directory : lib_path; + container_directory : abs_path; source : implementation_source; } From 9613c8d76e3d3608c6307255e4809667b692cf1d Mon Sep 17 00:00:00 2001 From: gfngfn Date: Sat, 19 Nov 2022 17:37:36 +0900 Subject: [PATCH 197/288] update expected lock files --- demo/demo.satysfi-lock-expected | 26 +++++++++++----------- doc/doc-lang.satysfi-lock-expected | 18 +++++++-------- doc/doc-primitives.satysfi-lock-expected | 22 +++++++++--------- doc/math1.satysfi-lock-expected | 22 +++++++++--------- tests/Makefile | 2 +- tests/clip.satysfi-lock-expected | 12 +++++----- tests/glue1.satysfi-lock-expected | 12 +++++----- tests/images/test.satysfi-lock-expected | 20 ++++++++--------- tests/macro1.satysfi-lock-expected | 20 ++++++++--------- tests/math-typefaces.satysfi-lock-expected | 22 +++++++++--------- tests/math2.satysfi-lock-expected | 12 +++++----- tests/md/test.satysfi-lock-expected | 22 +++++++++--------- tests/refactor1.satysfi-lock-expected | 10 ++++----- tests/refactor2.satysfi-lock-expected | 6 ++--- tests/refactor3.satysfi-lock-expected | 6 ++--- tests/refactor5.satysfi-lock-expected | 6 ++--- tests/staged1.satysfi-lock-expected | 18 +++++++-------- 17 files changed, 128 insertions(+), 128 deletions(-) diff --git a/demo/demo.satysfi-lock-expected b/demo/demo.satysfi-lock-expected index d6a41e519..e3ba8332f 100644 --- a/demo/demo.satysfi-lock-expected +++ b/demo/demo.satysfi-lock-expected @@ -2,14 +2,14 @@ locks: - name: annot.0.0.1 location: type: global - path: ./dist/packages/annot/annot.0.0.1/ + path: ./dist/packages/annot/annot.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: code.0.0.1 location: type: global - path: ./dist/packages/code/code.0.0.1/ + path: ./dist/packages/code/code.0.0.1 dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 @@ -17,59 +17,59 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + path: ./dist/packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: footnote-scheme.0.0.1 location: type: global - path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1/ + path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: itemize.0.0.1 location: type: global - path: ./dist/packages/itemize/itemize.0.0.1/ + path: ./dist/packages/itemize/itemize.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1/ + path: ./dist/packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: proof.0.0.1 location: type: global - path: ./dist/packages/proof/proof.0.0.1/ + path: ./dist/packages/proof/proof.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: std-ja-book.0.0.1 location: type: global - path: ./dist/packages/std-ja-book/std-ja-book.0.0.1/ + path: ./dist/packages/std-ja-book/std-ja-book.0.0.1 dependencies: - stdlib.0.0.1 - math.0.0.1 @@ -84,13 +84,13 @@ locks: - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1/ + path: ./dist/packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false - name: tabular.0.0.1 location: type: global - path: ./dist/packages/tabular/tabular.0.0.1/ + path: ./dist/packages/tabular/tabular.0.0.1 dependencies: - stdlib.0.0.1 test_only: false diff --git a/doc/doc-lang.satysfi-lock-expected b/doc/doc-lang.satysfi-lock-expected index fa57d1904..85533cfd0 100644 --- a/doc/doc-lang.satysfi-lock-expected +++ b/doc/doc-lang.satysfi-lock-expected @@ -2,14 +2,14 @@ locks: - name: annot.0.0.1 location: type: global - path: ./dist/packages/annot/annot.0.0.1/ + path: ./dist/packages/annot/annot.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: code.0.0.1 location: type: global - path: ./dist/packages/code/code.0.0.1/ + path: ./dist/packages/code/code.0.0.1 dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 @@ -17,38 +17,38 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + path: ./dist/packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1/ + path: ./dist/packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: std-ja.0.0.1 location: type: global - path: ./dist/packages/std-ja/std-ja.0.0.1/ + path: ./dist/packages/std-ja/std-ja.0.0.1 dependencies: - stdlib.0.0.1 - math.0.0.1 @@ -62,6 +62,6 @@ locks: - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1/ + path: ./dist/packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false diff --git a/doc/doc-primitives.satysfi-lock-expected b/doc/doc-primitives.satysfi-lock-expected index c366a425e..691256653 100644 --- a/doc/doc-primitives.satysfi-lock-expected +++ b/doc/doc-primitives.satysfi-lock-expected @@ -2,14 +2,14 @@ locks: - name: annot.0.0.1 location: type: global - path: ./dist/packages/annot/annot.0.0.1/ + path: ./dist/packages/annot/annot.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: code.0.0.1 location: type: global - path: ./dist/packages/code/code.0.0.1/ + path: ./dist/packages/code/code.0.0.1 dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 @@ -17,52 +17,52 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + path: ./dist/packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: footnote-scheme.0.0.1 location: type: global - path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1/ + path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: itemize.0.0.1 location: type: global - path: ./dist/packages/itemize/itemize.0.0.1/ + path: ./dist/packages/itemize/itemize.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1/ + path: ./dist/packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: std-ja-book.0.0.1 location: type: global - path: ./dist/packages/std-ja-book/std-ja-book.0.0.1/ + path: ./dist/packages/std-ja-book/std-ja-book.0.0.1 dependencies: - stdlib.0.0.1 - math.0.0.1 @@ -77,6 +77,6 @@ locks: - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1/ + path: ./dist/packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false diff --git a/doc/math1.satysfi-lock-expected b/doc/math1.satysfi-lock-expected index 3aa031e32..574135604 100644 --- a/doc/math1.satysfi-lock-expected +++ b/doc/math1.satysfi-lock-expected @@ -2,14 +2,14 @@ locks: - name: annot.0.0.1 location: type: global - path: ./dist/packages/annot/annot.0.0.1/ + path: ./dist/packages/annot/annot.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: code.0.0.1 location: type: global - path: ./dist/packages/code/code.0.0.1/ + path: ./dist/packages/code/code.0.0.1 dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 @@ -17,45 +17,45 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + path: ./dist/packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1/ + path: ./dist/packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: proof.0.0.1 location: type: global - path: ./dist/packages/proof/proof.0.0.1/ + path: ./dist/packages/proof/proof.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: std-ja.0.0.1 location: type: global - path: ./dist/packages/std-ja/std-ja.0.0.1/ + path: ./dist/packages/std-ja/std-ja.0.0.1 dependencies: - stdlib.0.0.1 - math.0.0.1 @@ -69,13 +69,13 @@ locks: - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1/ + path: ./dist/packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false - name: tabular.0.0.1 location: type: global - path: ./dist/packages/tabular/tabular.0.0.1/ + path: ./dist/packages/tabular/tabular.0.0.1 dependencies: - stdlib.0.0.1 test_only: false diff --git a/tests/Makefile b/tests/Makefile index 9255c82b2..634750e47 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -57,7 +57,7 @@ promote:: (cd md; make promote) clean:: - rm -f *.pdf *.satysfi-aux + rm -f *.pdf *.satysfi-aux *.satysfi-lock clean:: (cd images; make clean) diff --git a/tests/clip.satysfi-lock-expected b/tests/clip.satysfi-lock-expected index aeacb20d5..e74dd5887 100644 --- a/tests/clip.satysfi-lock-expected +++ b/tests/clip.satysfi-lock-expected @@ -2,37 +2,37 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + path: ./dist/packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1/ + path: ./dist/packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1/ + path: ./dist/packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false diff --git a/tests/glue1.satysfi-lock-expected b/tests/glue1.satysfi-lock-expected index aeacb20d5..e74dd5887 100644 --- a/tests/glue1.satysfi-lock-expected +++ b/tests/glue1.satysfi-lock-expected @@ -2,37 +2,37 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + path: ./dist/packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1/ + path: ./dist/packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1/ + path: ./dist/packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false diff --git a/tests/images/test.satysfi-lock-expected b/tests/images/test.satysfi-lock-expected index 4d923b2e0..7cb6dac84 100644 --- a/tests/images/test.satysfi-lock-expected +++ b/tests/images/test.satysfi-lock-expected @@ -2,14 +2,14 @@ locks: - name: annot.0.0.1 location: type: global - path: ./dist/packages/annot/annot.0.0.1/ + path: ./dist/packages/annot/annot.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: code.0.0.1 location: type: global - path: ./dist/packages/code/code.0.0.1/ + path: ./dist/packages/code/code.0.0.1 dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 @@ -17,45 +17,45 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + path: ./dist/packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: itemize.0.0.1 location: type: global - path: ./dist/packages/itemize/itemize.0.0.1/ + path: ./dist/packages/itemize/itemize.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1/ + path: ./dist/packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: std-ja.0.0.1 location: type: global - path: ./dist/packages/std-ja/std-ja.0.0.1/ + path: ./dist/packages/std-ja/std-ja.0.0.1 dependencies: - stdlib.0.0.1 - math.0.0.1 @@ -69,6 +69,6 @@ locks: - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1/ + path: ./dist/packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false diff --git a/tests/macro1.satysfi-lock-expected b/tests/macro1.satysfi-lock-expected index 6430e66bb..f99a5d0cc 100644 --- a/tests/macro1.satysfi-lock-expected +++ b/tests/macro1.satysfi-lock-expected @@ -2,14 +2,14 @@ locks: - name: annot.0.0.1 location: type: global - path: ./dist/packages/annot/annot.0.0.1/ + path: ./dist/packages/annot/annot.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: code.0.0.1 location: type: global - path: ./dist/packages/code/code.0.0.1/ + path: ./dist/packages/code/code.0.0.1 dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 @@ -17,45 +17,45 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + path: ./dist/packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: footnote-scheme.0.0.1 location: type: global - path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1/ + path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1/ + path: ./dist/packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: std-ja-report.0.0.1 location: type: global - path: ./dist/packages/std-ja-report/std-ja-report.0.0.1/ + path: ./dist/packages/std-ja-report/std-ja-report.0.0.1 dependencies: - stdlib.0.0.1 - math.0.0.1 @@ -70,6 +70,6 @@ locks: - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1/ + path: ./dist/packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false diff --git a/tests/math-typefaces.satysfi-lock-expected b/tests/math-typefaces.satysfi-lock-expected index 255558b23..99b3f8df1 100644 --- a/tests/math-typefaces.satysfi-lock-expected +++ b/tests/math-typefaces.satysfi-lock-expected @@ -2,14 +2,14 @@ locks: - name: annot.0.0.1 location: type: global - path: ./dist/packages/annot/annot.0.0.1/ + path: ./dist/packages/annot/annot.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: code.0.0.1 location: type: global - path: ./dist/packages/code/code.0.0.1/ + path: ./dist/packages/code/code.0.0.1 dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 @@ -17,52 +17,52 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + path: ./dist/packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: footnote-scheme.0.0.1 location: type: global - path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1/ + path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: itemize.0.0.1 location: type: global - path: ./dist/packages/itemize/itemize.0.0.1/ + path: ./dist/packages/itemize/itemize.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1/ + path: ./dist/packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: std-ja-report.0.0.1 location: type: global - path: ./dist/packages/std-ja-report/std-ja-report.0.0.1/ + path: ./dist/packages/std-ja-report/std-ja-report.0.0.1 dependencies: - stdlib.0.0.1 - math.0.0.1 @@ -77,6 +77,6 @@ locks: - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1/ + path: ./dist/packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false diff --git a/tests/math2.satysfi-lock-expected b/tests/math2.satysfi-lock-expected index aeacb20d5..e74dd5887 100644 --- a/tests/math2.satysfi-lock-expected +++ b/tests/math2.satysfi-lock-expected @@ -2,37 +2,37 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + path: ./dist/packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1/ + path: ./dist/packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1/ + path: ./dist/packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false diff --git a/tests/md/test.satysfi-lock-expected b/tests/md/test.satysfi-lock-expected index 1f15d14a7..064794080 100644 --- a/tests/md/test.satysfi-lock-expected +++ b/tests/md/test.satysfi-lock-expected @@ -2,14 +2,14 @@ locks: - name: annot.0.0.1 location: type: global - path: ./dist/packages/annot/annot.0.0.1/ + path: ./dist/packages/annot/annot.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: code.0.0.1 location: type: global - path: ./dist/packages/code/code.0.0.1/ + path: ./dist/packages/code/code.0.0.1 dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 @@ -17,52 +17,52 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + path: ./dist/packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: footnote-scheme.0.0.1 location: type: global - path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1/ + path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: itemize.0.0.1 location: type: global - path: ./dist/packages/itemize/itemize.0.0.1/ + path: ./dist/packages/itemize/itemize.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1/ + path: ./dist/packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: md-ja.0.0.1 location: type: global - path: ./dist/packages/md-ja/md-ja.0.0.1/ + path: ./dist/packages/md-ja/md-ja.0.0.1 dependencies: - stdlib.0.0.1 - math.0.0.1 @@ -78,6 +78,6 @@ locks: - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1/ + path: ./dist/packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false diff --git a/tests/refactor1.satysfi-lock-expected b/tests/refactor1.satysfi-lock-expected index 607c96b56..917770269 100644 --- a/tests/refactor1.satysfi-lock-expected +++ b/tests/refactor1.satysfi-lock-expected @@ -2,31 +2,31 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + path: ./dist/packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1/ + path: ./dist/packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1/ + path: ./dist/packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false diff --git a/tests/refactor2.satysfi-lock-expected b/tests/refactor2.satysfi-lock-expected index b0560eef0..1e7029d1a 100644 --- a/tests/refactor2.satysfi-lock-expected +++ b/tests/refactor2.satysfi-lock-expected @@ -2,18 +2,18 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + path: ./dist/packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false diff --git a/tests/refactor3.satysfi-lock-expected b/tests/refactor3.satysfi-lock-expected index b0560eef0..1e7029d1a 100644 --- a/tests/refactor3.satysfi-lock-expected +++ b/tests/refactor3.satysfi-lock-expected @@ -2,18 +2,18 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + path: ./dist/packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false diff --git a/tests/refactor5.satysfi-lock-expected b/tests/refactor5.satysfi-lock-expected index b0560eef0..1e7029d1a 100644 --- a/tests/refactor5.satysfi-lock-expected +++ b/tests/refactor5.satysfi-lock-expected @@ -2,18 +2,18 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + path: ./dist/packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false diff --git a/tests/staged1.satysfi-lock-expected b/tests/staged1.satysfi-lock-expected index fa57d1904..85533cfd0 100644 --- a/tests/staged1.satysfi-lock-expected +++ b/tests/staged1.satysfi-lock-expected @@ -2,14 +2,14 @@ locks: - name: annot.0.0.1 location: type: global - path: ./dist/packages/annot/annot.0.0.1/ + path: ./dist/packages/annot/annot.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: code.0.0.1 location: type: global - path: ./dist/packages/code/code.0.0.1/ + path: ./dist/packages/code/code.0.0.1 dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 @@ -17,38 +17,38 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/ + path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1/ + path: ./dist/packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1/ + path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/ + path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1/ + path: ./dist/packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: std-ja.0.0.1 location: type: global - path: ./dist/packages/std-ja/std-ja.0.0.1/ + path: ./dist/packages/std-ja/std-ja.0.0.1 dependencies: - stdlib.0.0.1 - math.0.0.1 @@ -62,6 +62,6 @@ locks: - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1/ + path: ./dist/packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false From 55a9ba6777c31803ef91169d0fd43a2e133d7e79 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Tue, 22 Nov 2022 00:53:03 +0900 Subject: [PATCH 198/288] update CI about 'diff' on 'macos-latest' --- .github/workflows/ci.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 332ed012e..99cc2106b 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -41,6 +41,7 @@ jobs: run: | if [ "${{ matrix.os }}" == 'macos-latest' ]; then brew install coreutils + brew install diffutils fi - name: Setup OCaml ${{ matrix.ocaml-version }} and pin satysfi From bcdbf10f5dd0f0e8e6e7af36b5046737cb173e69 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 23 Nov 2022 04:43:32 +0900 Subject: [PATCH 199/288] add 'LockFetcher' --- satysfi.opam | 1 + src/dune | 1 + src/frontend/configError.ml | 1 + src/frontend/lockFetcher.ml | 52 +++++++++++++++++++++++++++++++++++++ src/frontend/logging.ml | 8 ++++++ src/frontend/logging.mli | 4 +++ src/frontend/main.ml | 26 ++++++++++++++----- 7 files changed, 86 insertions(+), 7 deletions(-) create mode 100644 src/frontend/lockFetcher.ml diff --git a/satysfi.opam b/satysfi.opam index 12e7662f0..60cb573de 100644 --- a/satysfi.opam +++ b/satysfi.opam @@ -26,6 +26,7 @@ depends: [ "camlpdf" {= "2.3.1+satysfi"} "cmdliner" {>= "1.1.1"} "core_kernel" {>= "v0.15"} + "core_unix" {>= "v0.15"} "cppo" {build & >= "1.6.4" & < "1.7.0"} "dune" {build} "menhir" diff --git a/src/dune b/src/dune index 96e3eadd5..2a6d3130e 100644 --- a/src/dune +++ b/src/dune @@ -10,6 +10,7 @@ camlpdf core_kernel core_kernel.pairing_heap + core_unix menhirLib otfed uutf diff --git a/src/frontend/configError.ml b/src/frontend/configError.ml index 84b058051..425ca480a 100644 --- a/src/frontend/configError.ml +++ b/src/frontend/configError.ml @@ -82,3 +82,4 @@ type config_error = | NoMarkdownConversion of module_name | MoreThanOneMarkdownConversion of module_name | MarkdownError of MarkdownParser.error + | LockFetcherError of LockFetcher.error diff --git a/src/frontend/lockFetcher.ml b/src/frontend/lockFetcher.ml new file mode 100644 index 000000000..3b7fb971c --- /dev/null +++ b/src/frontend/lockFetcher.ml @@ -0,0 +1,52 @@ + +open MyUtil +open PackageSystemBase + + +type error = + | FetchFailed of { + lock_name : lock_name; + exit_status : int; + fetch_command : string; + } + + +let fetch_tarball ~(wget_command : string) ~(lock_name : lock_name) ~(url : string) ~(output : abs_path) : (unit, error) result = + let open ResultMonad in + let fetch_command = Printf.sprintf "\"%s\" -O \"%s\" \"%s\"" wget_command (get_abs_path_string output) url in + let exit_status = Sys.command fetch_command in + if exit_status = 0 then + return () + else + err @@ FetchFailed{ lock_name; exit_status; fetch_command } + + +let main ~(wget_command : string) (impl_spec : implementation_spec) : (unit, error) result = + let open ResultMonad in + let ImplSpec{ lock_name; container_directory; source } = impl_spec in + let absdirstr_container = get_abs_path_string container_directory in + let absdirstr_lock_root = Filename.concat absdirstr_container lock_name in + + (* Creates the directory if non-existent, or does nothing otherwise: *) + Core_unix.mkdir_p absdirstr_lock_root; + + if Sys.file_exists (Filename.concat absdirstr_lock_root "package.yaml") then begin + (* If the lock has already been fetched: *) + Logging.lock_already_installed lock_name (make_abs_path absdirstr_lock_root); + return () + end else begin + Logging.installing_lock lock_name (make_abs_path absdirstr_lock_root); + match source with + | NoSource -> + return () + + | TarGzip{ url } -> + (* Synchronously fetches a tarball: *) + let abspath_tarball = + make_abs_path (Filename.concat absdirstr_container (Printf.sprintf "%s.tar.gz" lock_name)) + in + let* () = fetch_tarball ~wget_command ~lock_name ~url ~output:abspath_tarball in + + (* TODO: extract sources from the tarball here *) + return () + end diff --git a/src/frontend/logging.ml b/src/frontend/logging.ml index 36cffd322..232643bf9 100644 --- a/src/frontend/logging.ml +++ b/src/frontend/logging.ml @@ -203,3 +203,11 @@ let all_tests_passed () = let some_test_failed () = print_endline " ---- ---- ---- ----"; print_endline "! some test has failed." + + +let lock_already_installed (lock_name : lock_name) (absdir : abs_path) = + Printf.printf " '%s': already installed at '%s'" lock_name (get_abs_path_string absdir) + + +let installing_lock (lock_name : lock_name) (absdir : abs_path) = + Printf.printf " installing '%s' at '%s'..." lock_name (get_abs_path_string absdir) diff --git a/src/frontend/logging.mli b/src/frontend/logging.mli index 3ffd189c0..0e267af86 100644 --- a/src/frontend/logging.mli +++ b/src/frontend/logging.mli @@ -69,3 +69,7 @@ val report_failed_test : test_name:string -> message:string -> unit val all_tests_passed : unit -> unit val some_test_failed : unit -> unit + +val lock_already_installed : lock_name -> abs_path -> unit + +val installing_lock : lock_name -> abs_path -> unit diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 620bf9f05..ccc40c6d2 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1122,6 +1122,16 @@ let report_config_error : config_error -> unit = function report_document_attribute_error de end + | LockFetcherError(e) -> + begin + match e with + | LockFetcher.FetchFailed{ lock_name; exit_status; fetch_command } -> + report_error Interface [ + NormalLine(Printf.sprintf "failed to fetch '%s' (exit status: %d). command:" lock_name exit_status); + DisplayLine(fetch_command); + ] + end + let report_font_error : font_error -> unit = function | FailedToReadFont(abspath, msg) -> @@ -1363,7 +1373,7 @@ let setup_root_dirs ~(no_default_config : bool) ~(extra_config_paths : (string l (* TODO: refine this *) -let primary_root_dir () : abs_path = +let get_primary_root_dir () : abs_path = let abspathstr = if Sys.os_type = "Win32" then match Sys.getenv_opt "userprofile" with @@ -1775,7 +1785,7 @@ let convert_solutions_to_lock_config (solutions : package_solution list) : LockC let test_only_lock = solution.used_in_test_only in let locked_package = LockConfig.{ lock_name; lock_location; lock_dependencies; test_only_lock } in let impl_spec = - let abspath_primary_root = primary_root_dir () in + let abspath_primary_root = get_primary_root_dir () in let abspath_container = make_abs_path (Filename.concat (get_abs_path_string abspath_primary_root) libpathstr_container) in @@ -1920,11 +1930,13 @@ let solve let (lock_config, impl_specs) = convert_solutions_to_lock_config solutions in - impl_specs |> List.iter (fun _impl_spec -> - (* TODO: fetch package sources here based on `impl_spec` *) - () - ); - + let wget_command = "wget" in (* TODO: make this changeable *) + let* () = + impl_specs |> foldM (fun () impl_spec -> + LockFetcher.main ~wget_command impl_spec + |> Result.map_error (fun e -> LockFetcherError(e)) + ) () + in LockConfig.write abspath_lock_config lock_config; return () end From 7644fb6308b650ead48f35cfd8bc7fa38198a713 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 23 Nov 2022 05:07:16 +0900 Subject: [PATCH 200/288] develop how to extract tarballs of locked packages --- src/frontend/lockFetcher.ml | 34 ++++++++++++++++++++++++++++++---- src/frontend/main.ml | 11 +++++++++-- 2 files changed, 39 insertions(+), 6 deletions(-) diff --git a/src/frontend/lockFetcher.ml b/src/frontend/lockFetcher.ml index 3b7fb971c..ca9370612 100644 --- a/src/frontend/lockFetcher.ml +++ b/src/frontend/lockFetcher.ml @@ -4,11 +4,16 @@ open PackageSystemBase type error = - | FetchFailed of { + | FailedToFetchTarball of { lock_name : lock_name; exit_status : int; fetch_command : string; } + | FailedToExtractTarball of { + lock_name : lock_name; + exit_status : int; + extraction_command : string; + } let fetch_tarball ~(wget_command : string) ~(lock_name : lock_name) ~(url : string) ~(output : abs_path) : (unit, error) result = @@ -18,10 +23,25 @@ let fetch_tarball ~(wget_command : string) ~(lock_name : lock_name) ~(url : stri if exit_status = 0 then return () else - err @@ FetchFailed{ lock_name; exit_status; fetch_command } + err @@ FailedToFetchTarball{ lock_name; exit_status; fetch_command } -let main ~(wget_command : string) (impl_spec : implementation_spec) : (unit, error) result = +let extract_tarball_with_components_stripped ~(tar_command : string) ~(lock_name : lock_name) ~tarball:(abspath_tarball : abs_path) ~lock_root:(absdir_lock_root : abs_path) = + let open ResultMonad in + let extraction_command = + Printf.sprintf "\"%s\" -xzf \"%s\" -C \"%s\" --strip-components 1" + (String.escaped tar_command) + (String.escaped (get_abs_path_string abspath_tarball)) + (String.escaped (get_abs_path_string absdir_lock_root)) + in + let exit_status = Sys.command extraction_command in + if exit_status = 0 then + return () + else + err @@ FailedToExtractTarball{ lock_name; exit_status; extraction_command } + + +let main ~(wget_command : string) ~(tar_command : string) (impl_spec : implementation_spec) : (unit, error) result = let open ResultMonad in let ImplSpec{ lock_name; container_directory; source } = impl_spec in let absdirstr_container = get_abs_path_string container_directory in @@ -47,6 +67,12 @@ let main ~(wget_command : string) (impl_spec : implementation_spec) : (unit, err in let* () = fetch_tarball ~wget_command ~lock_name ~url ~output:abspath_tarball in - (* TODO: extract sources from the tarball here *) + (* Extract sources from the tarball: *) + let absdir_lock_root = make_abs_path absdirstr_lock_root in + let* () = + extract_tarball_with_components_stripped + ~tar_command ~lock_name ~tarball:abspath_tarball ~lock_root:absdir_lock_root + in + return () end diff --git a/src/frontend/main.ml b/src/frontend/main.ml index ccc40c6d2..247aed462 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1125,11 +1125,17 @@ let report_config_error : config_error -> unit = function | LockFetcherError(e) -> begin match e with - | LockFetcher.FetchFailed{ lock_name; exit_status; fetch_command } -> + | LockFetcher.FailedToFetchTarball{ lock_name; exit_status; fetch_command } -> report_error Interface [ NormalLine(Printf.sprintf "failed to fetch '%s' (exit status: %d). command:" lock_name exit_status); DisplayLine(fetch_command); ] + + | LockFetcher.FailedToExtractTarball{ lock_name; exit_status; extraction_command } -> + report_error Interface [ + NormalLine(Printf.sprintf "failed to extract the tarball of '%s' (exit status: %d). command:" lock_name exit_status); + DisplayLine(extraction_command); + ] end @@ -1931,9 +1937,10 @@ let solve let (lock_config, impl_specs) = convert_solutions_to_lock_config solutions in let wget_command = "wget" in (* TODO: make this changeable *) + let tar_command = "tar" in (* TODO: make this changeable *) let* () = impl_specs |> foldM (fun () impl_spec -> - LockFetcher.main ~wget_command impl_spec + LockFetcher.main ~wget_command ~tar_command impl_spec |> Result.map_error (fun e -> LockFetcherError(e)) ) () in From 30c4c8c18b40639eb5a293293cc2f15bda7b9b47 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 23 Nov 2022 05:38:46 +0900 Subject: [PATCH 201/288] small fixes --- lib-satysfi/dist/cache/registry.yaml | 3 --- src/frontend/lockFetcher.ml | 39 +++++++++++++++++++++------- src/frontend/logging.ml | 10 ++++--- src/frontend/logging.mli | 4 ++- src/frontend/main.ml | 6 ++++- 5 files changed, 45 insertions(+), 17 deletions(-) diff --git a/lib-satysfi/dist/cache/registry.yaml b/lib-satysfi/dist/cache/registry.yaml index 58c23c375..bbb8dbfbe 100644 --- a/lib-satysfi/dist/cache/registry.yaml +++ b/lib-satysfi/dist/cache/registry.yaml @@ -42,9 +42,6 @@ packages: - name: "itemize" implementations: - version: "0.0.1" - source: - type: "tar_gzip" - url: "https://gfngfn.github.io/temp/itemize.0.0.1.tar.gz" dependencies: - name: "stdlib" requirements: [ "0.0.1" ] diff --git a/src/frontend/lockFetcher.ml b/src/frontend/lockFetcher.ml index ca9370612..5f44e2502 100644 --- a/src/frontend/lockFetcher.ml +++ b/src/frontend/lockFetcher.ml @@ -16,9 +16,19 @@ type error = } +(* Escapes double quotes and backslashes. TODO: refine this *) +let escape_string = + String.escaped + + let fetch_tarball ~(wget_command : string) ~(lock_name : lock_name) ~(url : string) ~(output : abs_path) : (unit, error) result = let open ResultMonad in - let fetch_command = Printf.sprintf "\"%s\" -O \"%s\" \"%s\"" wget_command (get_abs_path_string output) url in + let fetch_command = + Printf.sprintf "\"%s\" -O \"%s\" \"%s\"" + (escape_string wget_command) + (escape_string (get_abs_path_string output)) + (escape_string url) + in let exit_status = Sys.command fetch_command in if exit_status = 0 then return () @@ -30,9 +40,9 @@ let extract_tarball_with_components_stripped ~(tar_command : string) ~(lock_name let open ResultMonad in let extraction_command = Printf.sprintf "\"%s\" -xzf \"%s\" -C \"%s\" --strip-components 1" - (String.escaped tar_command) - (String.escaped (get_abs_path_string abspath_tarball)) - (String.escaped (get_abs_path_string absdir_lock_root)) + (escape_string tar_command) + (escape_string (get_abs_path_string abspath_tarball)) + (escape_string (get_abs_path_string absdir_lock_root)) in let exit_status = Sys.command extraction_command in if exit_status = 0 then @@ -41,21 +51,23 @@ let extract_tarball_with_components_stripped ~(tar_command : string) ~(lock_name err @@ FailedToExtractTarball{ lock_name; exit_status; extraction_command } -let main ~(wget_command : string) ~(tar_command : string) (impl_spec : implementation_spec) : (unit, error) result = +let main ~(wget_command : string) ~(tar_command : string) ~cache_directory:(absdir_lock_cache : abs_path) (impl_spec : implementation_spec) : (unit, error) result = let open ResultMonad in let ImplSpec{ lock_name; container_directory; source } = impl_spec in let absdirstr_container = get_abs_path_string container_directory in let absdirstr_lock_root = Filename.concat absdirstr_container lock_name in + (* Creates the lock cache directory if non-existent, or does nothing otherwise: *) + Core_unix.mkdir_p (get_abs_path_string absdir_lock_cache); + (* Creates the directory if non-existent, or does nothing otherwise: *) Core_unix.mkdir_p absdirstr_lock_root; - if Sys.file_exists (Filename.concat absdirstr_lock_root "package.yaml") then begin + if Sys.file_exists (Filename.concat absdirstr_lock_root "satysfi.yaml") then begin (* If the lock has already been fetched: *) Logging.lock_already_installed lock_name (make_abs_path absdirstr_lock_root); return () end else begin - Logging.installing_lock lock_name (make_abs_path absdirstr_lock_root); match source with | NoSource -> return () @@ -63,9 +75,18 @@ let main ~(wget_command : string) ~(tar_command : string) (impl_spec : implement | TarGzip{ url } -> (* Synchronously fetches a tarball: *) let abspath_tarball = - make_abs_path (Filename.concat absdirstr_container (Printf.sprintf "%s.tar.gz" lock_name)) + make_abs_path + (Filename.concat (get_abs_path_string absdir_lock_cache) (Printf.sprintf "%s.tar.gz" lock_name)) + in + let* () = + if Sys.file_exists (get_abs_path_string abspath_tarball) then begin + Logging.lock_cache_exists lock_name abspath_tarball; + return () + end else begin + Logging.downloading_lock lock_name abspath_tarball; + fetch_tarball ~wget_command ~lock_name ~url ~output:abspath_tarball + end in - let* () = fetch_tarball ~wget_command ~lock_name ~url ~output:abspath_tarball in (* Extract sources from the tarball: *) let absdir_lock_root = make_abs_path absdirstr_lock_root in diff --git a/src/frontend/logging.ml b/src/frontend/logging.ml index 232643bf9..8fe6750f6 100644 --- a/src/frontend/logging.ml +++ b/src/frontend/logging.ml @@ -206,8 +206,12 @@ let some_test_failed () = let lock_already_installed (lock_name : lock_name) (absdir : abs_path) = - Printf.printf " '%s': already installed at '%s'" lock_name (get_abs_path_string absdir) + Printf.printf " '%s': already installed at '%s'\n" lock_name (get_abs_path_string absdir) -let installing_lock (lock_name : lock_name) (absdir : abs_path) = - Printf.printf " installing '%s' at '%s'..." lock_name (get_abs_path_string absdir) +let lock_cache_exists (lock_name : lock_name) (abspath_tarball : abs_path) = + Printf.printf " cache for '%s' exists at '%s'\n" lock_name (get_abs_path_string abspath_tarball) + + +let downloading_lock (lock_name : lock_name) (absdir : abs_path) = + Printf.printf " downloading '%s' to '%s'...\n" lock_name (get_abs_path_string absdir) diff --git a/src/frontend/logging.mli b/src/frontend/logging.mli index 0e267af86..e49dd9b57 100644 --- a/src/frontend/logging.mli +++ b/src/frontend/logging.mli @@ -72,4 +72,6 @@ val some_test_failed : unit -> unit val lock_already_installed : lock_name -> abs_path -> unit -val installing_lock : lock_name -> abs_path -> unit +val lock_cache_exists : lock_name -> abs_path -> unit + +val downloading_lock : lock_name -> abs_path -> unit diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 247aed462..6ea83978a 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1938,9 +1938,13 @@ let solve let wget_command = "wget" in (* TODO: make this changeable *) let tar_command = "tar" in (* TODO: make this changeable *) + let absdir_lock_cache = + let absdir_primary_root = get_primary_root_dir () in + make_abs_path (Filename.concat (get_abs_path_string absdir_primary_root) "dist/cache/locks") + in let* () = impl_specs |> foldM (fun () impl_spec -> - LockFetcher.main ~wget_command ~tar_command impl_spec + LockFetcher.main ~wget_command ~tar_command ~cache_directory:absdir_lock_cache impl_spec |> Result.map_error (fun e -> LockFetcherError(e)) ) () in From 2bea99c27de4b2a5b23a6a9d2bf472ef89253c32 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 5 Dec 2022 17:25:17 +0900 Subject: [PATCH 202/288] add an interface file to 'LockFetcher' --- src/frontend/lockFetcher.mli | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) create mode 100644 src/frontend/lockFetcher.mli diff --git a/src/frontend/lockFetcher.mli b/src/frontend/lockFetcher.mli new file mode 100644 index 000000000..f335b65cd --- /dev/null +++ b/src/frontend/lockFetcher.mli @@ -0,0 +1,21 @@ + +open MyUtil +open PackageSystemBase + +type error = + | FailedToFetchTarball of { + lock_name : lock_name; + exit_status : int; + fetch_command : string; + } + | FailedToExtractTarball of { + lock_name : lock_name; + exit_status : int; + extraction_command : string; + } + +val main : + wget_command:string -> + tar_command:string -> + cache_directory:abs_path -> + PackageSystemBase.implementation_spec -> (unit, error) result From 5291900e43d58b66baeccf4e8d2e3f2fa2ef9515 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Mon, 5 Dec 2022 17:29:14 +0900 Subject: [PATCH 203/288] small changes --- src/frontend/lockFetcher.mli | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/frontend/lockFetcher.mli b/src/frontend/lockFetcher.mli index f335b65cd..3c90c822e 100644 --- a/src/frontend/lockFetcher.mli +++ b/src/frontend/lockFetcher.mli @@ -18,4 +18,4 @@ val main : wget_command:string -> tar_command:string -> cache_directory:abs_path -> - PackageSystemBase.implementation_spec -> (unit, error) result + implementation_spec -> (unit, error) result From e05a63c09ee1785a3779c085f08db35192ca701e Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 7 Dec 2022 00:54:57 +0900 Subject: [PATCH 204/288] remove 'dist/' --- lib-satysfi/{dist => }/hyph/english.satysfi-hyph | 0 .../packages/annot/annot.0.0.1/package.satysfi-lock | 0 .../{dist => }/packages/annot/annot.0.0.1/satysfi.yaml | 0 .../{dist => }/packages/annot/annot.0.0.1/src/annot.satyh | 0 lib-satysfi/{dist => }/packages/bnf.satyh | 0 lib-satysfi/{dist => }/packages/cd.satyh | 0 .../packages/code/code.0.0.1/package.satysfi-lock | 0 .../{dist => }/packages/code/code.0.0.1/satysfi.yaml | 0 .../{dist => }/packages/code/code.0.0.1/src/code.satyh | 0 .../packages/font-ipa-ex/font-ipa-ex.0.0.1/fonts/.gitkeep | 0 .../packages/font-ipa-ex/font-ipa-ex.0.0.1/satysfi.yaml | 0 .../font-junicode/font-junicode.0.0.1/fonts/.gitkeep | 0 .../packages/font-junicode/font-junicode.0.0.1/satysfi.yaml | 0 .../font-latin-modern-math.0.0.1/fonts/.gitkeep | 0 .../font-latin-modern-math.0.0.1/satysfi.yaml | 0 .../font-latin-modern.0.0.1/fonts/.gitkeep | 0 .../font-latin-modern/font-latin-modern.0.0.1/satysfi.yaml | 0 .../footnote-scheme.0.0.1/package.satysfi-lock | 0 .../footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml | 0 .../footnote-scheme.0.0.1/src/footnote-scheme.satyh | 0 lib-satysfi/{dist => }/packages/html-base.satyh-html | 0 .../packages/itemize/itemize.0.0.1/package.satysfi-lock | 0 .../{dist => }/packages/itemize/itemize.0.0.1/satysfi.yaml | 0 .../packages/itemize/itemize.0.0.1/src/itemize.satyh | 0 .../packages/math/math.0.0.1/package.satysfi-lock | 0 .../{dist => }/packages/math/math.0.0.1/satysfi.yaml | 0 .../{dist => }/packages/math/math.0.0.1/src/math.satyh | 0 .../packages/md-ja/md-ja.0.0.1/package.satysfi-lock | 0 .../{dist => }/packages/md-ja/md-ja.0.0.1/satysfi.yaml | 0 .../{dist => }/packages/md-ja/md-ja.0.0.1/src/md-ja.satyh | 0 lib-satysfi/{dist => }/packages/mitou-detail.satyh | 0 lib-satysfi/{dist => }/packages/mitou-report.satyh | 0 lib-satysfi/{dist => }/packages/picture.satyh | 0 lib-satysfi/{dist => }/packages/progsynt.satyh | 0 .../packages/proof/proof.0.0.1/package.satysfi-lock | 0 .../{dist => }/packages/proof/proof.0.0.1/satysfi.yaml | 0 .../{dist => }/packages/proof/proof.0.0.1/src/proof.satyh | 0 lib-satysfi/{dist => }/packages/standalone.satyh | 0 .../std-ja-book/std-ja-book.0.0.1/package.satysfi-lock | 0 .../packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml | 0 .../std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh | 0 .../std-ja-report/std-ja-report.0.0.1/package.satysfi-lock | 0 .../packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml | 0 .../std-ja-report.0.0.1/src/std-ja-report.satyh | 0 .../packages/std-ja/std-ja.0.0.1/package.satysfi-lock | 0 .../{dist => }/packages/std-ja/std-ja.0.0.1/satysfi.yaml | 0 .../packages/std-ja/std-ja.0.0.1/src/std-ja.satyh | 0 .../packages/stdlib/stdlib.0.0.1/package.satysfi-lock | 0 .../{dist => }/packages/stdlib/stdlib.0.0.1/satysfi.yaml | 0 .../{dist => }/packages/stdlib/stdlib.0.0.1/src/color.satyh | 0 .../{dist => }/packages/stdlib/stdlib.0.0.1/src/deco.satyh | 0 .../{dist => }/packages/stdlib/stdlib.0.0.1/src/geom.satyh | 0 .../{dist => }/packages/stdlib/stdlib.0.0.1/src/gr.satyh | 0 .../packages/stdlib/stdlib.0.0.1/src/hdecoset.satyh | 0 .../{dist => }/packages/stdlib/stdlib.0.0.1/src/list.satyg | 0 .../packages/stdlib/stdlib.0.0.1/src/option.satyg | 0 .../packages/stdlib/stdlib.0.0.1/src/paper-size.satyh | 0 .../packages/stdlib/stdlib.0.0.1/src/pervasives.satyh | 0 .../packages/stdlib/stdlib.0.0.1/src/stdlib.satyh | 0 .../packages/stdlib/stdlib.0.0.1/src/vdecoset.satyh | 0 .../packages/stdlib/stdlib.0.0.1/test/list-test.satyg | 0 lib-satysfi/{dist => }/packages/table.satyh | 0 .../packages/tabular/tabular.0.0.1/package.satysfi-lock | 0 .../{dist => }/packages/tabular/tabular.0.0.1/satysfi.yaml | 0 .../packages/tabular/tabular.0.0.1/src/tabular.satyh | 0 lib-satysfi/{dist => }/packages/tabularx.satyh | 0 .../packages/testing/testing.0.0.1/package.satysfi-lock | 0 .../{dist => }/packages/testing/testing.0.0.1/satysfi.yaml | 0 .../packages/testing/testing.0.0.1/src/testing.satyg | 0 .../{dist/cache => registries/default}/registry.yaml | 0 lib-satysfi/{dist => }/unidata/.gitignore | 0 lib-satysfi/{dist => }/unidata/EastAsianWidth.txt | 0 lib-satysfi/{dist => }/unidata/LineBreak.txt | 0 lib-satysfi/{dist => }/unidata/PropList.txt | 0 lib-satysfi/{dist => }/unidata/PropertyAliases.txt | 0 lib-satysfi/{dist => }/unidata/PropertyValueAliases.txt | 0 lib-satysfi/{dist => }/unidata/ScriptExtensions.txt | 0 lib-satysfi/{dist => }/unidata/Scripts.txt | 0 lib-satysfi/{dist => }/unidata/UnicodeData.txt | 0 src/chardecoder/lineBreakDataMap.ml | 2 +- src/frontend/fontInfo.ml | 6 +++--- src/frontend/main.ml | 6 +++--- src/frontend/primitives.cppo.ml | 2 +- 83 files changed, 8 insertions(+), 8 deletions(-) rename lib-satysfi/{dist => }/hyph/english.satysfi-hyph (100%) rename lib-satysfi/{dist => }/packages/annot/annot.0.0.1/package.satysfi-lock (100%) rename lib-satysfi/{dist => }/packages/annot/annot.0.0.1/satysfi.yaml (100%) rename lib-satysfi/{dist => }/packages/annot/annot.0.0.1/src/annot.satyh (100%) rename lib-satysfi/{dist => }/packages/bnf.satyh (100%) rename lib-satysfi/{dist => }/packages/cd.satyh (100%) rename lib-satysfi/{dist => }/packages/code/code.0.0.1/package.satysfi-lock (100%) rename lib-satysfi/{dist => }/packages/code/code.0.0.1/satysfi.yaml (100%) rename lib-satysfi/{dist => }/packages/code/code.0.0.1/src/code.satyh (100%) rename lib-satysfi/{dist => }/packages/font-ipa-ex/font-ipa-ex.0.0.1/fonts/.gitkeep (100%) rename lib-satysfi/{dist => }/packages/font-ipa-ex/font-ipa-ex.0.0.1/satysfi.yaml (100%) rename lib-satysfi/{dist => }/packages/font-junicode/font-junicode.0.0.1/fonts/.gitkeep (100%) rename lib-satysfi/{dist => }/packages/font-junicode/font-junicode.0.0.1/satysfi.yaml (100%) rename lib-satysfi/{dist => }/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/fonts/.gitkeep (100%) rename lib-satysfi/{dist => }/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/satysfi.yaml (100%) rename lib-satysfi/{dist => }/packages/font-latin-modern/font-latin-modern.0.0.1/fonts/.gitkeep (100%) rename lib-satysfi/{dist => }/packages/font-latin-modern/font-latin-modern.0.0.1/satysfi.yaml (100%) rename lib-satysfi/{dist => }/packages/footnote-scheme/footnote-scheme.0.0.1/package.satysfi-lock (100%) rename lib-satysfi/{dist => }/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml (100%) rename lib-satysfi/{dist => }/packages/footnote-scheme/footnote-scheme.0.0.1/src/footnote-scheme.satyh (100%) rename lib-satysfi/{dist => }/packages/html-base.satyh-html (100%) rename lib-satysfi/{dist => }/packages/itemize/itemize.0.0.1/package.satysfi-lock (100%) rename lib-satysfi/{dist => }/packages/itemize/itemize.0.0.1/satysfi.yaml (100%) rename lib-satysfi/{dist => }/packages/itemize/itemize.0.0.1/src/itemize.satyh (100%) rename lib-satysfi/{dist => }/packages/math/math.0.0.1/package.satysfi-lock (100%) rename lib-satysfi/{dist => }/packages/math/math.0.0.1/satysfi.yaml (100%) rename lib-satysfi/{dist => }/packages/math/math.0.0.1/src/math.satyh (100%) rename lib-satysfi/{dist => }/packages/md-ja/md-ja.0.0.1/package.satysfi-lock (100%) rename lib-satysfi/{dist => }/packages/md-ja/md-ja.0.0.1/satysfi.yaml (100%) rename lib-satysfi/{dist => }/packages/md-ja/md-ja.0.0.1/src/md-ja.satyh (100%) rename lib-satysfi/{dist => }/packages/mitou-detail.satyh (100%) rename lib-satysfi/{dist => }/packages/mitou-report.satyh (100%) rename lib-satysfi/{dist => }/packages/picture.satyh (100%) rename lib-satysfi/{dist => }/packages/progsynt.satyh (100%) rename lib-satysfi/{dist => }/packages/proof/proof.0.0.1/package.satysfi-lock (100%) rename lib-satysfi/{dist => }/packages/proof/proof.0.0.1/satysfi.yaml (100%) rename lib-satysfi/{dist => }/packages/proof/proof.0.0.1/src/proof.satyh (100%) rename lib-satysfi/{dist => }/packages/standalone.satyh (100%) rename lib-satysfi/{dist => }/packages/std-ja-book/std-ja-book.0.0.1/package.satysfi-lock (100%) rename lib-satysfi/{dist => }/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml (100%) rename lib-satysfi/{dist => }/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh (100%) rename lib-satysfi/{dist => }/packages/std-ja-report/std-ja-report.0.0.1/package.satysfi-lock (100%) rename lib-satysfi/{dist => }/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml (100%) rename lib-satysfi/{dist => }/packages/std-ja-report/std-ja-report.0.0.1/src/std-ja-report.satyh (100%) rename lib-satysfi/{dist => }/packages/std-ja/std-ja.0.0.1/package.satysfi-lock (100%) rename lib-satysfi/{dist => }/packages/std-ja/std-ja.0.0.1/satysfi.yaml (100%) rename lib-satysfi/{dist => }/packages/std-ja/std-ja.0.0.1/src/std-ja.satyh (100%) rename lib-satysfi/{dist => }/packages/stdlib/stdlib.0.0.1/package.satysfi-lock (100%) rename lib-satysfi/{dist => }/packages/stdlib/stdlib.0.0.1/satysfi.yaml (100%) rename lib-satysfi/{dist => }/packages/stdlib/stdlib.0.0.1/src/color.satyh (100%) rename lib-satysfi/{dist => }/packages/stdlib/stdlib.0.0.1/src/deco.satyh (100%) rename lib-satysfi/{dist => }/packages/stdlib/stdlib.0.0.1/src/geom.satyh (100%) rename lib-satysfi/{dist => }/packages/stdlib/stdlib.0.0.1/src/gr.satyh (100%) rename lib-satysfi/{dist => }/packages/stdlib/stdlib.0.0.1/src/hdecoset.satyh (100%) rename lib-satysfi/{dist => }/packages/stdlib/stdlib.0.0.1/src/list.satyg (100%) rename lib-satysfi/{dist => }/packages/stdlib/stdlib.0.0.1/src/option.satyg (100%) rename lib-satysfi/{dist => }/packages/stdlib/stdlib.0.0.1/src/paper-size.satyh (100%) rename lib-satysfi/{dist => }/packages/stdlib/stdlib.0.0.1/src/pervasives.satyh (100%) rename lib-satysfi/{dist => }/packages/stdlib/stdlib.0.0.1/src/stdlib.satyh (100%) rename lib-satysfi/{dist => }/packages/stdlib/stdlib.0.0.1/src/vdecoset.satyh (100%) rename lib-satysfi/{dist => }/packages/stdlib/stdlib.0.0.1/test/list-test.satyg (100%) rename lib-satysfi/{dist => }/packages/table.satyh (100%) rename lib-satysfi/{dist => }/packages/tabular/tabular.0.0.1/package.satysfi-lock (100%) rename lib-satysfi/{dist => }/packages/tabular/tabular.0.0.1/satysfi.yaml (100%) rename lib-satysfi/{dist => }/packages/tabular/tabular.0.0.1/src/tabular.satyh (100%) rename lib-satysfi/{dist => }/packages/tabularx.satyh (100%) rename lib-satysfi/{dist => }/packages/testing/testing.0.0.1/package.satysfi-lock (100%) rename lib-satysfi/{dist => }/packages/testing/testing.0.0.1/satysfi.yaml (100%) rename lib-satysfi/{dist => }/packages/testing/testing.0.0.1/src/testing.satyg (100%) rename lib-satysfi/{dist/cache => registries/default}/registry.yaml (100%) rename lib-satysfi/{dist => }/unidata/.gitignore (100%) rename lib-satysfi/{dist => }/unidata/EastAsianWidth.txt (100%) rename lib-satysfi/{dist => }/unidata/LineBreak.txt (100%) rename lib-satysfi/{dist => }/unidata/PropList.txt (100%) rename lib-satysfi/{dist => }/unidata/PropertyAliases.txt (100%) rename lib-satysfi/{dist => }/unidata/PropertyValueAliases.txt (100%) rename lib-satysfi/{dist => }/unidata/ScriptExtensions.txt (100%) rename lib-satysfi/{dist => }/unidata/Scripts.txt (100%) rename lib-satysfi/{dist => }/unidata/UnicodeData.txt (100%) diff --git a/lib-satysfi/dist/hyph/english.satysfi-hyph b/lib-satysfi/hyph/english.satysfi-hyph similarity index 100% rename from lib-satysfi/dist/hyph/english.satysfi-hyph rename to lib-satysfi/hyph/english.satysfi-hyph diff --git a/lib-satysfi/dist/packages/annot/annot.0.0.1/package.satysfi-lock b/lib-satysfi/packages/annot/annot.0.0.1/package.satysfi-lock similarity index 100% rename from lib-satysfi/dist/packages/annot/annot.0.0.1/package.satysfi-lock rename to lib-satysfi/packages/annot/annot.0.0.1/package.satysfi-lock diff --git a/lib-satysfi/dist/packages/annot/annot.0.0.1/satysfi.yaml b/lib-satysfi/packages/annot/annot.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/annot/annot.0.0.1/satysfi.yaml rename to lib-satysfi/packages/annot/annot.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/annot/annot.0.0.1/src/annot.satyh b/lib-satysfi/packages/annot/annot.0.0.1/src/annot.satyh similarity index 100% rename from lib-satysfi/dist/packages/annot/annot.0.0.1/src/annot.satyh rename to lib-satysfi/packages/annot/annot.0.0.1/src/annot.satyh diff --git a/lib-satysfi/dist/packages/bnf.satyh b/lib-satysfi/packages/bnf.satyh similarity index 100% rename from lib-satysfi/dist/packages/bnf.satyh rename to lib-satysfi/packages/bnf.satyh diff --git a/lib-satysfi/dist/packages/cd.satyh b/lib-satysfi/packages/cd.satyh similarity index 100% rename from lib-satysfi/dist/packages/cd.satyh rename to lib-satysfi/packages/cd.satyh diff --git a/lib-satysfi/dist/packages/code/code.0.0.1/package.satysfi-lock b/lib-satysfi/packages/code/code.0.0.1/package.satysfi-lock similarity index 100% rename from lib-satysfi/dist/packages/code/code.0.0.1/package.satysfi-lock rename to lib-satysfi/packages/code/code.0.0.1/package.satysfi-lock diff --git a/lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml b/lib-satysfi/packages/code/code.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/code/code.0.0.1/satysfi.yaml rename to lib-satysfi/packages/code/code.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/code/code.0.0.1/src/code.satyh b/lib-satysfi/packages/code/code.0.0.1/src/code.satyh similarity index 100% rename from lib-satysfi/dist/packages/code/code.0.0.1/src/code.satyh rename to lib-satysfi/packages/code/code.0.0.1/src/code.satyh diff --git a/lib-satysfi/dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/fonts/.gitkeep b/lib-satysfi/packages/font-ipa-ex/font-ipa-ex.0.0.1/fonts/.gitkeep similarity index 100% rename from lib-satysfi/dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/fonts/.gitkeep rename to lib-satysfi/packages/font-ipa-ex/font-ipa-ex.0.0.1/fonts/.gitkeep diff --git a/lib-satysfi/dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/satysfi.yaml b/lib-satysfi/packages/font-ipa-ex/font-ipa-ex.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/satysfi.yaml rename to lib-satysfi/packages/font-ipa-ex/font-ipa-ex.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/font-junicode/font-junicode.0.0.1/fonts/.gitkeep b/lib-satysfi/packages/font-junicode/font-junicode.0.0.1/fonts/.gitkeep similarity index 100% rename from lib-satysfi/dist/packages/font-junicode/font-junicode.0.0.1/fonts/.gitkeep rename to lib-satysfi/packages/font-junicode/font-junicode.0.0.1/fonts/.gitkeep diff --git a/lib-satysfi/dist/packages/font-junicode/font-junicode.0.0.1/satysfi.yaml b/lib-satysfi/packages/font-junicode/font-junicode.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/font-junicode/font-junicode.0.0.1/satysfi.yaml rename to lib-satysfi/packages/font-junicode/font-junicode.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/fonts/.gitkeep b/lib-satysfi/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/fonts/.gitkeep similarity index 100% rename from lib-satysfi/dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/fonts/.gitkeep rename to lib-satysfi/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/fonts/.gitkeep diff --git a/lib-satysfi/dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/satysfi.yaml b/lib-satysfi/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/satysfi.yaml rename to lib-satysfi/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/font-latin-modern/font-latin-modern.0.0.1/fonts/.gitkeep b/lib-satysfi/packages/font-latin-modern/font-latin-modern.0.0.1/fonts/.gitkeep similarity index 100% rename from lib-satysfi/dist/packages/font-latin-modern/font-latin-modern.0.0.1/fonts/.gitkeep rename to lib-satysfi/packages/font-latin-modern/font-latin-modern.0.0.1/fonts/.gitkeep diff --git a/lib-satysfi/dist/packages/font-latin-modern/font-latin-modern.0.0.1/satysfi.yaml b/lib-satysfi/packages/font-latin-modern/font-latin-modern.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/font-latin-modern/font-latin-modern.0.0.1/satysfi.yaml rename to lib-satysfi/packages/font-latin-modern/font-latin-modern.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/package.satysfi-lock b/lib-satysfi/packages/footnote-scheme/footnote-scheme.0.0.1/package.satysfi-lock similarity index 100% rename from lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/package.satysfi-lock rename to lib-satysfi/packages/footnote-scheme/footnote-scheme.0.0.1/package.satysfi-lock diff --git a/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml b/lib-satysfi/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml rename to lib-satysfi/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/src/footnote-scheme.satyh b/lib-satysfi/packages/footnote-scheme/footnote-scheme.0.0.1/src/footnote-scheme.satyh similarity index 100% rename from lib-satysfi/dist/packages/footnote-scheme/footnote-scheme.0.0.1/src/footnote-scheme.satyh rename to lib-satysfi/packages/footnote-scheme/footnote-scheme.0.0.1/src/footnote-scheme.satyh diff --git a/lib-satysfi/dist/packages/html-base.satyh-html b/lib-satysfi/packages/html-base.satyh-html similarity index 100% rename from lib-satysfi/dist/packages/html-base.satyh-html rename to lib-satysfi/packages/html-base.satyh-html diff --git a/lib-satysfi/dist/packages/itemize/itemize.0.0.1/package.satysfi-lock b/lib-satysfi/packages/itemize/itemize.0.0.1/package.satysfi-lock similarity index 100% rename from lib-satysfi/dist/packages/itemize/itemize.0.0.1/package.satysfi-lock rename to lib-satysfi/packages/itemize/itemize.0.0.1/package.satysfi-lock diff --git a/lib-satysfi/dist/packages/itemize/itemize.0.0.1/satysfi.yaml b/lib-satysfi/packages/itemize/itemize.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/itemize/itemize.0.0.1/satysfi.yaml rename to lib-satysfi/packages/itemize/itemize.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/itemize/itemize.0.0.1/src/itemize.satyh b/lib-satysfi/packages/itemize/itemize.0.0.1/src/itemize.satyh similarity index 100% rename from lib-satysfi/dist/packages/itemize/itemize.0.0.1/src/itemize.satyh rename to lib-satysfi/packages/itemize/itemize.0.0.1/src/itemize.satyh diff --git a/lib-satysfi/dist/packages/math/math.0.0.1/package.satysfi-lock b/lib-satysfi/packages/math/math.0.0.1/package.satysfi-lock similarity index 100% rename from lib-satysfi/dist/packages/math/math.0.0.1/package.satysfi-lock rename to lib-satysfi/packages/math/math.0.0.1/package.satysfi-lock diff --git a/lib-satysfi/dist/packages/math/math.0.0.1/satysfi.yaml b/lib-satysfi/packages/math/math.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/math/math.0.0.1/satysfi.yaml rename to lib-satysfi/packages/math/math.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/math/math.0.0.1/src/math.satyh b/lib-satysfi/packages/math/math.0.0.1/src/math.satyh similarity index 100% rename from lib-satysfi/dist/packages/math/math.0.0.1/src/math.satyh rename to lib-satysfi/packages/math/math.0.0.1/src/math.satyh diff --git a/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/package.satysfi-lock b/lib-satysfi/packages/md-ja/md-ja.0.0.1/package.satysfi-lock similarity index 100% rename from lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/package.satysfi-lock rename to lib-satysfi/packages/md-ja/md-ja.0.0.1/package.satysfi-lock diff --git a/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml b/lib-satysfi/packages/md-ja/md-ja.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/satysfi.yaml rename to lib-satysfi/packages/md-ja/md-ja.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/src/md-ja.satyh b/lib-satysfi/packages/md-ja/md-ja.0.0.1/src/md-ja.satyh similarity index 100% rename from lib-satysfi/dist/packages/md-ja/md-ja.0.0.1/src/md-ja.satyh rename to lib-satysfi/packages/md-ja/md-ja.0.0.1/src/md-ja.satyh diff --git a/lib-satysfi/dist/packages/mitou-detail.satyh b/lib-satysfi/packages/mitou-detail.satyh similarity index 100% rename from lib-satysfi/dist/packages/mitou-detail.satyh rename to lib-satysfi/packages/mitou-detail.satyh diff --git a/lib-satysfi/dist/packages/mitou-report.satyh b/lib-satysfi/packages/mitou-report.satyh similarity index 100% rename from lib-satysfi/dist/packages/mitou-report.satyh rename to lib-satysfi/packages/mitou-report.satyh diff --git a/lib-satysfi/dist/packages/picture.satyh b/lib-satysfi/packages/picture.satyh similarity index 100% rename from lib-satysfi/dist/packages/picture.satyh rename to lib-satysfi/packages/picture.satyh diff --git a/lib-satysfi/dist/packages/progsynt.satyh b/lib-satysfi/packages/progsynt.satyh similarity index 100% rename from lib-satysfi/dist/packages/progsynt.satyh rename to lib-satysfi/packages/progsynt.satyh diff --git a/lib-satysfi/dist/packages/proof/proof.0.0.1/package.satysfi-lock b/lib-satysfi/packages/proof/proof.0.0.1/package.satysfi-lock similarity index 100% rename from lib-satysfi/dist/packages/proof/proof.0.0.1/package.satysfi-lock rename to lib-satysfi/packages/proof/proof.0.0.1/package.satysfi-lock diff --git a/lib-satysfi/dist/packages/proof/proof.0.0.1/satysfi.yaml b/lib-satysfi/packages/proof/proof.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/proof/proof.0.0.1/satysfi.yaml rename to lib-satysfi/packages/proof/proof.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/proof/proof.0.0.1/src/proof.satyh b/lib-satysfi/packages/proof/proof.0.0.1/src/proof.satyh similarity index 100% rename from lib-satysfi/dist/packages/proof/proof.0.0.1/src/proof.satyh rename to lib-satysfi/packages/proof/proof.0.0.1/src/proof.satyh diff --git a/lib-satysfi/dist/packages/standalone.satyh b/lib-satysfi/packages/standalone.satyh similarity index 100% rename from lib-satysfi/dist/packages/standalone.satyh rename to lib-satysfi/packages/standalone.satyh diff --git a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/package.satysfi-lock b/lib-satysfi/packages/std-ja-book/std-ja-book.0.0.1/package.satysfi-lock similarity index 100% rename from lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/package.satysfi-lock rename to lib-satysfi/packages/std-ja-book/std-ja-book.0.0.1/package.satysfi-lock diff --git a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml b/lib-satysfi/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml rename to lib-satysfi/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh b/lib-satysfi/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh similarity index 100% rename from lib-satysfi/dist/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh rename to lib-satysfi/packages/std-ja-book/std-ja-book.0.0.1/src/std-ja-book.satyh diff --git a/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/package.satysfi-lock b/lib-satysfi/packages/std-ja-report/std-ja-report.0.0.1/package.satysfi-lock similarity index 100% rename from lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/package.satysfi-lock rename to lib-satysfi/packages/std-ja-report/std-ja-report.0.0.1/package.satysfi-lock diff --git a/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml b/lib-satysfi/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml rename to lib-satysfi/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/src/std-ja-report.satyh b/lib-satysfi/packages/std-ja-report/std-ja-report.0.0.1/src/std-ja-report.satyh similarity index 100% rename from lib-satysfi/dist/packages/std-ja-report/std-ja-report.0.0.1/src/std-ja-report.satyh rename to lib-satysfi/packages/std-ja-report/std-ja-report.0.0.1/src/std-ja-report.satyh diff --git a/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/package.satysfi-lock b/lib-satysfi/packages/std-ja/std-ja.0.0.1/package.satysfi-lock similarity index 100% rename from lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/package.satysfi-lock rename to lib-satysfi/packages/std-ja/std-ja.0.0.1/package.satysfi-lock diff --git a/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/satysfi.yaml b/lib-satysfi/packages/std-ja/std-ja.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/satysfi.yaml rename to lib-satysfi/packages/std-ja/std-ja.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/src/std-ja.satyh b/lib-satysfi/packages/std-ja/std-ja.0.0.1/src/std-ja.satyh similarity index 100% rename from lib-satysfi/dist/packages/std-ja/std-ja.0.0.1/src/std-ja.satyh rename to lib-satysfi/packages/std-ja/std-ja.0.0.1/src/std-ja.satyh diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/package.satysfi-lock b/lib-satysfi/packages/stdlib/stdlib.0.0.1/package.satysfi-lock similarity index 100% rename from lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/package.satysfi-lock rename to lib-satysfi/packages/stdlib/stdlib.0.0.1/package.satysfi-lock diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/satysfi.yaml b/lib-satysfi/packages/stdlib/stdlib.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/satysfi.yaml rename to lib-satysfi/packages/stdlib/stdlib.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/color.satyh b/lib-satysfi/packages/stdlib/stdlib.0.0.1/src/color.satyh similarity index 100% rename from lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/color.satyh rename to lib-satysfi/packages/stdlib/stdlib.0.0.1/src/color.satyh diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/deco.satyh b/lib-satysfi/packages/stdlib/stdlib.0.0.1/src/deco.satyh similarity index 100% rename from lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/deco.satyh rename to lib-satysfi/packages/stdlib/stdlib.0.0.1/src/deco.satyh diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/geom.satyh b/lib-satysfi/packages/stdlib/stdlib.0.0.1/src/geom.satyh similarity index 100% rename from lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/geom.satyh rename to lib-satysfi/packages/stdlib/stdlib.0.0.1/src/geom.satyh diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/gr.satyh b/lib-satysfi/packages/stdlib/stdlib.0.0.1/src/gr.satyh similarity index 100% rename from lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/gr.satyh rename to lib-satysfi/packages/stdlib/stdlib.0.0.1/src/gr.satyh diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/hdecoset.satyh b/lib-satysfi/packages/stdlib/stdlib.0.0.1/src/hdecoset.satyh similarity index 100% rename from lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/hdecoset.satyh rename to lib-satysfi/packages/stdlib/stdlib.0.0.1/src/hdecoset.satyh diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/list.satyg b/lib-satysfi/packages/stdlib/stdlib.0.0.1/src/list.satyg similarity index 100% rename from lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/list.satyg rename to lib-satysfi/packages/stdlib/stdlib.0.0.1/src/list.satyg diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/option.satyg b/lib-satysfi/packages/stdlib/stdlib.0.0.1/src/option.satyg similarity index 100% rename from lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/option.satyg rename to lib-satysfi/packages/stdlib/stdlib.0.0.1/src/option.satyg diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/paper-size.satyh b/lib-satysfi/packages/stdlib/stdlib.0.0.1/src/paper-size.satyh similarity index 100% rename from lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/paper-size.satyh rename to lib-satysfi/packages/stdlib/stdlib.0.0.1/src/paper-size.satyh diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/pervasives.satyh b/lib-satysfi/packages/stdlib/stdlib.0.0.1/src/pervasives.satyh similarity index 100% rename from lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/pervasives.satyh rename to lib-satysfi/packages/stdlib/stdlib.0.0.1/src/pervasives.satyh diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/stdlib.satyh b/lib-satysfi/packages/stdlib/stdlib.0.0.1/src/stdlib.satyh similarity index 100% rename from lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/stdlib.satyh rename to lib-satysfi/packages/stdlib/stdlib.0.0.1/src/stdlib.satyh diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/vdecoset.satyh b/lib-satysfi/packages/stdlib/stdlib.0.0.1/src/vdecoset.satyh similarity index 100% rename from lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/src/vdecoset.satyh rename to lib-satysfi/packages/stdlib/stdlib.0.0.1/src/vdecoset.satyh diff --git a/lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/test/list-test.satyg b/lib-satysfi/packages/stdlib/stdlib.0.0.1/test/list-test.satyg similarity index 100% rename from lib-satysfi/dist/packages/stdlib/stdlib.0.0.1/test/list-test.satyg rename to lib-satysfi/packages/stdlib/stdlib.0.0.1/test/list-test.satyg diff --git a/lib-satysfi/dist/packages/table.satyh b/lib-satysfi/packages/table.satyh similarity index 100% rename from lib-satysfi/dist/packages/table.satyh rename to lib-satysfi/packages/table.satyh diff --git a/lib-satysfi/dist/packages/tabular/tabular.0.0.1/package.satysfi-lock b/lib-satysfi/packages/tabular/tabular.0.0.1/package.satysfi-lock similarity index 100% rename from lib-satysfi/dist/packages/tabular/tabular.0.0.1/package.satysfi-lock rename to lib-satysfi/packages/tabular/tabular.0.0.1/package.satysfi-lock diff --git a/lib-satysfi/dist/packages/tabular/tabular.0.0.1/satysfi.yaml b/lib-satysfi/packages/tabular/tabular.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/tabular/tabular.0.0.1/satysfi.yaml rename to lib-satysfi/packages/tabular/tabular.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/tabular/tabular.0.0.1/src/tabular.satyh b/lib-satysfi/packages/tabular/tabular.0.0.1/src/tabular.satyh similarity index 100% rename from lib-satysfi/dist/packages/tabular/tabular.0.0.1/src/tabular.satyh rename to lib-satysfi/packages/tabular/tabular.0.0.1/src/tabular.satyh diff --git a/lib-satysfi/dist/packages/tabularx.satyh b/lib-satysfi/packages/tabularx.satyh similarity index 100% rename from lib-satysfi/dist/packages/tabularx.satyh rename to lib-satysfi/packages/tabularx.satyh diff --git a/lib-satysfi/dist/packages/testing/testing.0.0.1/package.satysfi-lock b/lib-satysfi/packages/testing/testing.0.0.1/package.satysfi-lock similarity index 100% rename from lib-satysfi/dist/packages/testing/testing.0.0.1/package.satysfi-lock rename to lib-satysfi/packages/testing/testing.0.0.1/package.satysfi-lock diff --git a/lib-satysfi/dist/packages/testing/testing.0.0.1/satysfi.yaml b/lib-satysfi/packages/testing/testing.0.0.1/satysfi.yaml similarity index 100% rename from lib-satysfi/dist/packages/testing/testing.0.0.1/satysfi.yaml rename to lib-satysfi/packages/testing/testing.0.0.1/satysfi.yaml diff --git a/lib-satysfi/dist/packages/testing/testing.0.0.1/src/testing.satyg b/lib-satysfi/packages/testing/testing.0.0.1/src/testing.satyg similarity index 100% rename from lib-satysfi/dist/packages/testing/testing.0.0.1/src/testing.satyg rename to lib-satysfi/packages/testing/testing.0.0.1/src/testing.satyg diff --git a/lib-satysfi/dist/cache/registry.yaml b/lib-satysfi/registries/default/registry.yaml similarity index 100% rename from lib-satysfi/dist/cache/registry.yaml rename to lib-satysfi/registries/default/registry.yaml diff --git a/lib-satysfi/dist/unidata/.gitignore b/lib-satysfi/unidata/.gitignore similarity index 100% rename from lib-satysfi/dist/unidata/.gitignore rename to lib-satysfi/unidata/.gitignore diff --git a/lib-satysfi/dist/unidata/EastAsianWidth.txt b/lib-satysfi/unidata/EastAsianWidth.txt similarity index 100% rename from lib-satysfi/dist/unidata/EastAsianWidth.txt rename to lib-satysfi/unidata/EastAsianWidth.txt diff --git a/lib-satysfi/dist/unidata/LineBreak.txt b/lib-satysfi/unidata/LineBreak.txt similarity index 100% rename from lib-satysfi/dist/unidata/LineBreak.txt rename to lib-satysfi/unidata/LineBreak.txt diff --git a/lib-satysfi/dist/unidata/PropList.txt b/lib-satysfi/unidata/PropList.txt similarity index 100% rename from lib-satysfi/dist/unidata/PropList.txt rename to lib-satysfi/unidata/PropList.txt diff --git a/lib-satysfi/dist/unidata/PropertyAliases.txt b/lib-satysfi/unidata/PropertyAliases.txt similarity index 100% rename from lib-satysfi/dist/unidata/PropertyAliases.txt rename to lib-satysfi/unidata/PropertyAliases.txt diff --git a/lib-satysfi/dist/unidata/PropertyValueAliases.txt b/lib-satysfi/unidata/PropertyValueAliases.txt similarity index 100% rename from lib-satysfi/dist/unidata/PropertyValueAliases.txt rename to lib-satysfi/unidata/PropertyValueAliases.txt diff --git a/lib-satysfi/dist/unidata/ScriptExtensions.txt b/lib-satysfi/unidata/ScriptExtensions.txt similarity index 100% rename from lib-satysfi/dist/unidata/ScriptExtensions.txt rename to lib-satysfi/unidata/ScriptExtensions.txt diff --git a/lib-satysfi/dist/unidata/Scripts.txt b/lib-satysfi/unidata/Scripts.txt similarity index 100% rename from lib-satysfi/dist/unidata/Scripts.txt rename to lib-satysfi/unidata/Scripts.txt diff --git a/lib-satysfi/dist/unidata/UnicodeData.txt b/lib-satysfi/unidata/UnicodeData.txt similarity index 100% rename from lib-satysfi/dist/unidata/UnicodeData.txt rename to lib-satysfi/unidata/UnicodeData.txt diff --git a/src/chardecoder/lineBreakDataMap.ml b/src/chardecoder/lineBreakDataMap.ml index 086eccaa7..99ff2a984 100644 --- a/src/chardecoder/lineBreakDataMap.ml +++ b/src/chardecoder/lineBreakDataMap.ml @@ -503,7 +503,7 @@ let print_trilist trilst = (* (* unit test *) let () = - set_from_file "./lib-satysfi/dist/unidata/LineBreak.txt"; + set_from_file "./lib-satysfi/unidata/LineBreak.txt"; let uchlst = InternalText.to_uchar_list (InternalText.of_utf8 "The quick brown fox") diff --git a/src/frontend/fontInfo.ml b/src/frontend/fontInfo.ml index 12185e08f..586f3f2ee 100644 --- a/src/frontend/fontInfo.ml +++ b/src/frontend/fontInfo.ml @@ -419,10 +419,10 @@ let initialize () = let open ResultMonad in FontHashTable.initialize (); MathFontHashTable.initialize (); - let* abspath_S = resolve_lib_file (make_lib_path "dist/unidata/Scripts.txt") in - let* abspath_EAW = resolve_lib_file (make_lib_path "dist/unidata/EastAsianWidth.txt") in + let* abspath_S = resolve_lib_file (make_lib_path "unidata/Scripts.txt") in + let* abspath_EAW = resolve_lib_file (make_lib_path "unidata/EastAsianWidth.txt") in ScriptDataMap.set_from_file abspath_S abspath_EAW; - let* abspath_LB = resolve_lib_file (make_lib_path "dist/unidata/LineBreak.txt") in + let* abspath_LB = resolve_lib_file (make_lib_path "unidata/LineBreak.txt") in LineBreakDataMap.set_from_file abspath_LB; return () in diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 6ea83978a..84e3e8372 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -1776,7 +1776,7 @@ let convert_solutions_to_lock_config (solutions : package_solution list) : LockC solutions |> List.fold_left (fun (locked_package_acc, impl_spec_acc) solution -> let package_name = solution.package_name in let lock_name = make_lock_name package_name solution.locked_version in - let libpathstr_container = Printf.sprintf "./dist/packages/%s/" package_name in + let libpathstr_container = Printf.sprintf "./packages/%s/" package_name in let libpathstr_lock = Filename.concat libpathstr_container lock_name in let lock_location = LockConfig.GlobalLocation{ @@ -1884,7 +1884,7 @@ let solve let res = let open ResultMonad in let* abspath_registry_config = - let libpath = make_lib_path "dist/cache/registry.yaml" in + let libpath = make_lib_path "registries/default/registry.yaml" in Config.resolve_lib_file libpath |> Result.map_error (fun candidates -> RegistryConfigNotFoundIn(libpath, candidates)) in @@ -1940,7 +1940,7 @@ let solve let tar_command = "tar" in (* TODO: make this changeable *) let absdir_lock_cache = let absdir_primary_root = get_primary_root_dir () in - make_abs_path (Filename.concat (get_abs_path_string absdir_primary_root) "dist/cache/locks") + make_abs_path (Filename.concat (get_abs_path_string absdir_primary_root) "cache/locks") in let* () = impl_specs |> foldM (fun () impl_spec -> diff --git a/src/frontend/primitives.cppo.ml b/src/frontend/primitives.cppo.ml index 34a20da97..4cd447e53 100644 --- a/src/frontend/primitives.cppo.ml +++ b/src/frontend/primitives.cppo.ml @@ -762,7 +762,7 @@ let resolve_lib_file (libpath : lib_path) = let make_pdf_mode_environments () = let open ResultMonad in - let* abspath_hyphen = resolve_lib_file (make_lib_path "dist/hyph/english.satysfi-hyph") 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 From 35dca89d3d72fd81d13a31131610653df492ae0c Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 7 Dec 2022 01:09:55 +0900 Subject: [PATCH 205/288] update expected lock files --- demo/demo.satysfi-lock-expected | 26 +++++++++++----------- doc/doc-lang.satysfi-lock-expected | 18 +++++++-------- doc/doc-primitives.satysfi-lock-expected | 22 +++++++++--------- doc/math1.satysfi-lock-expected | 22 +++++++++--------- install-libs.sh | 17 +++++++------- tests/clip.satysfi-lock-expected | 12 +++++----- tests/glue1.satysfi-lock-expected | 12 +++++----- tests/images/test.satysfi-lock-expected | 20 ++++++++--------- tests/macro1.satysfi-lock-expected | 20 ++++++++--------- tests/math-typefaces.satysfi-lock-expected | 22 +++++++++--------- tests/math2.satysfi-lock-expected | 12 +++++----- tests/md/test.satysfi-lock-expected | 22 +++++++++--------- tests/refactor1.satysfi-lock-expected | 10 ++++----- tests/refactor2.satysfi-lock-expected | 6 ++--- tests/refactor3.satysfi-lock-expected | 6 ++--- tests/refactor5.satysfi-lock-expected | 6 ++--- tests/staged1.satysfi-lock-expected | 18 +++++++-------- 17 files changed, 135 insertions(+), 136 deletions(-) diff --git a/demo/demo.satysfi-lock-expected b/demo/demo.satysfi-lock-expected index e3ba8332f..cf3e6f07d 100644 --- a/demo/demo.satysfi-lock-expected +++ b/demo/demo.satysfi-lock-expected @@ -2,14 +2,14 @@ locks: - name: annot.0.0.1 location: type: global - path: ./dist/packages/annot/annot.0.0.1 + path: ./packages/annot/annot.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: code.0.0.1 location: type: global - path: ./dist/packages/code/code.0.0.1 + path: ./packages/code/code.0.0.1 dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 @@ -17,59 +17,59 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 + path: ./packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1 + path: ./packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 + path: ./packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 + path: ./packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: footnote-scheme.0.0.1 location: type: global - path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1 + path: ./packages/footnote-scheme/footnote-scheme.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: itemize.0.0.1 location: type: global - path: ./dist/packages/itemize/itemize.0.0.1 + path: ./packages/itemize/itemize.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1 + path: ./packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: proof.0.0.1 location: type: global - path: ./dist/packages/proof/proof.0.0.1 + path: ./packages/proof/proof.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: std-ja-book.0.0.1 location: type: global - path: ./dist/packages/std-ja-book/std-ja-book.0.0.1 + path: ./packages/std-ja-book/std-ja-book.0.0.1 dependencies: - stdlib.0.0.1 - math.0.0.1 @@ -84,13 +84,13 @@ locks: - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1 + path: ./packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false - name: tabular.0.0.1 location: type: global - path: ./dist/packages/tabular/tabular.0.0.1 + path: ./packages/tabular/tabular.0.0.1 dependencies: - stdlib.0.0.1 test_only: false diff --git a/doc/doc-lang.satysfi-lock-expected b/doc/doc-lang.satysfi-lock-expected index 85533cfd0..02b3942f2 100644 --- a/doc/doc-lang.satysfi-lock-expected +++ b/doc/doc-lang.satysfi-lock-expected @@ -2,14 +2,14 @@ locks: - name: annot.0.0.1 location: type: global - path: ./dist/packages/annot/annot.0.0.1 + path: ./packages/annot/annot.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: code.0.0.1 location: type: global - path: ./dist/packages/code/code.0.0.1 + path: ./packages/code/code.0.0.1 dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 @@ -17,38 +17,38 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 + path: ./packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1 + path: ./packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 + path: ./packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 + path: ./packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1 + path: ./packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: std-ja.0.0.1 location: type: global - path: ./dist/packages/std-ja/std-ja.0.0.1 + path: ./packages/std-ja/std-ja.0.0.1 dependencies: - stdlib.0.0.1 - math.0.0.1 @@ -62,6 +62,6 @@ locks: - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1 + path: ./packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false diff --git a/doc/doc-primitives.satysfi-lock-expected b/doc/doc-primitives.satysfi-lock-expected index 691256653..d09c35330 100644 --- a/doc/doc-primitives.satysfi-lock-expected +++ b/doc/doc-primitives.satysfi-lock-expected @@ -2,14 +2,14 @@ locks: - name: annot.0.0.1 location: type: global - path: ./dist/packages/annot/annot.0.0.1 + path: ./packages/annot/annot.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: code.0.0.1 location: type: global - path: ./dist/packages/code/code.0.0.1 + path: ./packages/code/code.0.0.1 dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 @@ -17,52 +17,52 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 + path: ./packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1 + path: ./packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 + path: ./packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 + path: ./packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: footnote-scheme.0.0.1 location: type: global - path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1 + path: ./packages/footnote-scheme/footnote-scheme.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: itemize.0.0.1 location: type: global - path: ./dist/packages/itemize/itemize.0.0.1 + path: ./packages/itemize/itemize.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1 + path: ./packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: std-ja-book.0.0.1 location: type: global - path: ./dist/packages/std-ja-book/std-ja-book.0.0.1 + path: ./packages/std-ja-book/std-ja-book.0.0.1 dependencies: - stdlib.0.0.1 - math.0.0.1 @@ -77,6 +77,6 @@ locks: - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1 + path: ./packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false diff --git a/doc/math1.satysfi-lock-expected b/doc/math1.satysfi-lock-expected index 574135604..4820051d5 100644 --- a/doc/math1.satysfi-lock-expected +++ b/doc/math1.satysfi-lock-expected @@ -2,14 +2,14 @@ locks: - name: annot.0.0.1 location: type: global - path: ./dist/packages/annot/annot.0.0.1 + path: ./packages/annot/annot.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: code.0.0.1 location: type: global - path: ./dist/packages/code/code.0.0.1 + path: ./packages/code/code.0.0.1 dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 @@ -17,45 +17,45 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 + path: ./packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1 + path: ./packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 + path: ./packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 + path: ./packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1 + path: ./packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: proof.0.0.1 location: type: global - path: ./dist/packages/proof/proof.0.0.1 + path: ./packages/proof/proof.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: std-ja.0.0.1 location: type: global - path: ./dist/packages/std-ja/std-ja.0.0.1 + path: ./packages/std-ja/std-ja.0.0.1 dependencies: - stdlib.0.0.1 - math.0.0.1 @@ -69,13 +69,13 @@ locks: - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1 + path: ./packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false - name: tabular.0.0.1 location: type: global - path: ./dist/packages/tabular/tabular.0.0.1 + path: ./packages/tabular/tabular.0.0.1 dependencies: - stdlib.0.0.1 test_only: false diff --git a/install-libs.sh b/install-libs.sh index 7a6ef5429..f621ddbc0 100755 --- a/install-libs.sh +++ b/install-libs.sh @@ -4,12 +4,11 @@ LIBDIR=${1:-/usr/local/share/satysfi} INSTALL=${2:-install} "${INSTALL}" -d "${LIBDIR}" -"${INSTALL}" -d "${LIBDIR}/dist" -"${INSTALL}" -d "${LIBDIR}/dist/unidata" -"${INSTALL}" -m 644 lib-satysfi/dist/unidata/*.txt "${LIBDIR}/dist/unidata" -"${INSTALL}" -d "${LIBDIR}/dist/hyph" -"${INSTALL}" -m 644 lib-satysfi/dist/hyph/* "${LIBDIR}/dist/hyph" -"${INSTALL}" -d "${LIBDIR}/dist/packages" -(cd lib-satysfi && find dist/packages -type f -exec "${INSTALL}" -Dm 644 "{}" "${LIBDIR}/{}" \;) -"${INSTALL}" -d "${LIBDIR}/dist/cache" -"${INSTALL}" -m 644 lib-satysfi/dist/cache/* "${LIBDIR}/dist/cache" +"${INSTALL}" -d "${LIBDIR}/unidata" +"${INSTALL}" -m 644 lib-satysfi/unidata/*.txt "${LIBDIR}/unidata" +"${INSTALL}" -d "${LIBDIR}/hyph" +"${INSTALL}" -m 644 lib-satysfi/hyph/* "${LIBDIR}/hyph" +"${INSTALL}" -d "${LIBDIR}/packages" +(cd lib-satysfi && find packages -type f -exec "${INSTALL}" -Dm 644 "{}" "${LIBDIR}/{}" \;) +"${INSTALL}" -d "${LIBDIR}/registries" +(cd lib-satysfi && find registries -type f -exec "${INSTALL}" -Dm 644 "{}" "${LIBDIR}/{}" \;) diff --git a/tests/clip.satysfi-lock-expected b/tests/clip.satysfi-lock-expected index e74dd5887..7569c0e4c 100644 --- a/tests/clip.satysfi-lock-expected +++ b/tests/clip.satysfi-lock-expected @@ -2,37 +2,37 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 + path: ./packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1 + path: ./packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 + path: ./packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 + path: ./packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1 + path: ./packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1 + path: ./packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false diff --git a/tests/glue1.satysfi-lock-expected b/tests/glue1.satysfi-lock-expected index e74dd5887..7569c0e4c 100644 --- a/tests/glue1.satysfi-lock-expected +++ b/tests/glue1.satysfi-lock-expected @@ -2,37 +2,37 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 + path: ./packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1 + path: ./packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 + path: ./packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 + path: ./packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1 + path: ./packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1 + path: ./packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false diff --git a/tests/images/test.satysfi-lock-expected b/tests/images/test.satysfi-lock-expected index 7cb6dac84..0b67e8056 100644 --- a/tests/images/test.satysfi-lock-expected +++ b/tests/images/test.satysfi-lock-expected @@ -2,14 +2,14 @@ locks: - name: annot.0.0.1 location: type: global - path: ./dist/packages/annot/annot.0.0.1 + path: ./packages/annot/annot.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: code.0.0.1 location: type: global - path: ./dist/packages/code/code.0.0.1 + path: ./packages/code/code.0.0.1 dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 @@ -17,45 +17,45 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 + path: ./packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1 + path: ./packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 + path: ./packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 + path: ./packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: itemize.0.0.1 location: type: global - path: ./dist/packages/itemize/itemize.0.0.1 + path: ./packages/itemize/itemize.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1 + path: ./packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: std-ja.0.0.1 location: type: global - path: ./dist/packages/std-ja/std-ja.0.0.1 + path: ./packages/std-ja/std-ja.0.0.1 dependencies: - stdlib.0.0.1 - math.0.0.1 @@ -69,6 +69,6 @@ locks: - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1 + path: ./packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false diff --git a/tests/macro1.satysfi-lock-expected b/tests/macro1.satysfi-lock-expected index f99a5d0cc..dd3852546 100644 --- a/tests/macro1.satysfi-lock-expected +++ b/tests/macro1.satysfi-lock-expected @@ -2,14 +2,14 @@ locks: - name: annot.0.0.1 location: type: global - path: ./dist/packages/annot/annot.0.0.1 + path: ./packages/annot/annot.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: code.0.0.1 location: type: global - path: ./dist/packages/code/code.0.0.1 + path: ./packages/code/code.0.0.1 dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 @@ -17,45 +17,45 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 + path: ./packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1 + path: ./packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 + path: ./packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 + path: ./packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: footnote-scheme.0.0.1 location: type: global - path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1 + path: ./packages/footnote-scheme/footnote-scheme.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1 + path: ./packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: std-ja-report.0.0.1 location: type: global - path: ./dist/packages/std-ja-report/std-ja-report.0.0.1 + path: ./packages/std-ja-report/std-ja-report.0.0.1 dependencies: - stdlib.0.0.1 - math.0.0.1 @@ -70,6 +70,6 @@ locks: - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1 + path: ./packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false diff --git a/tests/math-typefaces.satysfi-lock-expected b/tests/math-typefaces.satysfi-lock-expected index 99b3f8df1..799d94f14 100644 --- a/tests/math-typefaces.satysfi-lock-expected +++ b/tests/math-typefaces.satysfi-lock-expected @@ -2,14 +2,14 @@ locks: - name: annot.0.0.1 location: type: global - path: ./dist/packages/annot/annot.0.0.1 + path: ./packages/annot/annot.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: code.0.0.1 location: type: global - path: ./dist/packages/code/code.0.0.1 + path: ./packages/code/code.0.0.1 dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 @@ -17,52 +17,52 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 + path: ./packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1 + path: ./packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 + path: ./packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 + path: ./packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: footnote-scheme.0.0.1 location: type: global - path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1 + path: ./packages/footnote-scheme/footnote-scheme.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: itemize.0.0.1 location: type: global - path: ./dist/packages/itemize/itemize.0.0.1 + path: ./packages/itemize/itemize.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1 + path: ./packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: std-ja-report.0.0.1 location: type: global - path: ./dist/packages/std-ja-report/std-ja-report.0.0.1 + path: ./packages/std-ja-report/std-ja-report.0.0.1 dependencies: - stdlib.0.0.1 - math.0.0.1 @@ -77,6 +77,6 @@ locks: - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1 + path: ./packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false diff --git a/tests/math2.satysfi-lock-expected b/tests/math2.satysfi-lock-expected index e74dd5887..7569c0e4c 100644 --- a/tests/math2.satysfi-lock-expected +++ b/tests/math2.satysfi-lock-expected @@ -2,37 +2,37 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 + path: ./packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1 + path: ./packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 + path: ./packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 + path: ./packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1 + path: ./packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1 + path: ./packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false diff --git a/tests/md/test.satysfi-lock-expected b/tests/md/test.satysfi-lock-expected index 064794080..c1a16cdf8 100644 --- a/tests/md/test.satysfi-lock-expected +++ b/tests/md/test.satysfi-lock-expected @@ -2,14 +2,14 @@ locks: - name: annot.0.0.1 location: type: global - path: ./dist/packages/annot/annot.0.0.1 + path: ./packages/annot/annot.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: code.0.0.1 location: type: global - path: ./dist/packages/code/code.0.0.1 + path: ./packages/code/code.0.0.1 dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 @@ -17,52 +17,52 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 + path: ./packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1 + path: ./packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 + path: ./packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 + path: ./packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: footnote-scheme.0.0.1 location: type: global - path: ./dist/packages/footnote-scheme/footnote-scheme.0.0.1 + path: ./packages/footnote-scheme/footnote-scheme.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: itemize.0.0.1 location: type: global - path: ./dist/packages/itemize/itemize.0.0.1 + path: ./packages/itemize/itemize.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1 + path: ./packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: md-ja.0.0.1 location: type: global - path: ./dist/packages/md-ja/md-ja.0.0.1 + path: ./packages/md-ja/md-ja.0.0.1 dependencies: - stdlib.0.0.1 - math.0.0.1 @@ -78,6 +78,6 @@ locks: - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1 + path: ./packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false diff --git a/tests/refactor1.satysfi-lock-expected b/tests/refactor1.satysfi-lock-expected index 917770269..96257f1e6 100644 --- a/tests/refactor1.satysfi-lock-expected +++ b/tests/refactor1.satysfi-lock-expected @@ -2,31 +2,31 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 + path: ./packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1 + path: ./packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 + path: ./packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1 + path: ./packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1 + path: ./packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false diff --git a/tests/refactor2.satysfi-lock-expected b/tests/refactor2.satysfi-lock-expected index 1e7029d1a..faad66ada 100644 --- a/tests/refactor2.satysfi-lock-expected +++ b/tests/refactor2.satysfi-lock-expected @@ -2,18 +2,18 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 + path: ./packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1 + path: ./packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 + path: ./packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false diff --git a/tests/refactor3.satysfi-lock-expected b/tests/refactor3.satysfi-lock-expected index 1e7029d1a..faad66ada 100644 --- a/tests/refactor3.satysfi-lock-expected +++ b/tests/refactor3.satysfi-lock-expected @@ -2,18 +2,18 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 + path: ./packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1 + path: ./packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 + path: ./packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false diff --git a/tests/refactor5.satysfi-lock-expected b/tests/refactor5.satysfi-lock-expected index 1e7029d1a..faad66ada 100644 --- a/tests/refactor5.satysfi-lock-expected +++ b/tests/refactor5.satysfi-lock-expected @@ -2,18 +2,18 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 + path: ./packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1 + path: ./packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 + path: ./packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false diff --git a/tests/staged1.satysfi-lock-expected b/tests/staged1.satysfi-lock-expected index 85533cfd0..02b3942f2 100644 --- a/tests/staged1.satysfi-lock-expected +++ b/tests/staged1.satysfi-lock-expected @@ -2,14 +2,14 @@ locks: - name: annot.0.0.1 location: type: global - path: ./dist/packages/annot/annot.0.0.1 + path: ./packages/annot/annot.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: code.0.0.1 location: type: global - path: ./dist/packages/code/code.0.0.1 + path: ./packages/code/code.0.0.1 dependencies: - stdlib.0.0.1 - font-latin-modern.0.0.1 @@ -17,38 +17,38 @@ locks: - name: font-ipa-ex.0.0.1 location: type: global - path: ./dist/packages/font-ipa-ex/font-ipa-ex.0.0.1 + path: ./packages/font-ipa-ex/font-ipa-ex.0.0.1 dependencies: [] test_only: false - name: font-junicode.0.0.1 location: type: global - path: ./dist/packages/font-junicode/font-junicode.0.0.1 + path: ./packages/font-junicode/font-junicode.0.0.1 dependencies: [] test_only: false - name: font-latin-modern.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern/font-latin-modern.0.0.1 + path: ./packages/font-latin-modern/font-latin-modern.0.0.1 dependencies: [] test_only: false - name: font-latin-modern-math.0.0.1 location: type: global - path: ./dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1 + path: ./packages/font-latin-modern-math/font-latin-modern-math.0.0.1 dependencies: [] test_only: false - name: math.0.0.1 location: type: global - path: ./dist/packages/math/math.0.0.1 + path: ./packages/math/math.0.0.1 dependencies: - stdlib.0.0.1 test_only: false - name: std-ja.0.0.1 location: type: global - path: ./dist/packages/std-ja/std-ja.0.0.1 + path: ./packages/std-ja/std-ja.0.0.1 dependencies: - stdlib.0.0.1 - math.0.0.1 @@ -62,6 +62,6 @@ locks: - name: stdlib.0.0.1 location: type: global - path: ./dist/packages/stdlib/stdlib.0.0.1 + path: ./packages/stdlib/stdlib.0.0.1 dependencies: [] test_only: false From 97474e275a1cb37ba756cf3cc17e7b899a6fe3f0 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 7 Dec 2022 02:15:48 +0900 Subject: [PATCH 206/288] update 'download-fonts.sh' --- download-fonts.sh | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/download-fonts.sh b/download-fonts.sh index ae3174ce7..4e4a8da46 100755 --- a/download-fonts.sh +++ b/download-fonts.sh @@ -3,6 +3,7 @@ set -ue CACHE=temp +PACKAGES=lib-satysfi/packages MESSAGE_PREFIX="[download-fonts.sh]" cd "$(dirname "$0")" mkdir -p "$CACHE" @@ -47,23 +48,23 @@ download_file () { # Latin Modern NAME=lm2.004otf download_file "$NAME.zip" "http://www.gust.org.pl/projects/e-foundry/latin-modern/download/lm2.004otf.zip" -unzip -o "$CACHE/$NAME.zip" "*.otf" -d lib-satysfi/dist/packages/font-latin-modern/font-latin-modern.0.0.1/fonts/ +unzip -o "$CACHE/$NAME.zip" "*.otf" -d "$PACKAGES"/font-latin-modern/font-latin-modern.0.0.1/fonts/ # Latin Modern Math NAME=latinmodern-math-1959 download_file "$NAME.zip" "http://www.gust.org.pl/projects/e-foundry/lm-math/download/latinmodern-math-1959.zip" unzip -o "$CACHE/$NAME.zip" "*.otf" -d "$CACHE/" -cp "$CACHE"/latinmodern-math-1959/otf/latinmodern-math.otf lib-satysfi/dist/packages/font-latin-modern-math/font-latin-modern-math.0.0.1/fonts/ +cp "$CACHE"/latinmodern-math-1959/otf/latinmodern-math.otf "$PACKAGES"/font-latin-modern-math/font-latin-modern-math.0.0.1/fonts/ # Junicode NAME=junicode-1.002 download_file "$NAME.zip" "http://downloads.sourceforge.net/project/junicode/junicode/junicode-1.002/junicode-1.002.zip" -unzip -o "$CACHE/$NAME.zip" "*.ttf" -d lib-satysfi/dist/packages/font-junicode/font-junicode.0.0.1/fonts/ +unzip -o "$CACHE/$NAME.zip" "*.ttf" -d "$PACKAGES"/font-junicode/font-junicode.0.0.1/fonts/ # IPAexfont NAME=IPAexfont00401 download_file "$NAME.zip" "https://moji.or.jp/wp-content/ipafont/IPAexfont/IPAexfont00401.zip" unzip -o "$CACHE/$NAME.zip" "*.ttf" -d "$CACHE/" -cp "$CACHE"/IPAexfont00401/ipaexg.ttf lib-satysfi/dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/fonts/ -cp "$CACHE"/IPAexfont00401/ipaexm.ttf lib-satysfi/dist/packages/font-ipa-ex/font-ipa-ex.0.0.1/fonts/ +cp "$CACHE"/IPAexfont00401/ipaexg.ttf "$PACKAGES"/font-ipa-ex/font-ipa-ex.0.0.1/fonts/ +cp "$CACHE"/IPAexfont00401/ipaexm.ttf "$PACKAGES"/font-ipa-ex/font-ipa-ex.0.0.1/fonts/ show_message "end." From aeb99f30a3db754ccbbc9044278af69813fb564d Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 7 Dec 2022 19:43:08 +0900 Subject: [PATCH 207/288] modify how to decode version requirements --- src/frontend/configUtil.ml | 14 +++++++------- src/frontend/documentAttribute.ml | 12 ++++++------ src/frontend/logging.ml | 8 ++++---- src/frontend/main.ml | 4 ++-- src/frontend/packageConstraintSolver.ml | 14 +++++++------- src/frontend/packageSystemBase.ml | 8 ++------ src/frontend/semanticVersion.ml | 18 +++++++++++++++++- src/frontend/semanticVersion.mli | 6 ++++++ 8 files changed, 51 insertions(+), 33 deletions(-) diff --git a/src/frontend/configUtil.ml b/src/frontend/configUtil.ml index ccac02285..844769e6d 100644 --- a/src/frontend/configUtil.ml +++ b/src/frontend/configUtil.ml @@ -6,19 +6,19 @@ open PackageSystemBase module ConfigDecoder = YamlDecoder.Make(YamlError) -let requirement_decoder : package_restriction ConfigDecoder.t = +let requirement_decoder : SemanticVersion.requirement ConfigDecoder.t = let open ConfigDecoder in - string >>= fun s_version -> - match SemanticVersion.parse s_version with - | None -> failure (fun context -> NotASemanticVersion(context, s_version)) - | Some(semver) -> succeed @@ CompatibleWith(semver) + string >>= fun s_version_requirement -> + match SemanticVersion.parse_requirement s_version_requirement with + | None -> failure (fun context -> NotASemanticVersion(context, s_version_requirement)) + | Some(verreq) -> succeed verreq let dependency_decoder : package_dependency ConfigDecoder.t = let open ConfigDecoder in get "name" string >>= fun package_name -> - get "requirements" (list requirement_decoder) >>= fun restrictions -> + get "requirement" requirement_decoder >>= fun version_requirement -> succeed @@ PackageDependency{ package_name; - restrictions; + version_requirement; } diff --git a/src/frontend/documentAttribute.ml b/src/frontend/documentAttribute.ml index c1edf8cd8..265c37be5 100644 --- a/src/frontend/documentAttribute.ml +++ b/src/frontend/documentAttribute.ml @@ -6,7 +6,7 @@ open PackageSystemBase type error = | NoDependencyList of Range.t | MoreThanOneDependencyAttribute of Range.t * Range.t - | NotASemanticVersion of Range.t * string + | NotAVersionRequirement of Range.t * string | NotAPackageDependency of Range.t | NotAListLiteral of Range.t @@ -23,17 +23,17 @@ let decode_package_dependency (utast : untyped_abstract_tree) : package_dependen | (rng, UTTuple(utasts)) -> begin match TupleList.to_list utasts with - | [ (_, UTStringConstant(package_name)); (rng_version, UTStringConstant(s_version)) ] -> + | [ (_, UTStringConstant(package_name)); (rng_version, UTStringConstant(s_version_requirement)) ] -> begin - match SemanticVersion.parse s_version with - | Some(semver) -> + match SemanticVersion.parse_requirement s_version_requirement with + | Some(version_requirement) -> return @@ PackageDependency{ package_name; - restrictions = [ CompatibleWith(semver) ]; + version_requirement; } | None -> - err @@ NotASemanticVersion(rng_version, s_version) + err @@ NotAVersionRequirement(rng_version, s_version_requirement) end | _ -> diff --git a/src/frontend/logging.ml b/src/frontend/logging.ml index 8fe6750f6..a6701454a 100644 --- a/src/frontend/logging.ml +++ b/src/frontend/logging.ml @@ -114,11 +114,11 @@ let show_package_dependency_before_solving (dependencies_with_flags : (dependenc Printf.printf " package dependencies to solve:\n"; dependencies_with_flags |> List.iter (fun (flag, dep) -> match dep with - | PackageDependency{ package_name; restrictions } -> + | PackageDependency{ package_name; version_requirement } -> let s_restr = - restrictions |> List.map (function - | CompatibleWith(semver) -> SemanticVersion.to_string semver - ) |> String.concat ", " + match version_requirement with + | SemanticVersion.CompatibleWith(semver) -> + Printf.sprintf "^%s" (SemanticVersion.to_string semver) in let s_test_only = match flag with diff --git a/src/frontend/main.ml b/src/frontend/main.ml index 84e3e8372..5d8228db9 100644 --- a/src/frontend/main.ml +++ b/src/frontend/main.ml @@ -859,10 +859,10 @@ let report_document_attribute_error : DocumentAttribute.error -> unit = function DisplayLine(Printf.sprintf "- %s" (Range.to_string rng2)); ] - | NotASemanticVersion(rng, s) -> + | NotAVersionRequirement(rng, s) -> report_error Interface [ NormalLine(Printf.sprintf "at %s:" (Range.to_string rng)); - NormalLine(Printf.sprintf "not a semantic version: '%s'" s); + NormalLine(Printf.sprintf "not a version requirement: '%s'" s); ] | NotAPackageDependency(rng) -> diff --git a/src/frontend/packageConstraintSolver.ml b/src/frontend/packageConstraintSolver.ml index d8062c1ca..8b398249d 100644 --- a/src/frontend/packageConstraintSolver.ml +++ b/src/frontend/packageConstraintSolver.ml @@ -41,12 +41,12 @@ module SolverInput = struct (* Unused *) type command_name = string - type restriction = package_restriction + type restriction = SemanticVersion.requirement type dependency = | Dependency of { - role : Role.t; - restrictions : package_restriction list; + role : Role.t; + version_requirement : SemanticVersion.requirement; } type dep_info = { @@ -137,8 +137,8 @@ module SolverInput = struct let make_internal_dependency (context : package_context) (requires : package_dependency list) : dependency list = requires |> List.map (function - | PackageDependency{ package_name; restrictions } -> - Dependency{ role = Role{ package_name; context }; restrictions } + | PackageDependency{ package_name; version_requirement } -> + Dependency{ role = Role{ package_name; context }; version_requirement } ) @@ -164,8 +164,8 @@ module SolverInput = struct let restrictions (dep : dependency) : restriction list = - let Dependency{ restrictions; _ } = dep in - restrictions + let Dependency{ version_requirement; _ } = dep in + [ version_requirement ] let meets_restriction (impl : impl) (restr : restriction) : bool = diff --git a/src/frontend/packageSystemBase.ml b/src/frontend/packageSystemBase.ml index d23ddc5d1..d7f472d89 100644 --- a/src/frontend/packageSystemBase.ml +++ b/src/frontend/packageSystemBase.ml @@ -17,14 +17,10 @@ module PackageNameSet = Set.Make(String) type package_name = string [@@deriving show { with_path = false }] -type package_restriction = - | CompatibleWith of SemanticVersion.t -[@@deriving show { with_path = false }] - type package_dependency = | PackageDependency of { - package_name : package_name; - restrictions : package_restriction list; + package_name : package_name; + version_requirement : SemanticVersion.requirement; } [@@deriving show { with_path = false }] diff --git a/src/frontend/semanticVersion.ml b/src/frontend/semanticVersion.ml index 1f5330ab7..daedfe910 100644 --- a/src/frontend/semanticVersion.ml +++ b/src/frontend/semanticVersion.ml @@ -1,7 +1,6 @@ type t = Semver.t - let parse (s : string) : t option = Semver.of_string s @@ -32,3 +31,20 @@ let is_compatible ~(old : t) ~(new_ : t) = old.major = new_.major && ((old.minor < new_.minor) || (old.minor == new_.minor && old.patch <= new_.patch)) + + +type requirement = + | CompatibleWith of t +[@@deriving show { with_path = false }] + + +let parse_requirement (s : string) : requirement option = + match (String.get s 0, parse (String.sub s 1 (String.length s - 1))) with + | exception Invalid_argument(_) -> + None + + | ('^', Some(semver)) -> + Some(CompatibleWith(semver)) + + | _ -> + None diff --git a/src/frontend/semanticVersion.mli b/src/frontend/semanticVersion.mli index b78421125..cc6ac8f59 100644 --- a/src/frontend/semanticVersion.mli +++ b/src/frontend/semanticVersion.mli @@ -9,3 +9,9 @@ val to_string : t -> string val compare : t -> t -> int val is_compatible : old:t -> new_:t -> bool + +type requirement = + | CompatibleWith of t +[@@deriving show] + +val parse_requirement : string -> requirement option From 7fa26a3d0c25e1252f58104f0df51409b4be46f6 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 7 Dec 2022 20:01:44 +0900 Subject: [PATCH 208/288] modify version requirements in config files --- demo/demo.saty | 14 +-- doc/doc-lang.saty | 6 +- doc/doc-primitives.saty | 8 +- doc/math1.saty | 10 +-- .../packages/annot/annot.0.0.1/satysfi.yaml | 2 +- .../packages/code/code.0.0.1/satysfi.yaml | 4 +- .../footnote-scheme.0.0.1/satysfi.yaml | 2 +- .../itemize/itemize.0.0.1/satysfi.yaml | 2 +- .../packages/math/math.0.0.1/satysfi.yaml | 2 +- .../packages/md-ja/md-ja.0.0.1/satysfi.yaml | 20 ++--- .../packages/proof/proof.0.0.1/satysfi.yaml | 2 +- .../std-ja-book.0.0.1/satysfi.yaml | 18 ++-- .../std-ja-report.0.0.1/satysfi.yaml | 18 ++-- .../packages/std-ja/std-ja.0.0.1/satysfi.yaml | 16 ++-- .../packages/stdlib/stdlib.0.0.1/satysfi.yaml | 2 +- .../tabular/tabular.0.0.1/satysfi.yaml | 2 +- lib-satysfi/registries/default/registry.yaml | 88 +++++++++---------- tests/clip.saty | 12 +-- tests/glue1.saty | 12 +-- tests/images/test.saty | 6 +- tests/macro1.saty | 2 +- tests/math-typefaces.saty | 8 +- tests/math2.saty | 12 +-- tests/refactor1.saty | 10 +-- tests/refactor2.saty | 6 +- tests/refactor3.saty | 6 +- tests/refactor5.saty | 6 +- tests/staged1.saty | 2 +- 28 files changed, 149 insertions(+), 149 deletions(-) diff --git a/demo/demo.saty b/demo/demo.saty index 18585aa85..e406c614f 100644 --- a/demo/demo.saty +++ b/demo/demo.saty @@ -1,11 +1,11 @@ #[dependencies [ - (`stdlib`, `0.0.1`), - (`math`, `0.0.1`), - (`code`, `0.0.1`), - (`itemize`, `0.0.1`), - (`proof`, `0.0.1`), - (`tabular`, `0.0.1`), - (`std-ja-book`, `0.0.1`), + (`stdlib`, `^0.0.1`), + (`math`, `^0.0.1`), + (`code`, `^0.0.1`), + (`itemize`, `^0.0.1`), + (`proof`, `^0.0.1`), + (`tabular`, `^0.0.1`), + (`std-ja-book`, `^0.0.1`), ]] use package open Stdlib use package open Math diff --git a/doc/doc-lang.saty b/doc/doc-lang.saty index c0b719255..428ef9066 100644 --- a/doc/doc-lang.saty +++ b/doc/doc-lang.saty @@ -1,7 +1,7 @@ #[dependencies [ - (`stdlib`, `0.0.1`), - (`math`, `0.0.1`), - (`std-ja`, `0.0.1`), + (`stdlib`, `^0.0.1`), + (`math`, `^0.0.1`), + (`std-ja`, `^0.0.1`), ]] use package open Stdlib use package open StdJa diff --git a/doc/doc-primitives.saty b/doc/doc-primitives.saty index 449b06fc4..dcb837984 100644 --- a/doc/doc-primitives.saty +++ b/doc/doc-primitives.saty @@ -1,8 +1,8 @@ #[dependencies [ - (`stdlib`, `0.0.1`), - (`math`, `0.0.1`), - (`itemize`, `0.0.1`), - (`std-ja-book`, `0.0.1`), + (`stdlib`, `^0.0.1`), + (`math`, `^0.0.1`), + (`itemize`, `^0.0.1`), + (`std-ja-book`, `^0.0.1`), ]] use package open Stdlib use package open Math diff --git a/doc/math1.saty b/doc/math1.saty index 90bf068fd..b697765b3 100644 --- a/doc/math1.saty +++ b/doc/math1.saty @@ -1,9 +1,9 @@ #[dependencies [ - (`stdlib`, `0.0.1`), - (`math`, `0.0.1`), - (`proof`, `0.0.1`), - (`tabular`, `0.0.1`), - (`std-ja`, `0.0.1`), + (`stdlib`, `^0.0.1`), + (`math`, `^0.0.1`), + (`proof`, `^0.0.1`), + (`tabular`, `^0.0.1`), + (`std-ja`, `^0.0.1`), ]] use package open Stdlib use package open Math diff --git a/lib-satysfi/packages/annot/annot.0.0.1/satysfi.yaml b/lib-satysfi/packages/annot/annot.0.0.1/satysfi.yaml index 963274f52..706516c56 100644 --- a/lib-satysfi/packages/annot/annot.0.0.1/satysfi.yaml +++ b/lib-satysfi/packages/annot/annot.0.0.1/satysfi.yaml @@ -6,4 +6,4 @@ contents: - "./src" dependencies: - name: "stdlib" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" diff --git a/lib-satysfi/packages/code/code.0.0.1/satysfi.yaml b/lib-satysfi/packages/code/code.0.0.1/satysfi.yaml index 624b06ddf..0469d6f75 100644 --- a/lib-satysfi/packages/code/code.0.0.1/satysfi.yaml +++ b/lib-satysfi/packages/code/code.0.0.1/satysfi.yaml @@ -6,6 +6,6 @@ contents: - "./src" dependencies: - name: "stdlib" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-latin-modern" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" diff --git a/lib-satysfi/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml b/lib-satysfi/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml index 1e5b3ec88..893d8df23 100644 --- a/lib-satysfi/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml +++ b/lib-satysfi/packages/footnote-scheme/footnote-scheme.0.0.1/satysfi.yaml @@ -6,4 +6,4 @@ contents: - "./src" dependencies: - name: "stdlib" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" diff --git a/lib-satysfi/packages/itemize/itemize.0.0.1/satysfi.yaml b/lib-satysfi/packages/itemize/itemize.0.0.1/satysfi.yaml index acb288e1b..c0fe01a09 100644 --- a/lib-satysfi/packages/itemize/itemize.0.0.1/satysfi.yaml +++ b/lib-satysfi/packages/itemize/itemize.0.0.1/satysfi.yaml @@ -6,4 +6,4 @@ contents: - "./src" dependencies: - name: "stdlib" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" diff --git a/lib-satysfi/packages/math/math.0.0.1/satysfi.yaml b/lib-satysfi/packages/math/math.0.0.1/satysfi.yaml index b1bf5c1df..5c9e21b1d 100644 --- a/lib-satysfi/packages/math/math.0.0.1/satysfi.yaml +++ b/lib-satysfi/packages/math/math.0.0.1/satysfi.yaml @@ -6,4 +6,4 @@ contents: - "./src" dependencies: - name: "stdlib" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" diff --git a/lib-satysfi/packages/md-ja/md-ja.0.0.1/satysfi.yaml b/lib-satysfi/packages/md-ja/md-ja.0.0.1/satysfi.yaml index 263d11191..8b35981ef 100644 --- a/lib-satysfi/packages/md-ja/md-ja.0.0.1/satysfi.yaml +++ b/lib-satysfi/packages/md-ja/md-ja.0.0.1/satysfi.yaml @@ -6,25 +6,25 @@ contents: - "./src" dependencies: - name: "stdlib" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "math" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "annot" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "code" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "footnote-scheme" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "itemize" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-junicode" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-latin-modern" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-ipa-ex" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-latin-modern-math" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" conversion: - type: "markdown" document: "MDJa.document" diff --git a/lib-satysfi/packages/proof/proof.0.0.1/satysfi.yaml b/lib-satysfi/packages/proof/proof.0.0.1/satysfi.yaml index 1b7274a7e..a5cc49c04 100644 --- a/lib-satysfi/packages/proof/proof.0.0.1/satysfi.yaml +++ b/lib-satysfi/packages/proof/proof.0.0.1/satysfi.yaml @@ -6,4 +6,4 @@ contents: - "./src" dependencies: - name: "stdlib" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" diff --git a/lib-satysfi/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml b/lib-satysfi/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml index d9c6da8f6..9073acf04 100644 --- a/lib-satysfi/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml +++ b/lib-satysfi/packages/std-ja-book/std-ja-book.0.0.1/satysfi.yaml @@ -6,20 +6,20 @@ contents: - "./src" dependencies: - name: "stdlib" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "math" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "annot" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "code" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "footnote-scheme" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-junicode" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-latin-modern" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-ipa-ex" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-latin-modern-math" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" diff --git a/lib-satysfi/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml b/lib-satysfi/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml index 9125ad9c1..e9afa3844 100644 --- a/lib-satysfi/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml +++ b/lib-satysfi/packages/std-ja-report/std-ja-report.0.0.1/satysfi.yaml @@ -6,20 +6,20 @@ contents: - "./src" dependencies: - name: "stdlib" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "math" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "annot" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "code" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "footnote-scheme" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-junicode" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-latin-modern" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-ipa-ex" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-latin-modern-math" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" diff --git a/lib-satysfi/packages/std-ja/std-ja.0.0.1/satysfi.yaml b/lib-satysfi/packages/std-ja/std-ja.0.0.1/satysfi.yaml index b970aab74..cad6872c8 100644 --- a/lib-satysfi/packages/std-ja/std-ja.0.0.1/satysfi.yaml +++ b/lib-satysfi/packages/std-ja/std-ja.0.0.1/satysfi.yaml @@ -6,18 +6,18 @@ contents: - "./src" dependencies: - name: "stdlib" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "math" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "annot" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "code" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-junicode" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-latin-modern" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-ipa-ex" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-latin-modern-math" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" diff --git a/lib-satysfi/packages/stdlib/stdlib.0.0.1/satysfi.yaml b/lib-satysfi/packages/stdlib/stdlib.0.0.1/satysfi.yaml index c43a5496f..2a93c6acb 100644 --- a/lib-satysfi/packages/stdlib/stdlib.0.0.1/satysfi.yaml +++ b/lib-satysfi/packages/stdlib/stdlib.0.0.1/satysfi.yaml @@ -9,4 +9,4 @@ contents: dependencies: [] test_dependencies: - name: "testing" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" diff --git a/lib-satysfi/packages/tabular/tabular.0.0.1/satysfi.yaml b/lib-satysfi/packages/tabular/tabular.0.0.1/satysfi.yaml index c577d335c..02661f4a1 100644 --- a/lib-satysfi/packages/tabular/tabular.0.0.1/satysfi.yaml +++ b/lib-satysfi/packages/tabular/tabular.0.0.1/satysfi.yaml @@ -6,4 +6,4 @@ contents: - "./src" dependencies: - name: "stdlib" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" diff --git a/lib-satysfi/registries/default/registry.yaml b/lib-satysfi/registries/default/registry.yaml index bbb8dbfbe..bdeaca63e 100644 --- a/lib-satysfi/registries/default/registry.yaml +++ b/lib-satysfi/registries/default/registry.yaml @@ -18,7 +18,7 @@ packages: url: "https://gfngfn.github.io/temp/math.0.0.1.tar.gz" dependencies: - name: "stdlib" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "code" implementations: - version: "0.0.1" @@ -27,9 +27,9 @@ packages: url: "https://gfngfn.github.io/temp/code.0.0.1.tar.gz" dependencies: - name: "stdlib" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-latin-modern" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "annot" implementations: - version: "0.0.1" @@ -38,25 +38,25 @@ packages: url: "https://gfngfn.github.io/temp/annot.0.0.1.tar.gz" dependencies: - name: "stdlib" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "itemize" implementations: - version: "0.0.1" dependencies: - name: "stdlib" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "proof" implementations: - version: "0.0.1" dependencies: - name: "stdlib" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "tabular" implementations: - version: "0.0.1" dependencies: - name: "stdlib" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "footnote-scheme" implementations: - version: "0.0.1" @@ -65,27 +65,27 @@ packages: url: "https://gfngfn.github.io/temp/footnote-scheme.0.0.1.tar.gz" dependencies: - name: "stdlib" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "std-ja" implementations: - version: "0.0.1" dependencies: - name: "stdlib" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "math" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "annot" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "code" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-junicode" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-latin-modern" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-ipa-ex" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-latin-modern-math" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "std-ja-book" implementations: - version: "0.0.1" @@ -94,69 +94,69 @@ packages: url: "https://gfngfn.github.io/temp/std-ja-book.0.0.1.tar.gz" dependencies: - name: "stdlib" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "math" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "annot" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "code" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "footnote-scheme" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-junicode" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-latin-modern" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-ipa-ex" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-latin-modern-math" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "std-ja-report" implementations: - version: "0.0.1" dependencies: - name: "stdlib" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "math" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "annot" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "code" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "footnote-scheme" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-junicode" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-latin-modern" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-ipa-ex" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-latin-modern-math" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "md-ja" implementations: - version: "0.0.1" dependencies: - name: "stdlib" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "math" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "annot" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "code" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "footnote-scheme" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "itemize" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-junicode" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-latin-modern" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-ipa-ex" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-latin-modern-math" - requirements: [ "0.0.1" ] + requirement: "^0.0.1" - name: "font-latin-modern" implementations: - version: "0.0.1" diff --git a/tests/clip.saty b/tests/clip.saty index 131886f9c..90df27f3c 100644 --- a/tests/clip.saty +++ b/tests/clip.saty @@ -1,10 +1,10 @@ #[dependencies [ - (`stdlib`, `0.0.1`), - (`math`, `0.0.1`), - (`font-junicode`, `0.0.1`), - (`font-ipa-ex`, `0.0.1`), - (`font-latin-modern`, `0.0.1`), - (`font-latin-modern-math`, `0.0.1`), + (`stdlib`, `^0.0.1`), + (`math`, `^0.0.1`), + (`font-junicode`, `^0.0.1`), + (`font-ipa-ex`, `^0.0.1`), + (`font-latin-modern`, `^0.0.1`), + (`font-latin-modern-math`, `^0.0.1`), ]] use package open Stdlib use open Head of `head` diff --git a/tests/glue1.saty b/tests/glue1.saty index 129cf28c5..5b4099148 100644 --- a/tests/glue1.saty +++ b/tests/glue1.saty @@ -1,10 +1,10 @@ #[dependencies [ - (`stdlib`, `0.0.1`), - (`math`, `0.0.1`), - (`font-junicode`, `0.0.1`), - (`font-ipa-ex`, `0.0.1`), - (`font-latin-modern`, `0.0.1`), - (`font-latin-modern-math`, `0.0.1`), + (`stdlib`, `^0.0.1`), + (`math`, `^0.0.1`), + (`font-junicode`, `^0.0.1`), + (`font-ipa-ex`, `^0.0.1`), + (`font-latin-modern`, `^0.0.1`), + (`font-latin-modern-math`, `^0.0.1`), ]] use Head of `head` diff --git a/tests/images/test.saty b/tests/images/test.saty index aa69f53c8..c171dec2b 100644 --- a/tests/images/test.saty +++ b/tests/images/test.saty @@ -1,7 +1,7 @@ #[dependencies [ - (`std-ja`, `0.0.1`), - (`itemize`, `0.0.1`), - (`annot`, `0.0.1`), + (`std-ja`, `^0.0.1`), + (`itemize`, `^0.0.1`), + (`annot`, `^0.0.1`), ]] use package StdJa use package Itemize diff --git a/tests/macro1.saty b/tests/macro1.saty index e3efb86ff..18d21ec0f 100644 --- a/tests/macro1.saty +++ b/tests/macro1.saty @@ -1,5 +1,5 @@ #[dependencies [ - (`std-ja-report`, `0.0.1`), + (`std-ja-report`, `^0.0.1`), ]] use package StdJaReport use Macro1Local of `macro1-local` diff --git a/tests/math-typefaces.saty b/tests/math-typefaces.saty index d585d310e..6caa87184 100644 --- a/tests/math-typefaces.saty +++ b/tests/math-typefaces.saty @@ -1,8 +1,8 @@ #[dependencies [ - (`stdlib`, `0.0.1`), - (`math`, `0.0.1`), - (`itemize`, `0.0.1`), - (`std-ja-report`, `0.0.1`), + (`stdlib`, `^0.0.1`), + (`math`, `^0.0.1`), + (`itemize`, `^0.0.1`), + (`std-ja-report`, `^0.0.1`), ]] use package open Stdlib use package open Math diff --git a/tests/math2.saty b/tests/math2.saty index 1545ef8c7..6ad4a08e8 100644 --- a/tests/math2.saty +++ b/tests/math2.saty @@ -1,10 +1,10 @@ #[dependencies [ - (`stdlib`, `0.0.1`), - (`math`, `0.0.1`), - (`font-junicode`, `0.0.1`), - (`font-ipa-ex`, `0.0.1`), - (`font-latin-modern`, `0.0.1`), - (`font-latin-modern-math`, `0.0.1`), + (`stdlib`, `^0.0.1`), + (`math`, `^0.0.1`), + (`font-junicode`, `^0.0.1`), + (`font-ipa-ex`, `^0.0.1`), + (`font-latin-modern`, `^0.0.1`), + (`font-latin-modern-math`, `^0.0.1`), ]] use package Math use Head of `head` diff --git a/tests/refactor1.saty b/tests/refactor1.saty index b2780821d..84f33b9e6 100644 --- a/tests/refactor1.saty +++ b/tests/refactor1.saty @@ -1,9 +1,9 @@ #[dependencies [ - (`stdlib`, `0.0.1`), - (`math`, `0.0.1`), - (`font-junicode`, `0.0.1`), - (`font-ipa-ex`, `0.0.1`), - (`font-latin-modern-math`, `0.0.1`), + (`stdlib`, `^0.0.1`), + (`math`, `^0.0.1`), + (`font-junicode`, `^0.0.1`), + (`font-ipa-ex`, `^0.0.1`), + (`font-latin-modern-math`, `^0.0.1`), ]] use package open Stdlib use package open Math diff --git a/tests/refactor2.saty b/tests/refactor2.saty index a843af9b1..d2d972f05 100644 --- a/tests/refactor2.saty +++ b/tests/refactor2.saty @@ -1,7 +1,7 @@ #[dependencies [ - (`font-junicode`, `0.0.1`), - (`font-ipa-ex`, `0.0.1`), - (`font-latin-modern-math`, `0.0.1`), + (`font-junicode`, `^0.0.1`), + (`font-ipa-ex`, `^0.0.1`), + (`font-latin-modern-math`, `^0.0.1`), ]] use package FontJunicode use package FontIpaEx diff --git a/tests/refactor3.saty b/tests/refactor3.saty index aa8c164fd..4f1e8852a 100644 --- a/tests/refactor3.saty +++ b/tests/refactor3.saty @@ -1,7 +1,7 @@ #[dependencies [ - (`font-junicode`, `0.0.1`), - (`font-ipa-ex`, `0.0.1`), - (`font-latin-modern-math`, `0.0.1`), + (`font-junicode`, `^0.0.1`), + (`font-ipa-ex`, `^0.0.1`), + (`font-latin-modern-math`, `^0.0.1`), ]] use package FontJunicode use package FontIpaEx diff --git a/tests/refactor5.saty b/tests/refactor5.saty index f9fce5eb4..46c6c4dc1 100644 --- a/tests/refactor5.saty +++ b/tests/refactor5.saty @@ -1,7 +1,7 @@ #[dependencies [ - (`font-junicode`, `0.0.1`), - (`font-ipa-ex`, `0.0.1`), - (`font-latin-modern-math`, `0.0.1`), + (`font-junicode`, `^0.0.1`), + (`font-ipa-ex`, `^0.0.1`), + (`font-latin-modern-math`, `^0.0.1`), ]] use package FontJunicode use package FontIpaEx diff --git a/tests/staged1.saty b/tests/staged1.saty index 5fab16846..e4a108d4f 100644 --- a/tests/staged1.saty +++ b/tests/staged1.saty @@ -1,5 +1,5 @@ #[dependencies [ - (`std-ja`, `0.0.1`), + (`std-ja`, `^0.0.1`), ]] use package StdJa use Staged1Local of `staged1-local` From 4ee734f6a862a30aca7f3457e95f8a95742afa04 Mon Sep 17 00:00:00 2001 From: gfngfn Date: Wed, 7 Dec 2022 20:23:58 +0900 Subject: [PATCH 209/288] modify version requirements in 'test.md' --- tests/md/test.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/md/test.md b/tests/md/test.md index 40fab36c6..5e78b3423 100644 --- a/tests/md/test.md +++ b/tests/md/test.md @@ -1,5 +1,5 @@ +