From 1a129cea2d5116382d80cd533387fc093221efaa Mon Sep 17 00:00:00 2001 From: logicmoo Date: Fri, 18 Oct 2024 05:37:21 -0700 Subject: [PATCH 01/11] begining of codeActions --- hyperon-wam.vpj | 3 - .../prolog/lsp_server_metta.pl | 152 ++++++++++++++++-- 2 files changed, 143 insertions(+), 12 deletions(-) diff --git a/hyperon-wam.vpj b/hyperon-wam.vpj index 7472b9e67ca..d7f7c16def2 100755 --- a/hyperon-wam.vpj +++ b/hyperon-wam.vpj @@ -218,9 +218,6 @@ - - - LSP Server -The main entry point for the Language Server implementation. +The main entry point for the Language Server implementation with dynamic handling based on max threads. + +Handles workspace folder changes, file indexing, and incremental updates. + +Supports LSP methods like hover, document symbol, definition, references, and more. @author James Cash */ @@ -9,6 +13,8 @@ :- use_module(library(apply), [maplist/2]). :- use_module(library(debug), [debug/3, debug/1]). :- use_module(library(http/json), [atom_json_dict/3]). +:- use_module(library(thread)). +:- use_module(library(thread_pool)). %:- use_module(library(prolog_xref)). %:- use_module(library(prolog_source), [directory_source_files/3]). :- use_module(library(utf8), [utf8_codes//1]). @@ -37,6 +43,14 @@ :- dynamic lsp_metta_changes:doc_text/2. +% If the max thread count is 1, it processes requests synchronously; +% otherwise, it uses a thread pool for parallel processing. +% 2 is a good default as it needs to be able to implement interruptions anyway +% (this is separate from the file indexer threads) +:- dynamic(lsp_max_threads/1). +lsp_max_threads(1). + +% Main entry point main :- set_prolog_flag(debug_on_error, false), set_prolog_flag(report_error, true), @@ -53,8 +67,7 @@ start(Args) :- debug(server, "Unknown args ~w", [Args]). -% stdio server - +% stdio server initialization stdio_server :- current_input(In), set_stream(In, buffer(full)), @@ -66,6 +79,7 @@ set_stream(In, encoding(octet)), current_output(Out), set_stream(Out, encoding(utf8)), + %stdio_handler_io(In, Out). %(might use this one later) stdio_handler(A-A, In). % [TODO] add multithreading? Guess that will also need a message queue @@ -120,12 +134,12 @@ message: "server error"}}) )). -%hide some response messages +% Hide responses for certain methods %user:nodebug_lsp_response("textDocument/hover"). user:nodebug_lsp_response("textDocument/documentSymbol"). -% Handling messages +% Server capabilities declaration server_capabilities( _{textDocumentSync: _{openClose: true, @@ -147,7 +161,8 @@ referencesProvider: true, documentHighlightProvider: false, - codeActionProvider: false, + codeActionProvider: true, % Changed from false to true + %% codeLensProvider: false, documentFormattingProvider:false, %% documentOnTypeFormattingProvider: false, @@ -155,7 +170,7 @@ % documentLinkProvider: false, % colorProvider: true, foldingRangeProvider: false, - executeCommandProvider: _{commands: ["eval_metta", "query_metta", "assert_metta"]}, + executeCommandProvider: _{commands: ["execute_code", "query_metta", "assert_metta"]}, semanticTokensProvider: _{legend: _{tokenTypes: TokenTypes, tokenModifiers: TokenModifiers}, range: true, @@ -192,7 +207,7 @@ server_capabilities(ServerCapabilities). handle_msg("shutdown", Msg, _{id: Id, result: null}) :- _{id: Id} :< Msg, - debug(server, "recieved shutdown message", []). + debug(server, "received shutdown message", []). % CALL: textDocument/hover % IN: params:{position:{character:11,line:56},textDocument:{uri:file://}}} @@ -349,6 +364,7 @@ ( loaded_source(Path) ; assertz(loaded_source(Path)) ), check_errors_resp(FileUri, Resp). +% Handle document change notifications handle_msg("textDocument/didChange", Msg, false) :- _{params: _{textDocument: TextDoc, contentChanges: Changes}} :< Msg, @@ -358,11 +374,13 @@ lsp_metta_changes:doc_text(Path,FullText), xref_maybe(Path, FullText). % Check if changed and enqueue the reindexing +% Handle document save notifications handle_msg("textDocument/didSave", Msg, Resp) :- _{params: Params} :< Msg, % xref_source_expired(Params.textDocument.uri), check_errors_resp(Params.textDocument.uri, Resp). +% Handle document close notifications handle_msg("textDocument/didClose", Msg, false) :- _{params: _{textDocument: TextDoc}} :< Msg, _{uri: FileUri} :< TextDoc, @@ -377,10 +395,125 @@ handle_msg("$/cancelRequest", Msg, false) :- debug(server, "Cancel request Msg ~w", [Msg]). +% Handle the 'exit' notification handle_msg("exit", _Msg, false) :- - debug(server, "recieved exit, shutting down", []), + debug(server, "Received exit, shutting down", []), halt. + +% Handle the textDocument/codeAction Request +handle_msg("textDocument/codeAction", Msg, _{id: Id, result: Actions}) :- + _{id: Id, params: Params} :< Msg, + _{textDocument: _{uri: Uri}, + range: Range, + context: _Context} :< Params, + compute_code_actions(Uri, Range, Actions). + +% Compute Code Actions +compute_code_actions(Uri, Range, [Action]) :- + Action = _{ + title: "Execute Code", + kind: "quickfix", + command: _{ + title: "Execute Code", + command: "execute_code", + arguments: [Uri, Range] + } + }. + +% Handle the workspace/executeCommand Request +handle_msg("workspace/executeCommand", Msg, _{id: Id, result: Result}) :- + _{id: Id, params: Params} :< Msg, + _{command: Command, arguments: Arguments} :< Params, + execute_command(Command, Arguments, ExecutionResult), + Result = _{message: ExecutionResult}. + +% Execute Command Implementation +execute_command("execute_code", [Uri, Range], ExecutionResult) :- + get_code_at_range(Uri, Range, Code), + execute_code(Code, ExecutionResult). +execute_command(_, _, "Command not recognized."). + +% Get Code at the Specified Range +get_code_at_range(Uri, Range, Code) :- + atom_concat('file://', Path, Uri), + lsp_metta_changes:doc_text(Path, SplitText), + coalesce_text(SplitText, Text), + split_string(Text, "\n", "", Lines), + _{start: Start, end: End} :< Range, + _{line: StartLine0, character: StartChar} :< Start, + _{line: EndLine0, character: EndChar} :< End, + StartLine is StartLine0 + 1, + EndLine is EndLine0 + 1, + extract_code(Lines, StartLine, StartChar, EndLine, EndChar, Code). + +% Extract Code from Lines +extract_code(Lines, StartLine, StartChar, EndLine, EndChar, Code) :- + findall(LineText, ( + between(StartLine, EndLine, LineNum), + nth1(LineNum, Lines, Line), + ( + LineNum =:= StartLine, LineNum =:= EndLine -> + sub_atom(Line, StartChar, EndChar - StartChar, _, LineText) + ; + LineNum =:= StartLine -> + sub_atom(Line, StartChar, _, 0, LineText) + ; + LineNum =:= EndLine -> + sub_atom(Line, 0, EndChar, _, LineText) + ; + LineText = Line + ) + ), CodeLines), + atomic_list_concat(CodeLines, '\n', Code). + +% Execute the Code +execute_code(Code, Result) :- + % For safety, catch any errors during execution + catch_with_backtrace(( + % Replace with actual code execution logic + % For demonstration, we'll just unify Result with Code + % In practice, you might use metta:eval_string/2 or similar + Result = Code + ), Error, ( + format(atom(ErrorMsg), 'Error executing code: ~w', [Error]), + Result = ErrorMsg + )). + + +% Handle the 'workspace/symbol' Request +handle_msg("workspace/symbol", Msg, _{id: Id, result: Symbols}) :- + _{id: Id, params: Params} :< Msg, + _{query: Query} :< Params, + collect_workspace_symbols(Query, Symbols). + +% Collect Workspace Symbols +collect_workspace_symbols(Query, Symbols) :- + findall(Symbol, + ( + in_editor(Path), + % Convert file path to URI + atom_concat('file://', Path, DocUri), + xref_document_symbols(DocUri, DocSymbols), + member(Symbol, DocSymbols), + symbol_matches_query(Symbol, Query) + ), + Symbols). + +% Predicate to check if a symbol matches the query +symbol_matches_query(Symbol, Query) :- + ( Query == "" -> true % If query is empty, include all symbols + ; get_symbol_name(Symbol, Name), + sub_atom_icasechk(Name, _, Query) % Case-insensitive match + ). + +% Helper predicate to extract the symbol's name +get_symbol_name(Symbol, Name) :- + % Symbol may be in hierarchical or non-hierarchical format + ( get_dict(name, Symbol, Name) + ; get_dict(label, Symbol, Name) + ). + % wildcard handle_msg(_, Msg, _{id: Id, error: _{code: -32603, message: "Unimplemented"}}) :- _{id: Id} :< Msg, !, @@ -388,6 +521,7 @@ handle_msg(_, Msg, false) :- debug(server, "unknown notification ~w", [Msg]). +% [TODO]Check errors and respond with diagnostics check_errors_resp(FileUri, _{method: "textDocument/publishDiagnostics", params: _{uri: FileUri, diagnostics: Errors}}) :- atom_concat('file://', Path, FileUri), From 729917c475815d6055a73a76ca8743587c3e4f9d Mon Sep 17 00:00:00 2001 From: logicmoo Date: Fri, 18 Oct 2024 06:06:08 -0700 Subject: [PATCH 02/11] Pre worker pool --- .../prolog/lsp_server_metta.pl | 211 ++++++++++++++++-- 1 file changed, 194 insertions(+), 17 deletions(-) diff --git a/src/packs/lsp_server_metta/prolog/lsp_server_metta.pl b/src/packs/lsp_server_metta/prolog/lsp_server_metta.pl index 9e6950a5514..cf9139ef07a 100644 --- a/src/packs/lsp_server_metta/prolog/lsp_server_metta.pl +++ b/src/packs/lsp_server_metta/prolog/lsp_server_metta.pl @@ -43,12 +43,12 @@ :- dynamic lsp_metta_changes:doc_text/2. -% If the max thread count is 1, it processes requests synchronously; +% If the max worked thread count is 0, it processes requests synchronously; % otherwise, it uses a thread pool for parallel processing. % 2 is a good default as it needs to be able to implement interruptions anyway % (this is separate from the file indexer threads) -:- dynamic(lsp_max_threads/1). -lsp_max_threads(1). +:- dynamic(lsp_worker_threads/1). +lsp_worker_threads(1). % Main entry point main :- @@ -59,8 +59,77 @@ debug(server), debug(server(high)), load_mettalog_xref, + ignore(handle_threads(Args)), % Handle threading based on max threads. start(Args). +% Handle thread pool or synchronous mode based on max threads. +handle_threads([MaxThreadsArg | _]) :- + atom_number(MaxThreadsArg, MaxThreads), + retractall(lsp_worker_threads(_)), + assertz(lsp_worker_threads(MaxThreads)), + ( MaxThreads > 1 + -> create_worker_pool(MaxThreads) % Create thread pool if max threads > 1 + ; debug(server, "Running synchronously since max threads = 1", []) % Sync mode + ). + +% Create a pool of workers if using more than 1 thread +create_worker_pool(NumWorkersP1) :- + NumWorkers is NumWorkersP1 - 1, + message_queue_create(task_queue), + numlist(1, NumWorkers, Workers), + maplist(start_worker, Workers). + +% Include necessary dynamic predicates +:- dynamic thread_request/2. +:- dynamic worker_thread/1. +:- dynamic id_was_canceled/1. + +% Create a mutex for synchronization +:- mutex_create(request_mutex). + +% Start an individual worker +start_worker :- + thread_create(worker_loop, ThreadId, [detached(true)]), + assertz(worker_thread(ThreadId)). + +% Update worker_loop to handle task cancellation +worker_loop :- + thread_self(ThreadId), + message_queue_pop(task_queue, Task), + Task = lsp_task(Out, Req), + ( get_dict(id, Req.body, RequestId) -> + true + ; RequestId = none ), + % Register this thread handling RequestId + ( id_was_canceled(RequestId) -> + debug(server, "Request ~w was canceled before it got started!", [RequestId]) + ; ( with_mutex(request_mutex, assertz(thread_request(RequestId, ThreadId))), + debug(server, "Worker ~w processing task with ID ~w", [ThreadId, RequestId]), + catch( + handle_request(Out, Req), + canceled, + ( debug(server, "Request ~w was canceled", [RequestId]), + send_cancellation_response(Out, RequestId) + ) + ), + % Clean up after handling + with_mutex(request_mutex, + retract(thread_request(RequestId, ThreadId)) + ) + ) + ), + worker_loop. + +% Send a cancellation response if necessary +send_cancellation_response(_OutStream, _RequestId) :- + % According to LSP, the server should not send a response to a canceled request, + % but some clients may expect a response indicating cancellation. + % Uncomment the following lines if you want to send such a response. + % Response = _{jsonrpc: "2.0", id: RequestId, error: _{code: -32800, message: "Request canceled"}}, + % send_message(OutStream, Response), + true. + +% Start the server based on input arguments start([stdio]) :- !, debug(server, "Starting stdio client", []), stdio_server. @@ -80,11 +149,87 @@ current_output(Out), set_stream(Out, encoding(utf8)), %stdio_handler_io(In, Out). %(might use this one later) - stdio_handler(A-A, In). + stdio_handler(A-A, In, Out). + + + +/* +% Handling requests from input/ouput stream (might use this one later) +stdio_handler_io(In, Out) :- + lsp_worker_threads(MaxThreads), + read_message(In, Codes), + ( Codes == end_of_file -> + true + ; phrase(lsp_metta_request(Req), Codes, RemainingCodes), + handle_parsed_request(Req, Out, MaxThreads), + ( RemainingCodes == [] -> + stdio_handler(In, Out) + ; % There might be multiple requests in the buffer + process_remaining_requests(RemainingCodes, Out, MaxThreads), + stdio_handler(In, Out) + ) + ). + +% Process remaining requests in the buffer +process_remaining_requests(Codes, Out, MaxThreads) :- + ( phrase(lsp_metta_request(Req), Codes, RemainingCodes) -> + handle_parsed_request(Req, Out, MaxThreads), + ( RemainingCodes == [] -> + true + ; process_remaining_requests(RemainingCodes, Out, MaxThreads) + ) + ; % Could not parse a complete request, ignore or handle error + true + ). + + +% Read a complete message from the input stream +read_message(In, Codes) :- + read_header(In, ContentLength), + ( ContentLength = end_of_file -> + Codes = end_of_file + ; read_codes(In, ContentLength, Codes) + ). + +% Read the header to get Content-Length +read_header(In, ContentLength) :- + read_line_to_codes(In, HeaderCodes), + ( HeaderCodes == end_of_file -> + ContentLength = end_of_file + ; atom_codes(HeaderLine, HeaderCodes), + ( HeaderLine = '' -> + % Empty line, headers end + read_header(In, ContentLength) + ; split_string(HeaderLine, ": ", "", ["Content-Length", LengthStr]) -> + number_string(ContentLength, LengthStr), + % Read the blank line after headers + read_line_to_codes(In, _) + ; % Other headers, ignore + read_header(In, ContentLength) + ) + ). + +% Read the message body based on Content-Length +read_codes(In, ContentLength, Codes) :- + read_n_codes(In, ContentLength, Codes). + +% Helper to read N codes from input +read_n_codes(In, N, Codes) :- + ( N > 0 -> + get_code(In, C), + N1 is N - 1, + read_n_codes(In, N1, RestCodes), + Codes = [C|RestCodes] + ; Codes = [] + ). +*/ +% Handling requests from input stream + + % [TODO] add multithreading? Guess that will also need a message queue % to write to stdout -stdio_handler(Extra-ExtraTail, In) :- +stdio_handler(Extra-ExtraTail, In, Out) :- wait_for_input([In], _, infinite), fill_buffer(In), read_pending_codes(In, ReadCodes, Tail), @@ -93,22 +238,37 @@ ; ( current_output(Out), ExtraTail = ReadCodes, handle_requests(Out, Extra, Remainder), - stdio_handler(Remainder-Tail, In) ) + stdio_handler(Remainder-Tail, In, Out) ) ). -handle_requests(Out, In, Tail) :- - handle_request(Out, In, Rest), !, +handle_requests(Out, InCodes, Tail) :- + handle_request(Out, InCodes, Rest), !, ( var(Rest) -> Tail = Rest ; handle_requests(Out, Rest, Tail) ). handle_requests(_, T, T). +% Handle parsed requests +handle_parsed_request(Req, Out) :- + ( Req.body.method == "$/cancelRequest" -> + handle_msg(Req.body.method, Req.body, _) % Handle cancel immediately + ; lsp_worker_threads(MaxThreads) + handle_request(Out, Req) + ; enqueue_task(lsp_task(Out, Req)) + ). + +% Enqueue an incoming LSP request to be handled by a worker +enqueue_task(Task) :- + message_queue_push(task_queue, Task). + % general handling stuff +% Backtrace error handler catch_with_backtrace(Goal):- catch_with_backtrace(Goal,Err, (debug(server(high), "error in ~n~n?- catch_with_backtrace(~q).~n~n handling msg:~n~n~@~n~n", [Goal, print_message(error, Err)]),throw(Err))). +% Send LSP message to client send_message(Stream, Msg) :- catch_with_backtrace(( put_dict(jsonrpc, Msg, "2.0", VersionedMsg), @@ -118,20 +278,25 @@ format(Stream, "Content-Length: ~w\r\n\r\n~s", [ContentLength, JsonCodes]), flush_output(Stream))). +% Handle individual requests handle_request(OutStream, Input, Rest) :- phrase(lsp_metta_request(Req), Input, Rest), debug(server(high), "Request ~q", [Req.body]), catch( ( catch_with_backtrace(handle_msg(Req.body.method, Req.body, Resp)), - ignore((user:nodebug_lsp_response(Req.body.method) -> debug(server(high), "response id: ~q", [Resp.id]) ; debug(server(high), "response ~q", [Resp]))), - %debug(server(high), "response ~q", [Resp]), + ignore((user:nodebug_lsp_response(Req.body.method) -> + debug(server(high),"response id: ~q",[Resp.id]); + debug(server(high),"response ~q",[Resp]))), ( is_dict(Resp) -> send_message(OutStream, Resp) ; true ) ), Err, - ( debug(server, "error handling msg ~q", [Err]), + ( Err == canceled -> + throw(canceled) + ; ( debug(server, "error handling msg ~q", [Err]), get_dict(id, Req.body, Id), send_message(OutStream, _{id: Id, error: _{code: -32001, message: "server error"}}) + ) )). % Hide responses for certain methods @@ -153,7 +318,8 @@ documentSymbolProvider: true, - workspaceSymbolProvider: true, + workspaceSymbolProvider: true, % Workspace symbol provider + definitionProvider: true, declarationProvider: true, implementationProvider: true, @@ -186,7 +352,7 @@ -:- dynamic loaded_source/1. +:- dynamic in_editor/1. % is not already an object? into_result_object(Help,Response):- \+ is_dict(Help), @@ -202,7 +368,7 @@ ( Params.rootUri \== null -> ( atom_concat('file://', RootPath, Params.rootUri), directory_source_files(RootPath, Files, [recursive(true)]), - maplist([F]>>assert(loaded_source(F)), Files) ) + maplist([F]>>assert(in_editor(F)), Files) ) ; true ), server_capabilities(ServerCapabilities). handle_msg("shutdown", Msg, _{id: Id, result: null}) :- @@ -361,7 +527,7 @@ xref_maybe(Path, FullText), % Check if changed and enqueue the reindexing retractall(lsp_metta_changes:doc_text(Path, _)), assertz(lsp_metta_changes:doc_text(Path, SplitText)), - ( loaded_source(Path) ; assertz(loaded_source(Path)) ), + ( in_editor(Path) ; assertz(in_editor(Path)) ), check_errors_resp(FileUri, Resp). % Handle document change notifications @@ -385,15 +551,26 @@ _{params: _{textDocument: TextDoc}} :< Msg, _{uri: FileUri} :< TextDoc, atom_concat('file://', Path, FileUri), - retractall(loaded_source(Path)). + retractall(in_editor(Path)). handle_msg("initialized", Msg, false) :- debug(server, "initialized ~w", [Msg]). handle_msg("$/setTrace", _Msg, false). +% Handle the $/cancelRequest Notification handle_msg("$/cancelRequest", Msg, false) :- - debug(server, "Cancel request Msg ~w", [Msg]). + _{params: _{id: CancelId}} :< Msg, + debug(server, "Cancel request received for ID ~w", [CancelId]), + with_mutex(request_mutex, + ( thread_request(CancelId, ThreadId) + -> % Attempt to interrupt the thread + debug(server, "Attempting to cancel thread ~w", [ThreadId]), + catch(thread_signal(ThreadId, throw(canceled)),_,true), % in case thread is already gone + ignore(retract(thread_request(CancelId, ThreadId))) % in case thread retracted it + ; ( debug(server, "No running thread found for request ID ~w", [CancelId]), + assert(id_was_canceled(CancelId)) ) + )). % Handle the 'exit' notification handle_msg("exit", _Msg, false) :- From b75752047ac31665d5e0201f84df37059fa9574d Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 18 Oct 2024 11:27:05 -0500 Subject: [PATCH 03/11] update docs for Minimal MeTTa functions --- src/canary/stdlib_mettalog.metta | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/src/canary/stdlib_mettalog.metta b/src/canary/stdlib_mettalog.metta index f47818a0be3..26224add0f1 100644 --- a/src/canary/stdlib_mettalog.metta +++ b/src/canary/stdlib_mettalog.metta @@ -92,7 +92,7 @@ ; Public MinimalMeTTa (@doc eval - (@desc "Evaluates input atom, makes one step of the evaluation") + (@desc "Evaluates input Atom, performs one step of the evaluation. Empty results (Empty, ()) are removed from the result set. If no results are produced for a non-grounded function, eval returns NotReducible.") (@params ( (@param "Atom to be evaluated, can be reduced via equality expression (= ...) or by calling a grounded function"))) (@return "Result of evaluation")) @@ -101,11 +101,11 @@ ; Public MinimalMeTTa (@doc chain - (@desc "Evaluates first argument, binds it to the variable (second argument) and then evaluates third argument which contains (or not) mentioned variable") + (@desc "Evaluates first argument Atom, binds it to the Variable (second argument) and then evaluates third argument Template with Variable substituted in. When evaluation of the first Atom brings more than a single result, chain returns one instance of the Template expression for each result. The first argument Atom is only evaluated if it is part of the Minimal MeTTa specification; evaluation of non-Minimal MeTTa atoms can be controlled by wrapping in a call to eval (for one evaluation step) or metta (for full evaluation).") (@params ( (@param "Atom to be evaluated") (@param "Variable") - (@param "Atom which will be evaluated at the end"))) + (@param "Template which will be evaluated at the end with Variable substituted"))) (@return "Result of evaluating third input argument")) (: chain (-> Atom Variable Atom Atom)) ;; Implemented from Interpreters @@ -132,7 +132,7 @@ (= (if-unify-or-empty $a $b) (empty)) -;; Public MeTTa +;; Public MinimalMeTTa (@doc cons-atom (@desc "Constructs an expression using two arguments") (@params ( @@ -143,7 +143,7 @@ ;; Implemented from Interpreters ; AKA? (: cons (-> Atom Atom Atom)) -;; Public MeTTa +;; Public MinimalMeTTa (@doc decons-atom (@desc "Works as a reverse to cons-atom function. It gets Expression as an input and returns it splitted to head and tail, e.g. (decons-atom (Cons X Nil)) -> (Cons (X Nil))") (@params ( @@ -153,26 +153,24 @@ ;; Implemented from Interpreters ; AKA? (: decons (-> Atom Atom)) -;; Public MeTTa +;; Public MinimalMeTTa (@doc collapse-bind - (@desc "Evaluates the Atom (first argument) and returns an expression which contains all alternative evaluations in a form (Atom Bindings). Bindings are represented in a form of a grounded atom.") + (@desc "Evaluates the Atom (first argument) and returns an expression which contains all alternative evaluations in a form (Atom Bindings). Bindings are represented in a form of a grounded atom { <- , ... }. See also the complement superpose-bind. Note that, like chain, collapse-bind only evaluates Minimal Metta expressions. Evaluation of non-Minimal MeTTa atoms can be controlled by wrapping in a call to eval (for one evaluation step) or metta (for full evaluation).") (@params ( (@param "Atom to be evaluated"))) (@return "All alternative evaluations")) -;; collapse-bind because `collapse` doesnt guarentee shared bindings -(: collapse-bind (-> Atom Atom)) ; We specialize but leaving the old defs in case +;; collapse-bind because `collapse` doesnt guarantee shared bindings (: collapse-bind (-> Atom Expression)) ;; Implemented from Interpreters -;; Public MeTTa +;; Public MinimalMeTTa (@doc superpose-bind - (@desc "Complement to the collapse-bind. It takes result of collapse-bind (first argument) and returns only result atoms without bindings") + (@desc "Complement to the collapse-bind. It takes result of collapse-bind (first argument) and returns only result atoms without bindings. Primarily used with some filtering step on the collapse-bind results, i.e. collapse-bind -> -> superpose-bind.") (@params ( (@param "Expression in form (Atom Binding)"))) (@return "Non-deterministic list of Atoms")) ;; superpose-bind because `superpose` doesnt guarentee shared bindings (: superpose-bind (-> Expression Atom)) -(: superpose-bind (-> Atom Atom)) ; We specialize them but leaving the old defs in case ;; Implemented from Interpreters ; Helper Minimal Metta? From f42f6a46ee557d78c54f20962e0f8df10e54d85a Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 18 Oct 2024 14:57:08 -0500 Subject: [PATCH 04/11] tests for Minimal MeTTa --- .../minimal_metta_tests.metta | 73 +++++++++++++++++++ 1 file changed, 73 insertions(+) create mode 100644 tests/baseline_compat/hyperon-mettalog_sanity/minimal_metta_tests.metta diff --git a/tests/baseline_compat/hyperon-mettalog_sanity/minimal_metta_tests.metta b/tests/baseline_compat/hyperon-mettalog_sanity/minimal_metta_tests.metta new file mode 100644 index 00000000000..c6478b90cfd --- /dev/null +++ b/tests/baseline_compat/hyperon-mettalog_sanity/minimal_metta_tests.metta @@ -0,0 +1,73 @@ +;; remove Empty result + +(= (returns-empty) Empty) +(= (returns-empty) 1) +(= (chain-to-empty) (returns-empty)) + +!(assertEqualToResult (returns-empty) (1)) +!(assertEqualToResult (eval (returns-empty)) (1)) +!(assertEqualToResult (chain-to-empty) (1)) +!(assertEqualToResult (eval (chain-to-empty)) (1)) +!(assertEqualToResult (chain (eval (returns-empty)) $x (quote $x)) ((quote 1) (quote Empty))) +!(assertEqualToResult (chain (eval (chain-to-empty)) $x (quote $x)) ((quote (returns-empty)))) + +;; include empty expression () + +(= (returns-empty-expression) ()) +(= (returns-empty-expression) 1) +(= (chain-to-empty-expression) (returns-empty-expression)) + +!(assertEqualToResult (returns-empty-expression) (1 ())) +!(assertEqualToResult (eval (returns-empty-expression)) (1 ())) +!(assertEqualToResult (chain-to-empty-expression) (1 ())) +!(assertEqualToResult (eval (chain-to-empty-expression)) (1 ())) +!(assertEqualToResult (chain (eval (returns-empty-expression)) $x (quote $x)) ((quote 1) (quote ()))) +!(assertEqualToResult (chain (eval (chain-to-empty-expression)) $x (quote $x)) ((quote (returns-empty-expression)))) + +;; return original form for NotReducible + +(= (returns-not-reducible) NotReducible) +(= (returns-not-reducible) 1) +(= (chain-to-not-reducible) (returns-not-reducible)) + +!(assertEqualToResult (returns-not-reducible) (1 (returns-not-reducible))) +!(assertEqualToResult (chain-to-not-reducible) (1 (returns-not-reducible))) +!(assertEqualToResult (eval (returns-not-reducible)) (1 (eval (returns-not-reducible)))) +!(assertEqualToResult (eval (chain-to-not-reducible)) (1 (returns-not-reducible))) +!(assertEqualToResult (chain (eval (returns-not-reducible)) $x (quote $x)) ((quote 1) (quote NotReducible))) +!(assertEqualToResult (chain (eval (chain-to-not-reducible)) $x (quote $x)) ((quote (returns-not-reducible)))) + +;; collapse-bind operates on Minimal MeTTa + +(= (bar A) (input A)) +(= (bar B) (input B)) +(= (foo $x) (bar $x)) + +!(assertEqualToResult (chain (collapse-bind (foo $x)) $a (quote $a)) ((quote (((foo $x) { }))))) +!(assertEqualToResult (chain (collapse-bind (eval (foo $x))) $a (quote $a)) ((quote (((bar $x) { }))))) +!(assertEqualToResult (chain (collapse-bind (metta (foo $x) %Undefined% &self)) $a (quote $a)) ((quote (((input B) { $x <- B }) ((input A) { $x <- A }))))) + +;; superpose-bind complements collapse-bind + +!(assertEqualToResult (chain (collapse-bind (foo $x)) $a + (chain (superpose-bind $a) $b (quote $b))) + ((quote (foo $x)))) +!(assertEqualToResult (chain (collapse-bind (eval (foo $x))) $a + (chain (superpose-bind $a) $b (quote $b))) + ((quote (bar $x)))) +!(assertEqualToResult (chain (collapse-bind (metta (foo $x) %Undefined% &self)) $a + (chain (superpose-bind $a) $b (quote $b))) + ((quote (input B)) (quote (input A)))) + +;; metta handles type + +(= (foobar) 1) +(= (foobar) "a") +(= (chain-to-foobar) (foobar)) + +!(assertEqualToResult (metta (foobar) Number &self) (1)) +!(assertEqualToResult (metta (foobar) String &self) ("a")) +!(assertEqualToResult (collapse-bind (metta (foobar) $type &self)) ((1 { $type <- Number }) ("a" { $type <- String }))) +!(assertEqualToResult (metta (chain-to-foobar) Number &self) (1)) +!(assertEqualToResult (metta (chain-to-foobar) String &self) ("a")) +!(assertEqualToResult (collapse-bind (metta (chain-to-foobar) $type &self)) ((1 { $type <- Number }) ("a" { $type <- String }))) From 62f07de9ecfd93f26a3bc3a0746b8552cd804103 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Fri, 18 Oct 2024 12:57:42 -0700 Subject: [PATCH 05/11] lsp_worker_threads(0) --- .../prolog/lsp_server_metta.pl | 388 +++++++++--------- 1 file changed, 199 insertions(+), 189 deletions(-) diff --git a/src/packs/lsp_server_metta/prolog/lsp_server_metta.pl b/src/packs/lsp_server_metta/prolog/lsp_server_metta.pl index cf9139ef07a..8415d428527 100644 --- a/src/packs/lsp_server_metta/prolog/lsp_server_metta.pl +++ b/src/packs/lsp_server_metta/prolog/lsp_server_metta.pl @@ -48,7 +48,7 @@ % 2 is a good default as it needs to be able to implement interruptions anyway % (this is separate from the file indexer threads) :- dynamic(lsp_worker_threads/1). -lsp_worker_threads(1). +lsp_worker_threads(0). % Main entry point main :- @@ -59,77 +59,81 @@ debug(server), debug(server(high)), load_mettalog_xref, - ignore(handle_threads(Args)), % Handle threading based on max threads. + ignore(handle_threads(Args)), % Handle threading based on max threads. start(Args). -% Handle thread pool or synchronous mode based on max threads. -handle_threads([MaxThreadsArg | _]) :- - atom_number(MaxThreadsArg, MaxThreads), - retractall(lsp_worker_threads(_)), - assertz(lsp_worker_threads(MaxThreads)), - ( MaxThreads > 1 - -> create_worker_pool(MaxThreads) % Create thread pool if max threads > 1 - ; debug(server, "Running synchronously since max threads = 1", []) % Sync mode - ). - -% Create a pool of workers if using more than 1 thread -create_worker_pool(NumWorkersP1) :- - NumWorkers is NumWorkersP1 - 1, - message_queue_create(task_queue), - numlist(1, NumWorkers, Workers), - maplist(start_worker, Workers). - -% Include necessary dynamic predicates -:- dynamic thread_request/2. -:- dynamic worker_thread/1. -:- dynamic id_was_canceled/1. - -% Create a mutex for synchronization -:- mutex_create(request_mutex). - -% Start an individual worker -start_worker :- - thread_create(worker_loop, ThreadId, [detached(true)]), - assertz(worker_thread(ThreadId)). - -% Update worker_loop to handle task cancellation -worker_loop :- - thread_self(ThreadId), - message_queue_pop(task_queue, Task), - Task = lsp_task(Out, Req), - ( get_dict(id, Req.body, RequestId) -> - true - ; RequestId = none ), - % Register this thread handling RequestId - ( id_was_canceled(RequestId) -> - debug(server, "Request ~w was canceled before it got started!", [RequestId]) - ; ( with_mutex(request_mutex, assertz(thread_request(RequestId, ThreadId))), - debug(server, "Worker ~w processing task with ID ~w", [ThreadId, RequestId]), - catch( - handle_request(Out, Req), - canceled, - ( debug(server, "Request ~w was canceled", [RequestId]), - send_cancellation_response(Out, RequestId) - ) - ), - % Clean up after handling - with_mutex(request_mutex, - retract(thread_request(RequestId, ThreadId)) - ) - ) - ), - worker_loop. - -% Send a cancellation response if necessary -send_cancellation_response(_OutStream, _RequestId) :- - % According to LSP, the server should not send a response to a canceled request, - % but some clients may expect a response indicating cancellation. - % Uncomment the following lines if you want to send such a response. - % Response = _{jsonrpc: "2.0", id: RequestId, error: _{code: -32800, message: "Request canceled"}}, - % send_message(OutStream, Response), - true. - -% Start the server based on input arguments +% Handle thread pool or synchronous mode based on max threads. +handle_threads([MaxThreadsArg | _]) :- + ignore((atom_number(MaxThreadsArg, MaxThreadsN), + retractall(lsp_worker_threads(_)), + assertz(lsp_worker_threads(MaxThreadsN)))). + +start_lsp_worker_threads:- + lsp_worker_threads(MaxThreads), + ( MaxThreads > 0 + -> create_worker_pool(MaxThreads) % Create thread pool if max threads > 1 + ; debug(server, "Running synchronously since max threads = 0", []) % Sync mode + ). + +% Create a pool of workers if using more than 0 +create_worker_pool(NumWorkers) :- NumWorkers < 1,!. +create_worker_pool(NumWorkers) :- + NumWorkersM1 is NumWorkers-1, + start_worker, + create_worker_pool(NumWorkersM1). + +% Include necessary dynamic predicates +:- dynamic thread_request/2. +:- dynamic worker_thread/1. +:- dynamic id_was_canceled/1. + +% Create a mutex for synchronization +:- message_queue_create('$lsp_task_queue'). +:- mutex_create('$lsp_request_mutex'). + +% Start an individual worker +start_worker :- + thread_create(worker_loop, ThreadId, [detached(true)]), + assertz(worker_thread(ThreadId)). + +% Update worker_loop to handle task cancellation +worker_loop :- + thread_self(ThreadId), + message_queue_pop('$lsp_task_queue', Task), + Task = lsp_task(Out, Req), + ( get_dict(id, Req.body, RequestId) -> + true + ; RequestId = none ), + % Register this thread handling RequestId + ( id_was_canceled(RequestId) -> + debug(server, "Request ~w was canceled before it got started!", [RequestId]) + ; ( with_mutex('$lsp_request_mutex', assertz(thread_request(RequestId, ThreadId))), + debug(server, "Worker ~w processing task with ID ~w", [ThreadId, RequestId]), + catch( + handle_request(Out, Req), + canceled, + ( debug(server, "Request ~w was canceled", [RequestId]), + send_cancellation_response(Out, RequestId) + ) + ), + % Clean up after handling + with_mutex('$lsp_request_mutex', + retract(thread_request(RequestId, ThreadId)) + ) + ) + ), + worker_loop. + +% Send a cancellation response if necessary +send_cancellation_response(_OutStream, _RequestId) :- + % According to LSP, the server should not send a response to a canceled request, + % but some clients may expect a response indicating cancellation. + % Uncomment the following lines if you want to send such a response. + % Response = _{jsonrpc: "2.0", id: RequestId, error: _{code: -32800, message: "Request canceled"}}, + % send_message(OutStream, Response), + true. + +% Start the server based on input arguments start([stdio]) :- !, debug(server, "Starting stdio client", []), stdio_server. @@ -143,6 +147,7 @@ set_stream(In, newline(posix)), set_stream(In, tty(false)), set_stream(In, representation_errors(error)), + start_lsp_worker_threads, % handling UTF decoding in JSON parsing, but doing the auto-translation % causes Content-Length to be incorrect set_stream(In, encoding(octet)), @@ -152,84 +157,84 @@ stdio_handler(A-A, In, Out). - -/* -% Handling requests from input/ouput stream (might use this one later) -stdio_handler_io(In, Out) :- - lsp_worker_threads(MaxThreads), - read_message(In, Codes), - ( Codes == end_of_file -> - true - ; phrase(lsp_metta_request(Req), Codes, RemainingCodes), - handle_parsed_request(Req, Out, MaxThreads), - ( RemainingCodes == [] -> - stdio_handler(In, Out) - ; % There might be multiple requests in the buffer - process_remaining_requests(RemainingCodes, Out, MaxThreads), - stdio_handler(In, Out) - ) - ). - -% Process remaining requests in the buffer -process_remaining_requests(Codes, Out, MaxThreads) :- - ( phrase(lsp_metta_request(Req), Codes, RemainingCodes) -> - handle_parsed_request(Req, Out, MaxThreads), - ( RemainingCodes == [] -> - true - ; process_remaining_requests(RemainingCodes, Out, MaxThreads) - ) - ; % Could not parse a complete request, ignore or handle error - true - ). - - -% Read a complete message from the input stream -read_message(In, Codes) :- - read_header(In, ContentLength), - ( ContentLength = end_of_file -> - Codes = end_of_file - ; read_codes(In, ContentLength, Codes) - ). - -% Read the header to get Content-Length -read_header(In, ContentLength) :- - read_line_to_codes(In, HeaderCodes), - ( HeaderCodes == end_of_file -> - ContentLength = end_of_file - ; atom_codes(HeaderLine, HeaderCodes), - ( HeaderLine = '' -> - % Empty line, headers end - read_header(In, ContentLength) - ; split_string(HeaderLine, ": ", "", ["Content-Length", LengthStr]) -> - number_string(ContentLength, LengthStr), - % Read the blank line after headers - read_line_to_codes(In, _) - ; % Other headers, ignore - read_header(In, ContentLength) - ) - ). - -% Read the message body based on Content-Length -read_codes(In, ContentLength, Codes) :- - read_n_codes(In, ContentLength, Codes). - -% Helper to read N codes from input -read_n_codes(In, N, Codes) :- - ( N > 0 -> - get_code(In, C), - N1 is N - 1, - read_n_codes(In, N1, RestCodes), - Codes = [C|RestCodes] - ; Codes = [] - ). -*/ -% Handling requests from input stream - - + +/* +% Handling requests from input/ouput stream (might use this one later) +stdio_handler_io(In, Out) :- + lsp_worker_threads(MaxThreads), + read_message(In, Codes), + ( Codes == end_of_file -> + true + ; phrase(lsp_metta_request(Req), Codes, RemainingCodes), + handle_parsed_request(Req, Out, MaxThreads), + ( RemainingCodes == [] -> + stdio_handler(In, Out) + ; % There might be multiple requests in the buffer + process_remaining_requests(RemainingCodes, Out, MaxThreads), + stdio_handler(In, Out) + ) + ). + +% Process remaining requests in the buffer +process_remaining_requests(Codes, Out, MaxThreads) :- + ( phrase(lsp_metta_request(Req), Codes, RemainingCodes) -> + handle_parsed_request(Req, Out, MaxThreads), + ( RemainingCodes == [] -> + true + ; process_remaining_requests(RemainingCodes, Out, MaxThreads) + ) + ; % Could not parse a complete request, ignore or handle error + true + ). + + +% Read a complete message from the input stream +read_message(In, Codes) :- + read_header(In, ContentLength), + ( ContentLength = end_of_file -> + Codes = end_of_file + ; read_codes(In, ContentLength, Codes) + ). + +% Read the header to get Content-Length +read_header(In, ContentLength) :- + read_line_to_codes(In, HeaderCodes), + ( HeaderCodes == end_of_file -> + ContentLength = end_of_file + ; atom_codes(HeaderLine, HeaderCodes), + ( HeaderLine = '' -> + % Empty line, headers end + read_header(In, ContentLength) + ; split_string(HeaderLine, ": ", "", ["Content-Length", LengthStr]) -> + number_string(ContentLength, LengthStr), + % Read the blank line after headers + read_line_to_codes(In, _) + ; % Other headers, ignore + read_header(In, ContentLength) + ) + ). + +% Read the message body based on Content-Length +read_codes(In, ContentLength, Codes) :- + read_n_codes(In, ContentLength, Codes). + +% Helper to read N codes from input +read_n_codes(In, N, Codes) :- + ( N > 0 -> + get_code(In, C), + N1 is N - 1, + read_n_codes(In, N1, RestCodes), + Codes = [C|RestCodes] + ; Codes = [] + ). +*/ +% Handling requests from input stream + + % [TODO] add multithreading? Guess that will also need a message queue % to write to stdout -stdio_handler(Extra-ExtraTail, In, Out) :- +stdio_handler(Extra-ExtraTail, In, Out) :- wait_for_input([In], _, infinite), fill_buffer(In), read_pending_codes(In, ReadCodes, Tail), @@ -242,33 +247,39 @@ ). handle_requests(Out, InCodes, Tail) :- - handle_request(Out, InCodes, Rest), !, + phrase(lsp_metta_request(Req), InCodes, Rest), !, + handle_parsed_request(Out, Req), !, ( var(Rest) -> Tail = Rest ; handle_requests(Out, Rest, Tail) ). handle_requests(_, T, T). -% Handle parsed requests -handle_parsed_request(Req, Out) :- - ( Req.body.method == "$/cancelRequest" -> - handle_msg(Req.body.method, Req.body, _) % Handle cancel immediately - ; lsp_worker_threads(MaxThreads) - handle_request(Out, Req) - ; enqueue_task(lsp_task(Out, Req)) - ). - -% Enqueue an incoming LSP request to be handled by a worker -enqueue_task(Task) :- - message_queue_push(task_queue, Task). - +% Handle parsed requests +handle_parsed_request(Out, Req) :- + ( Req.body.method == "$/cancelRequest" -> + handle_msg(Req.body.method, Req.body, _) % Handle cancel immediately + ; lsp_worker_threads(0) -> + handle_request(Out, Req) + ; enqueue_task(lsp_task(Out, Req)) + ). + +% Enqueue an incoming LSP request to be handled by a worker +enqueue_task(Task) :- + message_queue_push('$lsp_task_queue', Task). + % general handling stuff -% Backtrace error handler +% Backtrace error handler catch_with_backtrace(Goal):- catch_with_backtrace(Goal,Err, - (debug(server(high), "error in ~n~n?- catch_with_backtrace(~q).~n~n handling msg:~n~n~@~n~n", [Goal, print_message(error, Err)]),throw(Err))). - + ( Err == canceled -> + throw(canceled) + ; ( debug(server(high), "Error in:\n\n?- catch_with_backtrace(~q).\n\nHandling message:\n\n~@~n\n", [Goal, print_message(error, Err)]), + throw(Err) + ) + ) + ). -% Send LSP message to client +% Send LSP message to client send_message(Stream, Msg) :- catch_with_backtrace(( put_dict(jsonrpc, Msg, "2.0", VersionedMsg), @@ -279,24 +290,23 @@ flush_output(Stream))). % Handle individual requests -handle_request(OutStream, Input, Rest) :- - phrase(lsp_metta_request(Req), Input, Rest), +handle_request(OutStream, Req) :- debug(server(high), "Request ~q", [Req.body]), catch( ( catch_with_backtrace(handle_msg(Req.body.method, Req.body, Resp)), - ignore((user:nodebug_lsp_response(Req.body.method) -> - debug(server(high),"response id: ~q",[Resp.id]); - debug(server(high),"response ~q",[Resp]))), + ignore((user:nodebug_lsp_response(Req.body.method) -> + debug(server(high),"response id: ~q",[Resp.id]); + debug(server(high),"response ~q",[Resp]))), ( is_dict(Resp) -> send_message(OutStream, Resp) ; true ) ), Err, - ( Err == canceled -> - throw(canceled) - ; ( debug(server, "error handling msg ~q", [Err]), + ( Err == canceled -> + throw(canceled) + ; ( debug(server, "error handling msg ~q", [Err]), get_dict(id, Req.body, Id), send_message(OutStream, _{id: Id, error: _{code: -32001, message: "server error"}}) - ) + ) )). % Hide responses for certain methods @@ -318,8 +328,8 @@ documentSymbolProvider: true, - workspaceSymbolProvider: true, % Workspace symbol provider - + workspaceSymbolProvider: true, % Workspace symbol provider + definitionProvider: true, declarationProvider: true, implementationProvider: true, @@ -558,19 +568,19 @@ handle_msg("$/setTrace", _Msg, false). -% Handle the $/cancelRequest Notification +% Handle the $/cancelRequest Notification handle_msg("$/cancelRequest", Msg, false) :- - _{params: _{id: CancelId}} :< Msg, - debug(server, "Cancel request received for ID ~w", [CancelId]), - with_mutex(request_mutex, - ( thread_request(CancelId, ThreadId) - -> % Attempt to interrupt the thread - debug(server, "Attempting to cancel thread ~w", [ThreadId]), - catch(thread_signal(ThreadId, throw(canceled)),_,true), % in case thread is already gone - ignore(retract(thread_request(CancelId, ThreadId))) % in case thread retracted it - ; ( debug(server, "No running thread found for request ID ~w", [CancelId]), - assert(id_was_canceled(CancelId)) ) - )). + _{params: _{id: CancelId}} :< Msg, + debug(server, "Cancel request received for ID ~w", [CancelId]), + with_mutex('$lsp_request_mutex', + ( thread_request(CancelId, ThreadId) + -> % Attempt to interrupt the thread + debug(server, "Attempting to cancel thread ~w", [ThreadId]), + catch(thread_signal(ThreadId, throw(canceled)),_,true), % in case thread is already gone + ignore(retract(thread_request(CancelId, ThreadId))) % in case thread retracted it + ; ( debug(server, "No running thread found for request ID ~w", [CancelId]), + assert(id_was_canceled(CancelId)) ) + )). % Handle the 'exit' notification handle_msg("exit", _Msg, false) :- @@ -651,10 +661,10 @@ % Replace with actual code execution logic % For demonstration, we'll just unify Result with Code % In practice, you might use metta:eval_string/2 or similar - Result = Code + eval(Code,CodeResult), + sformat(Result,"~w ; ~q",[Code,CodeResult]) ), Error, ( - format(atom(ErrorMsg), 'Error executing code: ~w', [Error]), - Result = ErrorMsg + sformat(Result,"~w ; Error: ~q",[Code,Error]) )). From 6ab069e80ef1614570ab4c855e28caecadcae008 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Fri, 18 Oct 2024 13:09:26 -0700 Subject: [PATCH 06/11] anonymous QueueId --- .../prolog/lsp_server_metta.pl | 66 +++++++++---------- 1 file changed, 33 insertions(+), 33 deletions(-) diff --git a/src/packs/lsp_server_metta/prolog/lsp_server_metta.pl b/src/packs/lsp_server_metta/prolog/lsp_server_metta.pl index 8415d428527..5ac12c36223 100644 --- a/src/packs/lsp_server_metta/prolog/lsp_server_metta.pl +++ b/src/packs/lsp_server_metta/prolog/lsp_server_metta.pl @@ -71,36 +71,32 @@ start_lsp_worker_threads:- lsp_worker_threads(MaxThreads), ( MaxThreads > 0 - -> create_worker_pool(MaxThreads) % Create thread pool if max threads > 1 + -> create_workers('$lsp_worker_pool', MaxThreads) % Create thread pool if max threads > 0 ; debug(server, "Running synchronously since max threads = 0", []) % Sync mode ). -% Create a pool of workers if using more than 0 -create_worker_pool(NumWorkers) :- NumWorkers < 1,!. -create_worker_pool(NumWorkers) :- - NumWorkersM1 is NumWorkers-1, - start_worker, - create_worker_pool(NumWorkersM1). +% Worker pool implementation +% Create a pool with Id and number of workers. +% After the pool is created, post_job/1 can be used to send jobs to the pool. -% Include necessary dynamic predicates +create_workers(Id, N) :- + message_queue_create(Id), + forall(between(1, N, _), + thread_create(do_work(Id), _, [])). + +% Dynamic predicates for cancellation mechanism :- dynamic thread_request/2. -:- dynamic worker_thread/1. :- dynamic id_was_canceled/1. % Create a mutex for synchronization -:- message_queue_create('$lsp_task_queue'). :- mutex_create('$lsp_request_mutex'). -% Start an individual worker -start_worker :- - thread_create(worker_loop, ThreadId, [detached(true)]), - assertz(worker_thread(ThreadId)). -% Update worker_loop to handle task cancellation -worker_loop :- +do_work(QueueId) :- + repeat, + thread_get_message(QueueId, Task), + ( Task = lsp_task(Out, Req) -> thread_self(ThreadId), - message_queue_pop('$lsp_task_queue', Task), - Task = lsp_task(Out, Req), ( get_dict(id, Req.body, RequestId) -> true ; RequestId = none ), @@ -121,8 +117,16 @@ retract(thread_request(RequestId, ThreadId)) ) ) + ) + ; % Handle other types of tasks if needed + true ), - worker_loop. + fail. + +% Post a job to be executed by one of the pool's workers. + +post_job(Id, Task) :- + thread_send_message(Id, Task). % Send a cancellation response if necessary send_cancellation_response(_OutStream, _RequestId) :- @@ -148,7 +152,7 @@ set_stream(In, tty(false)), set_stream(In, representation_errors(error)), start_lsp_worker_threads, - % handling UTF decoding in JSON parsing, but doing the auto-translation + % Handling UTF decoding in JSON parsing, but doing the auto-translation % causes Content-Length to be incorrect set_stream(In, encoding(octet)), current_output(Out), @@ -240,8 +244,7 @@ read_pending_codes(In, ReadCodes, Tail), ( Tail == [] -> true - ; ( current_output(Out), - ExtraTail = ReadCodes, + ; ( ExtraTail = ReadCodes, handle_requests(Out, Extra, Remainder), stdio_handler(Remainder-Tail, In, Out) ) ). @@ -260,14 +263,9 @@ handle_msg(Req.body.method, Req.body, _) % Handle cancel immediately ; lsp_worker_threads(0) -> handle_request(Out, Req) - ; enqueue_task(lsp_task(Out, Req)) + ; post_job('$lsp_worker_pool', lsp_task(Out, Req)) ). -% Enqueue an incoming LSP request to be handled by a worker -enqueue_task(Task) :- - message_queue_push('$lsp_task_queue', Task). - -% general handling stuff % Backtrace error handler catch_with_backtrace(Goal):- catch_with_backtrace(Goal,Err, @@ -295,8 +293,9 @@ catch( ( catch_with_backtrace(handle_msg(Req.body.method, Req.body, Resp)), ignore((user:nodebug_lsp_response(Req.body.method) -> - debug(server(high),"response id: ~q",[Resp.id]); - debug(server(high),"response ~q",[Resp]))), + debug(server(high), "response id: ~q", [Resp.id]) + ; debug(server(high), "response ~q", [Resp]) + )), ( is_dict(Resp) -> send_message(OutStream, Resp) ; true ) ), Err, ( Err == canceled -> @@ -576,10 +575,11 @@ ( thread_request(CancelId, ThreadId) -> % Attempt to interrupt the thread debug(server, "Attempting to cancel thread ~w", [ThreadId]), - catch(thread_signal(ThreadId, throw(canceled)),_,true), % in case thread is already gone - ignore(retract(thread_request(CancelId, ThreadId))) % in case thread retracted it + catch(thread_signal(ThreadId, throw(canceled)), _, true), % In case thread is already gone + ignore(retract(thread_request(CancelId, ThreadId))) % In case thread retracted it ; ( debug(server, "No running thread found for request ID ~w", [CancelId]), - assert(id_was_canceled(CancelId)) ) + assertz(id_was_canceled(CancelId)) + ) )). % Handle the 'exit' notification From 9fdbee36e4beebfb86d119d9682e45666cece475 Mon Sep 17 00:00:00 2001 From: MikeArchbold Date: Fri, 18 Oct 2024 16:10:55 -0700 Subject: [PATCH 07/11] add comments --- src/canary/metta_repl.pl | 755 ++++++++++++++++++++++++++++++++++----- 1 file changed, 673 insertions(+), 82 deletions(-) diff --git a/src/canary/metta_repl.pl b/src/canary/metta_repl.pl index 7e90ae116fd..31aed373cbe 100755 --- a/src/canary/metta_repl.pl +++ b/src/canary/metta_repl.pl @@ -1,11 +1,85 @@ +/* + * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpreter + * Description: This file is part of the source code for a transpiler designed to convert + * MeTTa language programs into Prolog, utilizing the SWI-Prolog compiler for + * optimizing and transforming function/logic programs. It handles different + * logical constructs and performs conversions between functions and predicates. + * + * Author: Douglas R. Miles + * Contact: logicmoo@gmail.com / dmiles@logicmoo.org + * License: LGPL + * Repository: https://github.com/trueagi-io/metta-wam + * https://github.com/logicmoo/hyperon-wam + * Created Date: 8/23/2023 + * Last Modified: $LastChangedDate$ # You will replace this with Git automation + * + * Usage: This file is a part of the transpiler that transforms MeTTa programs into Prolog. For details + * on how to contribute or use this project, please refer to the repository README or the project documentation. + * + * Contribution: Contributions are welcome! For contributing guidelines, please check the CONTRIBUTING.md + * file in the repository. + * + * Notes: + * - Ensure you have SWI-Prolog installed and properly configured to use this transpiler. + * - This project is under active development, and we welcome feedback and contributions. + * + * Acknowledgments: Special thanks to all contributors and the open source community for their support and contributions. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the + * distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS + * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; + * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. + */ + + +%********************************************************************************************* +% PROGRAM FUNCTION: Implements a REPL (Read-Eval-Print Loop) for the Mettalog interpreter, providing +% interactive execution, debugging, and command handling capabilities. +%********************************************************************************************* + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% IMPORTANT: DO NOT DELETE COMMENTED-OUT CODE AS IT MAY BE UN-COMMENTED AND USED +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % Directive to save history when the program halts. :- at_halt(save_history). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% In order to run some of the specialized commands below like "repl1" and "history_file_location" +% you must start the mettalog repl by entering "mettalog" and then enter Prolog mode by +% entering "Prolog." This gives you the '?-' swipl prompt. Then you can enter eg., "repl1." +% to execute the desired command (no quotes around any of these commands when actually entered). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %! history_file_location(-Filename) is det. % Determines the location of the REPL history file. -% On Linux, the history is stored in ~/.config/metta/repl_history.txt. +% On Linux, the history is stored in '~/.config/metta/repl_history.txt.' % @arg Filename will be the expanded path to the history file. +% +% @example Retrieve the history file location: +% ?- history_file_location(Filename). +% Filename = '/home/user/.config/metta/repl_history.txt'. +% history_file_location(Filename) :- % Expands the relative path to an absolute path. expand_file_name('~/.config/metta/repl_history.txt', [Filename]). @@ -14,6 +88,11 @@ %! check_directory_exists(+Dir) is det. % Ensures that a directory exists. If not, it will create it. % @arg Dir is the directory path to check. +% +% @example Ensure a directory exists: +% ?- check_directory_exists('/home/user/.config/metta'). +% true. +% check_directory_exists(''). % Base case for an empty string (root of directory tree). check_directory_exists('/'). @@ -36,12 +115,16 @@ % Ensures that the history file exists and can be appended to. % If the file does not exist, it will create the file and its directory. % @arg HistoryFile is the path to the file to be checked or created. +% +% @example Ensure a history file exists: +% ?- check_file_exists_for_append('/home/user/.config/metta/repl_history.txt'). +% true. +% check_file_exists_for_append(HistoryFile) :- % Check if the file exists and is accessible for appending. exists_file(HistoryFile), access_file(HistoryFile, append), !. - check_file_exists_for_append(HistoryFile) :- % If the file does not exist, ensure the directory exists. file_directory_name(HistoryFile, Dir), @@ -51,7 +134,6 @@ !, % Close the stream after creating the file. close(Stream). - check_file_exists_for_append(HistoryFile) :- % If the file cannot be created, print an error message and halt the program. write("Error opening history file: "), @@ -61,6 +143,11 @@ %! save_history is det. % Saves the current input history to a file if input is from a terminal (tty). % Uses el_write_history/2 to write the history. +% +% @example Save the current history: +% ?- save_history. +% true. +% save_history :- % Get the current input stream. current_input(Input), @@ -75,6 +162,11 @@ %! load_and_trim_history is det. % Loads and trims the REPL history if needed, and installs readline support. +% +% @example Load and trim the history: +% ?- load_and_trim_history. +% true. +% load_and_trim_history :- % Disable tracing for the following operations. notrace(( @@ -99,6 +191,11 @@ %! repl is det. % Starts the REPL (Read-Eval-Print Loop) using `catch/3` to handle end-of-input gracefully. % This ensures the REPL terminates without error when the end of input is reached. +% +% @example Start the REPL: +% ?- repl. +% metta> +% repl :- % Catch any end_of_input exception and terminate the REPL gracefully. catch(repl2, end_of_input, true). @@ -106,6 +203,11 @@ %! repl1 is det. % A higher-level REPL function that sets some options before starting the REPL process. % It uses `with_option/3` to set internal flags and then invokes `repl2/0`. +% +% @example Start the REPL with internal options: +% ?- repl1. +% metta> +% repl1 :- % Set the option 'doing_repl' to true. with_option('doing_repl', true, @@ -115,6 +217,11 @@ %! repl2 is nondet. % The main loop of the REPL, responsible for managing history, garbage collection, and catching any errors. % It continually prompts the user until an error occurs or input is exhausted. +% +% @example Start the REPL loop: +% ?- repl2. +% metta> +% repl2 :- % Load the REPL history and clean it up if necessary. load_and_trim_history, @@ -134,6 +241,11 @@ %! write_metta_prompt is det. % Writes the REPL prompt for the user, including the current mode and self-reference. % It uses the `flush_output/1` to ensure all output is displayed immediately. +% +% @example Display the REPL prompt: +% ?- write_metta_prompt. +% metta> +% write_metta_prompt :- % Ensure any pending output is flushed to the terminal. flush_output(current_output), @@ -141,7 +253,7 @@ format('~Nmetta', []), % Display the current REPL mode (e.g., normal, query). current_read_mode(repl, Mode), write(Mode), - % Display the current self reference, unless it's '&self'. + % Display the current self reference, unless it is '&self'. current_self(Self), (Self == '&self' -> true ; write(Self)), % Write the final '>' as the prompt and flush the output again. write('>'), flush_output(current_output). @@ -149,6 +261,11 @@ %! repl3 is det. % Prepares the REPL prompt and handles the user input in a safe way. % It manages the prompt display and ensures the terminal is properly set up. +% +% @example Set up the REPL prompt and call repl4: +% ?- repl3. +% metta> +% repl3 :- % Create the prompt by writing it to an atom `P`. with_output_to(atom(P), write_metta_prompt), @@ -165,6 +282,11 @@ %! repl4 is det. % Executes the REPL logic by reading the input, processing expressions, and handling directives or commands. % The loop is managed through exceptions (e.g., restarting or ending input). +% +% @example Execute the main REPL logic: +% ?- repl4. +% metta> +% repl4 :- % Reset the evaluation number to ensure expressions are counted properly. ((reset_eval_num, @@ -191,9 +313,31 @@ % Throw `restart_reading` to restart the REPL input process after execution. nop(notrace(throw(restart_reading))))),!. -%! check_has_directive(+V) is semidet. -% Checks if the expression `V` contains a directive and processes it. -% Various directives like 'log.', 'rust.', and assignments are recognized. +%! check_has_directive(+V) is semidet. +% +% Processes a given input `V` to determine if it contains a recognized directive +% and executes the associated logic. This predicate handles several types of directives, +% such as switching modes, assigning values, or invoking debugging utilities. +% +% This predicate fails if the input `V` is a variable or if no matching directive is found. +% +% Directives can take several forms: +% - Simple commands like `'log.'` or `'rust.'` that switch modes. +% - Assignments of the form `call(N=V)`. +% - Special debugging and REPL controls using `@` or other characters. +% +% @arg V The input term to be checked and processed. This can be a variable, +% an atom, or a more complex term like an assignment. +% +% @example +% % Example of switching to mettalog mode: +% ?- check_has_directive('log.'). +% % This switches the system to the mettalog mode. +% +% % Example of switching to mettarust mode: +% ?- check_has_directive('rust.'). +% % This switches the system to the mettarust mode. +% check_has_directive(V) :- var(V), !, fail. % Directive to switch to mettalog. check_has_directive('log.') :- switch_to_mettalog, !. @@ -218,19 +362,39 @@ % No directive found. check_has_directive(_). -%! set_directive(+N, +V) is det. -% Sets the value of a directive `N` to `V`. Handles specific cases like `mode` separately. +%! set_directive(+N, +V) is det. +% +% Assigns the value `V` to the directive `N`. Handles special cases such as +% REPL mode changes differently from general directives. +% +% @arg N The name of the directive to set. It can be a general option or +% a specific control like `mode`. +% @arg V The value to assign to the directive. +% +% @example +% % Set the REPL mode to 'debug': +% ?- set_directive('mode', 'debug'). +% +% % Assign a general option value: +% ?- set_directive('timeout', 100). +% set_directive(N, V) :- symbol_concat('@', NN, N), !, set_directive(NN, V). % Special case for setting the REPL mode. set_directive(N, V) :- N == 'mode', !, set_directive(repl_mode, V). % Set a general directive using `set_option_value_interp/2`. set_directive(N, V) :- show_call(set_option_value_interp(N, V)), !, notrace(throw(restart_reading)). - %! read_pending_white_codes(+In) is det. % Reads the pending codes (whitespace characters) from the input stream `In`. % Specifically, it looks for the newline character (ASCII 10). % This predicate ensures that the REPL input stream is properly cleaned up. +% +% @arg In The input stream from which to read pending whitespace codes. +% +% @example +% % Clean up the input stream by reading pending newlines: +% ?- read_pending_white_codes(user_input). +% read_pending_white_codes(In) :- % Read pending codes from the input stream, only considering ASCII 10 (newline). read_pending_codes(In, [10], []), @@ -240,8 +404,21 @@ read_pending_white_codes(_). %! call_for_term_variables4v(+Term, +X, -Result, -NamedVarsList, +TF) is det. -% Handles the term `Term` and determines the term's variable list and final result. +% Handles the term `Term` and determines the term variable list and final result. % This version handles the case when the term has no variables and converts it to a truth-functional form. +% +% @arg Term The input term to be analyzed. +% @arg X The list of variables found within the term. It can be empty or contain one variable. +% @arg Result The final result, either as the original term or transformed into a truth-functional form. +% @arg NamedVarsList The list of named variables associated with the term. +% @arg TF The truth-functional form when the term has no variables. +% +% @example +% % Example with no variables: +% ?- call_for_term_variables4v(foo, [], Result, Vars, true). +% Result = as_tf(foo, true), +% Vars = []. +% call_for_term_variables4v(Term, [], as_tf(Term, TF), NamedVarsList, TF) :- % Get global variable names for the term. get_global_varnames(NamedVarsList), @@ -255,6 +432,19 @@ %! balanced_parentheses(+Str) is semidet. % Checks if parentheses are balanced in a string or list of characters `Str`. % This version handles both string input and list input by converting the string to a list of characters. +% +% @arg Str A string or list of characters to check for balanced parentheses. +% +% @example +% ?- balanced_parentheses("(())"). +% true. +% +% ?- balanced_parentheses("(()"). +% false. +% +% ?- balanced_parentheses("text(with(parentheses))"). +% true. +% balanced_parentheses(Str) :- % If the input is a string, convert it to a list of characters. string(Str), @@ -267,6 +457,14 @@ %! balanced_parentheses(+Chars, +N) is semidet. % Recursive helper predicate to check if parentheses are balanced in a list of characters `Chars`. % The second argument `N` keeps track of the net balance of opening and closing parentheses. +% +% @arg Chars A list of characters to process for balanced parentheses. +% @arg N A count tracking the net balance of open and close parentheses. +% +% @example +% ?- balanced_parentheses(['(', ')', '(', ')'], 0). +% true. +% balanced_parentheses([], 0). % Increment count when encountering an opening parenthesis. balanced_parentheses(['('|T], N) :- N1 is N + 1, !, balanced_parentheses(T, N1). @@ -275,23 +473,98 @@ % Skip any characters that are not parentheses. balanced_parentheses([H|T], N) :- H \= '(', H \= ')', !, balanced_parentheses(T, N). -next_expr(ExprI,Expr):- ExprI==end_of_file,!, (comment_buffer(Expr);(Expr="")). -next_expr(ExprI,Expr):- ExprI=Expr. -repl_read(In,Expr):- repl_read_next(In,ExprI),next_expr(ExprI,Expr). -repl_read(Expr):- repl_read_next(ExprI),next_expr(ExprI,Expr). +%! next_expr(+ExprI, -Expr) is det. +% +% Processes the given expression and returns the next expression to be used. +% If `ExprI` is `end_of_file`, it attempts to retrieve a buffered comment or +% defaults to an empty string. Otherwise, it directly unifies `ExprI` with `Expr`. +% +% @arg ExprI The input expression, which may be `end_of_file`. +% @arg Expr The resulting expression to be used in further processing. +% +% @example +% % If ExprI is `end_of_file`, it tries to get a buffered comment or returns "". +% ?- next_expr(end_of_file, Expr). +% Expr = "". +% +next_expr(ExprI, Expr) :- + % If the input expression is `end_of_file`, handle it with a cut. + ExprI == end_of_file, !, + % Retrieve a buffered comment or default to an empty string. + (comment_buffer(Expr); (Expr = "")). +% If ExprI is not `end_of_file`, unify it directly with Expr. +next_expr(ExprI, Expr) :- ExprI = Expr. + +%! repl_read(+In, -Expr) is det. +% +% Reads an expression from the given input stream, processes it with +% `next_expr/2`, and returns the result. +% +% @arg In The input stream from which the expression is read. +% @arg Expr The resulting expression after reading and processing. +% +% @example +% % Open a file and read an expression from it. +% ?- open('input.txt', read, In), repl_read(In, Expr). +% Expr = some_expression. +% +repl_read(In, Expr) :- + % Read the next expression from the input stream. + repl_read_next(In, ExprI), + % Process it to determine the final expression. + next_expr(ExprI, Expr). + +%! repl_read(-Expr) is det. +% +% Reads an expression without a specific input stream, processes it with +% `next_expr/2`, and returns the result. +% +% @arg Expr The resulting expression after reading and processing. +% +% @example +% % Read an expression from the default input source. +% ?- repl_read(Expr). +% Expr = some_expression. +% +repl_read(Expr) :- + % Read the next expression. + repl_read_next(ExprI), + % Process it to determine the final expression. + next_expr(ExprI, Expr). % maybe Write any stored comments to the output? -comment_buffer(Comment):- retract(metta_file_comment(_Line, _Col, _CharPos, Comment, _Pos)). - +%! comment_buffer(-Comment) is semidet. +% +% Retrieves and removes a comment from the metta file comment buffer. +% It retracts a `metta_file_comment/5` fact and unifies its `Comment` field +% with the output argument. +% +% @arg Comment The comment retrieved from the buffer. +% +% @example +% % Assume a comment was previously stored in the buffer. +% ?- comment_buffer(Comment). +% Comment = 'This is a comment'. +% +comment_buffer(Comment) :- + % Retract a comment from the buffer and unify it with the output argument. + retract(metta_file_comment(_Line, _Col, _CharPos, Comment, _Pos)). -%! repl_read(+NewAccumulated, -Expr) is det. -% Reads and accumulates input until it forms a valid expression or detects an error. +%! repl_read_next(+NewAccumulated, -Expr) is det. +% +% Reads the next expression by interpreting the accumulated input. It handles +% special cases (such as symbols `'!'` and `'+'`), manages syntax errors, +% balances parentheses, and normalizes spaces in input. If an error occurs, +% the reading process may be restarted. +% +% @arg NewAccumulated The accumulated input to be processed. +% @arg Expr The resulting expression, or a specific symbol or mode indicator. % -% @arg NewAccumulated is the accumulated input string. -% @arg Expr is the resulting expression. % @example -% ?- repl_read("foo.", Expr). -% Expr = call(foo). +% % Read a valid metta expression from input. +% ?- repl_read_next("write(hello)", Expr). +% Expr = call(write(hello)). +% repl_read_next(NewAccumulated, Expr) :- % Concatenate the input with '.' and try to interpret it as an atom. symbol_concat(Atom,'.',NewAccumulated), @@ -299,7 +572,6 @@ catch_err((read_term_from_atom(Atom, Term, []), Expr = call(Term)), E, (((fail, write('Syntax error: '), writeq(E), nl, repl_read_next(Expr))))), !. - % Previously commented: repl_read_next(Str, Expr):- ((clause(t_l:s_reader_info(Expr),_,Ref),erase(Ref))). % Handle special case for '!' symbol. @@ -344,7 +616,21 @@ % Call repl_read_next with the new line concatenated to the accumulated input. repl_read_next(Accumulated, Line, Expr). -% Handle end-of-file input gracefully. +%! repl_read_next(+Accumulated, +Line, -Expr) is det. +% +% Handles reading input, including special cases such as end-of-file. +% Accumulates lines of input and processes them to form valid expressions. +% It gracefully manages EOF, concatenates input, and continues reading. +% +% @arg Accumulated The accumulated input so far. +% @arg Line The new line to be added to the accumulated input. +% @arg Expr The resulting expression or an indication of end-of-file. +% +% @example +% % Handle end-of-file input gracefully. +% ?- repl_read_next(_, end_of_file, Expr). +% Expr = end_of_file. +% repl_read_next(_, end_of_file, end_of_file) :- nop(writeln("")), notrace(throw(end_of_input)). % Continue reading if no input has been accumulated yet. @@ -374,10 +660,21 @@ % Stop the repeat loop if there are no more pending codes. ((peek_pending_codes(_, Peek), Peek == []) -> ! ; true). -% Adds the string Str to the input history. -%! add_history_string(+Str) is det. -% Adds a string to the REPL history if the input is coming from a terminal. -% @arg Str is the string to be added to the history. +%! add_history_string(+Str) is det. +% +% Adds a string to the REPL history if the input is coming from a terminal (TTY). +% This helps maintain a history of inputs, which can be useful for interactive +% sessions. +% +% If the input stream is not from a terminal, the predicate simply succeeds without +% taking any action. +% +% @arg Str The string to be added to the REPL history. +% +% @example Adding a string to history: +% ?- add_history_string("example query"). +% true. +% add_history_string(Str) :- % Check if the current input stream is from a terminal (tty). current_input(Input), @@ -388,18 +685,36 @@ % Otherwise, do nothing. true), !. -% Adds the executed source code Exec to the input history. %! add_history_src(+Exec) is det. % Adds the source code to the input history if the execution is non-empty. % @arg Exec is the executed code to be added to the history. +% +% @example Add executed code to history: +% ?- add_history_src([write('Hello'), nl]). +% true. +% +% @example No effect with empty code: +% ?- add_history_src([]). +% true. +% add_history_src(Exec) :- % Check if Exec is not empty, and if so, write it to the string H and add it to the history. notrace(ignore((Exec \= [], with_output_to(string(H), with_indents(false, write_src(Exec))), add_history_string(H)))). -% Handles adding evaluated terms to the history in specific cases. -%! add_history_pl(+Exec) is det. -% Adds evaluated terms to the input history unless they are variables or special cases. -% @arg Exec is the evaluated term to be added to the history. +%! add_history_pl(+Exec) is det. +% +% Adds evaluated terms to the REPL history unless they are variables or special cases. +% +% @arg Exec The evaluated term to be added to the history. +% +% @example Add a regular term to history: +% ?- add_history_pl(write('Hello')). +% true. +% +% @example Skip variables: +% ?- add_history_pl(_). +% true. +% add_history_pl(Exec) :- % If Exec is a variable, do nothing. var(Exec), !. @@ -427,10 +742,31 @@ % Directive to set a global variable for variable names. :- nb_setval(variable_names, []). -%! call_for_term_variables5(+Term, +DC, +Vars1, +Vars2, -CallTerm, -DCVars, -TF) is det. -% Processes term variables and generates a call for the term, handling specific cases for grounding and different variables. +%! call_for_term_variables5(+Term, +DC, +Vars1, +Vars2, -CallTerm, -DCVars, -TF) is det. +% +% Processes term variables and generates a call structure based on the provided term, +% handling cases with ground terms, single variables, and multiple variables. +% +% @arg Term The input term to process. +% @arg DC The direct constraints or variables list (can be empty). +% @arg Vars1 The first set of variables (e.g., `[Var=Value]` format). +% @arg Vars2 The second set of variables. +% @arg CallTerm The generated term call (e.g., `call_nth/2` or `as_tf/2`). +% @arg DCVars The combined list of variables or constraints. +% @arg TF The variable or value associated with the call. +% +% @example Handling a ground term: +% ?- call_for_term_variables5(hello, [], [], [], CallTerm, DCVars, TF). +% CallTerm = as_tf(hello, TF), +% DCVars = [], +% TF = _. +% +% @example Single variable case: +% ?- call_for_term_variables5(hello, [], [], [X=_], CallTerm, DCVars, TF). +% CallTerm = call_nth(hello, Count), +% DCVars = ['Count' = Count], +% TF = X. % - % If the term is ground, return the as_tf form. call_for_term_variables5(Term,[],[],[],as_tf(Term,TF),[],TF) :- ground(Term), !. % If the term is ground, create a call_nth with the term. @@ -446,32 +782,67 @@ % Handle case with more than one variable, generating a call_nth. call_for_term_variables5(Term,_,SVars,Vars,call_nth(Term,Count),[Vars,SVars],Count). -%! is_interactive(+From) is semidet. -% Checks if input is from an interactive source such as the REPL. - +%! is_interactive(+From) is semidet. +% +% Checks if the input source is interactive, such as the REPL or a terminal. +% This predicate delegates the check to an internal helper `is_interactive0/1`. +% +% @arg From The source to check, typically an input stream or context. +% +% @example Check if the source is interactive: +% ?- is_interactive(user_input). +% true. +% +% @example Handling non-interactive sources: +% ?- open('file.pl', read, In), is_interactive(In), close(In). +% false. +% % Delegate to the internal helper predicate. is_interactive(From) :- notrace(is_interactive0(From)). -% Internal helper for checking if the source is interactive. +%! is_interactive0(+From) is semidet. +% +% Internal helper to determine if the given input source is interactive. +% This predicate checks various cases, including symbolic streams, explicit flags, +% and properties of streams to decide whether the input is interactive (e.g., REPL). +% +% @arg From The source to evaluate, which could be a symbolic name, stream, or flag. +% +% @example Check if a symbolic source is interactive: +% ?- is_interactive0(repl_true). +% true. +% is_interactive0(From) :- - % Check if the source is repl_true, meaning it's interactive. + % Check if the source is repl_true, meaning it is interactive. From == repl_true, !. is_interactive0(From) :- - % If the source is false, it's not interactive. + % If the source is false, it is not interactive. From == false, !, fail. is_interactive0(From) :- - % Check if the source is symbolic and a stream that doesn't have a filename. + % Check if the source is symbolic and a stream that does not have a filename. symbolic(From), is_stream(From), !, \+ stream_property(From, filename(_)). is_interactive0(From) :- - % If the source is true, it's interactive. + % If the source is true, it is interactive. From = true, !. % ================================================== % Predicate to check and process assertions within terms. % ================================================== -%! inside_assert(+Var, -Result) is det. -% Processes and identifies terms that involve assertions, extracting information from them. +%! inside_assert(+Var, -Result) is det. +% +% Processes and identifies terms that involve assertions, extracting relevant information. +% This predicate recursively navigates through various term structures to determine if +% the term contains an assertion or related construct. +% +% @arg Var The input term or variable to be analyzed. +% @arg Result The processed result, potentially modified based on the term structure. +% +% @example +% % Process a term containing an assertion. +% ?- inside_assert(assert(foo), Result). +% Result = assert(foo). +% inside_assert(Var,Var) :- % If the variable is not a compound term, leave it unchanged. \+ compound(Var), !. @@ -503,8 +874,20 @@ % Predicate to retrieve the current reading mode (REPL or file). % ================================================== -%! current_read_mode(+Source, -Mode) is det. -% Retrieves the current mode based on whether the source is the REPL or a file. +%! current_read_mode(+Source, -Mode) is det. +% +% Retrieves the current reading mode based on the source, which can either be +% the REPL or a file. It checks the relevant settings and options to determine +% the mode, defaulting to `'+'` if no specific mode is set. +% +% @arg Source The source of the input, either `repl` or `file`. +% @arg Mode The mode retrieved, or `'+'` if no specific mode is set. +% +% @example +% % Retrieve the REPL mode, defaulting to '+' if unset. +% ?- current_read_mode(repl, Mode). +% Mode = '+'. +% current_read_mode(repl,Mode) :- % Retrieve the REPL mode from the options if set, otherwise default to '+'. ((option_value(repl_mode, Mode), Mode \== []) -> true; Mode = '+'), !. @@ -516,8 +899,15 @@ % Evaluates a Form and ensures all conditions in the form hold true. % Handles the case where the form is wrapped in `all/1`. % @arg Form is the form to be evaluated. +% +% @example +% % Evaluate a form wrapped in `all/1`. +% ?- eval(all(write(hello))). +% hello +% true. +% eval(all(Form)) :- - % Check that Form is instantiated (nonvar) and evaluate it as long as it's true. + % Check that Form is instantiated (nonvar) and evaluate it as long as it is true. nonvar(Form), !, forall(eval(Form),true). % Evaluate a form by calling do_metta/5 with the current Self context and display the output. eval(Form) :- @@ -532,6 +922,12 @@ % Evaluates a form and returns the output. % @arg Form is the input form to evaluate. % @arg Out is the output after evaluation. +% +% @example +% % Evaluate a form and retrieve the output. +% ?- eval(write(hello), Out). +% Out = some_output. +% eval(Form, Out) :- % Get the current self-reference. current_self(Self), @@ -543,6 +939,12 @@ % @arg Self is the current self-reference. % @arg Form is the input form to evaluate. % @arg Out is the output after evaluation. +% +% @example +% % Evaluate a form with the current self-reference and retrieve the output. +% ?- current_self(Self), eval(Self, write(hello), Out). +% Out = some_output. +% eval(Self, Form, Out) :- % Use eval_H with a timeout of 500 to evaluate the form. eval_H(500, Self, Form, Out). @@ -552,6 +954,12 @@ % @arg Self is the current self-reference. % @arg Form is the form to evaluate. % @arg OOut is the transformed output. +% +% @example +% % Evaluate a form and transform the output. +% ?- current_self(Self), eval_I(Self, write(hello), OOut). +% OOut = some_output. +% eval_I(Self, Form, OOut) :- % Evaluate the form with a timeout using eval_H. eval_H(500, Self, Form, Out), @@ -564,6 +972,16 @@ % Transforms the output by checking if it is a return value. % @arg Out is the initial output. % @arg OOut is the transformed output. +% +% @example +% % Transform a returned value. +% ?- xform_out(return_value, OOut). +% OOut = return_value. +% +% % Handle a non-return value. +% ?- xform_out(some_output, OOut). +% OOut = 'Empty'. +% xform_out(Out, OOut) :- % If the output is a returned value, pass it through unchanged. is_returned(Out), !, OOut = Out. @@ -580,14 +998,20 @@ %! name_vars0(+Equality) is det. % Helper predicate that assigns names to variables if necessary. % @arg Equality is a term containing variables. +% +% @example +% % Assign names to variables in an equality expression. +% ?- name_vars(X=Y). +% true. +% name_vars0(X=Y) :- % If X and Y are identical, do nothing. X == Y, !. % If X is a '$VAR', set the name. name_vars0(X='$VAR'(X)). -% Resets internal caches. %! reset_cache is det. +% Resets internal caches. % Placeholder for cache resetting logic. reset_cache. @@ -827,6 +1251,12 @@ % Attempts to assign variable V to the variable name N, if V is unbound. % % @arg N=V is the variable assignment term. +% +% @example +% % Attempt to assign a variable name. +% ?- maybe_assign(x=Var). +% Var = '$VAR'(x). +% maybe_assign(N=V):- ignore(V='$VAR'(N)). % Disable the debug mode for the 'metta(time)' predicate. @@ -836,6 +1266,15 @@ % % A query executor that retrieves terms from a knowledge base using 'query-info', computes variable intersections, % and evaluates the query Q against the term T in the context of a flybase. +% +% @example +% % Execute the query matching process. +% ?- mqd. +% Entity1 +% Entity2 +% ... +% true. +% mqd :- % Iterate over all metta_atom/3 calls that match the 'query-info' term. forall(metta_atom(_KB, ['query-info', E, T, Q]), @@ -851,17 +1290,30 @@ % Handles escape sequences for special keys. % % @arg O is the output character, transformed into an atom. +% +% @example +% % Read a single character and transform it into an atom. +% ?- get_single_char_key(O). +% O = a. +% get_single_char_key(O):- % Get the single character input. get_single_char(C), % Recursively read characters until a valid key is obtained. get_single_char_key(C, O). + %! get_single_char_key(+C, -A) is det. % % Handles special cases such as escape sequences for the arrow keys. % % @arg C is the character received. % @arg A is the resulting atom. +% +% @example +% % Handle escape sequence input. +% ?- get_single_char_key(27, esc(A, [27|Codes])). +% A = '\e[A', Codes = [91, 65]. +% get_single_char_key(27, esc(A,[27|O])):- !, % Read pending escape sequences and convert them to a name. @@ -921,13 +1373,28 @@ % Writes a variable, handling special cases like unbound or '$VAR'. % % @arg V is the variable to be written. +% +% @example +% % Write an unbound variable. +% ?- write_var(X). +% _G123 +% write_var(V):- var(V), !, write_dvar(V),!. % Write the unbound variable using a helper predicate. -write_var('$VAR'(S)):- !, write_dvar(S),!. % Handle Prolog's internal variable representation. +write_var('$VAR'(S)):- !, write_dvar(S),!. % Handle the Prolog internal variable representation. write_var(V):- write_dvar(V),!. % Default case: write the variable. %! print_var(+Name, +Var) is det. % -% Prints a variable assignment as Name = Var. +% Prints a variable assignment in the format `Name = Var`. +% +% @arg Name The name of the variable. +% @arg Var The value of the variable. +% +% @example +% % Print a variable assignment. +% ?- print_var(Name, 42). +% Name = 42 +% print_var(Name,Var):- % Print the variable name. write_var(Name), @@ -943,6 +1410,11 @@ % Writes a variable, skipping if it is 'Empty' and compatible with the environment. % % @arg Var is the variable to be written. +% +% @example +% % Write a variable unless it is 'Empty' in a compatible environment. +% ?- write_asrc(X). +% write_asrc(Var):- Var=='Empty',is_compatio,!. % Skip writing if the variable is 'Empty' in a compatible mode. write_asrc(Var):- write_bsrc(Var),!. % Otherwise, write the variable. @@ -951,9 +1423,28 @@ % Writes the value of a variable, handling ground terms and variables with goals. % % @arg Var is the variable to be written. +% +% @example +% % Write the value of a ground term. +% ?- write_bsrc(42). +% 42 +% write_bsrc(Var):- Var=='Empty',!,write(Var). % Special case: write 'Empty' directly. write_bsrc(Var):- ground(Var),!,write_bsrc1(Var). % If the variable is ground, write it directly. write_bsrc(Var):- copy_term(Var,Copy,Goals),Var=Copy,write_bsrc_goal(Var,Goals). % For non-ground terms, handle goals. + +%! write_bsrc_goal(+Var, +Goals) is det. +% +% Writes a variable along with its associated goals, if any. +% +% @arg Var The variable to be written. +% @arg Goals A list of goals associated with the variable. +% +% @example +% % Write a variable with goals. +% ?- write_bsrc_goal(Var, [goal1, goal2]). +% Var { goal1 goal2 } +% write_bsrc_goal(Var,[]):- write_src(Var). % Write the variable if no goals are present. write_bsrc_goal(Var,[G|Goals]):- % Write the variable. @@ -972,6 +1463,12 @@ % Writes the value of a variable (often not indenting it) % % @arg Var is the variable to be written. +% +% @example +% % Write a list of lists. +% ?- write_bsrc1([[1, 2], [3, 4]]). +% [[1,2],[3,4]] +% write_bsrc1(Var):- is_list(Var), member(E, Var), is_list(E), !, write_src(Var). write_bsrc1(Var):- write_src_woi(Var). @@ -980,6 +1477,12 @@ % Writes a goal with a preceding space. % % @arg Goal is the goal to be written. +% +% @example +% % Write a goal with a space before it. +% ?- write_src_space(goal1). +% goal1 +% write_src_space(Goal):- % Write a space before the goal. write(' '), @@ -988,11 +1491,11 @@ %! get_term_variables(+Term, -DontCaresN, -CSingletonsN, -CNonSingletonsN) is det. % -% Collects variables from a Prolog term, identifying don't-care variables, singletons, and non-singletons. +% Collects variables from a Prolog term, identifying do-not-care variables, singletons, and non-singletons. % It then maps these variables into named variable lists. % % @arg Term is the Prolog term whose variables are being analyzed. -% @arg DontCaresN is the list of don't-care variables (those represented by underscores). +% @arg DontCaresN is the list of do-not-care variables (those represented by underscores). % @arg CSingletonsN is the list of singleton variables (those that appear only once). % @arg CNonSingletonsN is the list of non-singleton variables (those that appear more than once). % @@ -1008,15 +1511,15 @@ writeqln(term_variables(Term, AllVars)=VNs), % Identify singleton variables in the term. term_singletons(Term, Singletons), - % Identify don't-care variables in the term. + % Identify do-not-care variables in the term. term_dont_cares(Term, DontCares), % Filter out singletons from the set of all variables. include(not_in_eq(Singletons), AllVars, NonSingletons), - % Remove don't-care variables from the non-singleton set. + % Remove do-not-care variables from the non-singleton set. include(not_in_eq(DontCares), NonSingletons, CNonSingletons), - % Remove don't-care variables from the singleton set. + % Remove do-not-care variables from the singleton set. include(not_in_eq(DontCares), Singletons, CSingletons), - % Map the don't-care, singleton, and non-singleton variables into named variable lists. + % Map the do-not-care, singleton, and non-singleton variables into named variable lists. maplist(into_named_vars, [DontCares, CSingletons, CNonSingletons], [DontCaresN, CSingletonsN, CNonSingletonsN]), % Log the final result. @@ -1025,10 +1528,16 @@ %! term_dont_cares(+Term, -DontCares) is det. % -% Finds the don't-care variables (those represented by underscores) in a term. +% Finds the do-not-care variables (those represented by underscores) in a term. % % @arg Term is the term to analyze. -% @arg DontCares is the list of don't-care variables in the term. +% @arg DontCares is the list of do-not-care variables in the term. +% +% @example +% % Find do-not-care variables in a term. +% ?- term_dont_cares(f(_, X, _), DontCares). +% DontCares = [_G123, _G124]. +% term_dont_cares(Term, DontCares) :- % Extract all variables from the term. term_variables(Term, AllVars), @@ -1036,7 +1545,7 @@ get_global_varnames(VNs), % Find variables that have sub-variables in the term. include(has_sub_var(AllVars), VNs, HVNs), - % Filter out underscore variables (don't-cares). + % Filter out underscore variables (do-not-cares). include(underscore_vars, HVNs, DontCareNs), % Extract the actual variable values from the named variables. maplist(arg(2), DontCareNs, DontCares). @@ -1069,6 +1578,12 @@ % % @arg AllVars is the list of variables to search in. % @arg Equality is the variable to check as a sub-variable. +% +% @example +% % Check if a variable is a sub-variable of another. +% ?- has_sub_var([X, Y], X=Z). +% true. +% has_sub_var(AllVars,_=V):- % Check if V is a sub-variable of any variable in AllVars. sub_var(V,AllVars). @@ -1076,9 +1591,15 @@ %! underscore_vars(+Var) is semidet. % -% Succeeds if the variable or name represents a don't-care variable (underscore). +% Succeeds if the variable or name represents a do-not-care variable (underscore). % % @arg Var is the variable or name to check. +% +% @example +% % Check if a variable is a do-not-care variable. +% ?- underscore_vars('_G123'). +% true. +% underscore_vars(V):- % If V is a variable, retrieve its name and check if it is an underscore variable. var(V),!, @@ -1099,6 +1620,12 @@ % Retrieves the global list of variable names. % % @arg VNs is the list of variable names in the current context. +% +% @example +% % Retrieve the global variable names. +% ?- get_global_varnames(VNs). +% VNs = [X, Y]. +% get_global_varnames(VNs):- % If there are variable names in nb_current, use them. nb_current('variable_names',VNs),VNs\==[],!. @@ -1112,6 +1639,12 @@ % Conditionally sets the variable names if the list is not empty. % % @arg List is the list of variable names. +% +% @example +% % Set a list of variable names if it is non-empty. +% ?- maybe_set_var_names([X, Y]). +% true. +% maybe_set_var_names(List):- % If the list is empty, do nothing. List==[],!. @@ -1128,6 +1661,12 @@ % % @arg V is the input variable. % @arg EqualityPair is the resulting named variable pair. +% +% @example +% % Map a variable to its named pair. +% ?- X = some_value, name_for_var_vn(X, Pair). +% Pair = N = some_value. +% name_for_var_vn(V,N=V):- % Retrieve the name for the variable V. name_for_var(V,N). @@ -1139,6 +1678,12 @@ % % @arg V is the variable whose name is being retrieved. % @arg N is the name corresponding to V. +% +% @example +% % Retrieve the name for a variable from global names. +% ?- nb_linkval(variable_names, ['X'=X]), name_for_var(X, N). +% N = 'X'. +% name_for_var(V,N):- % If V is a variable, check the global variable names. var(V),!, @@ -1184,6 +1729,12 @@ % Attempts to execute the goal G, but if an existence error is encountered, it switches to tracing and retries G. % % @arg G is the goal to execute. +% +% @example +% % Demonstrate retrying a goal on existence error with tracing. +% ?- rtrace_on_existence_error(nonexistent_predicate). +% ERROR: existence_error ... +% rtrace_on_existence_error(G):- % Catch any existence errors, log them, and retry G with tracing enabled. !, catch_err(G, E, (fbug(E = G), \+ tracing, trace, rtrace(G))). @@ -1194,6 +1745,12 @@ % Runs the goal if tracing is enabled for Prolog operations. % % @arg Goal is the Prolog goal to execute. +% +% @example +% % Run a goal only if Prolog tracing is enabled. +% ?- prolog_only(write('Tracing enabled for Prolog')). +% Tracing enabled for Prolog +% prolog_only(Goal):- % If Prolog tracing is enabled, run the goal. if_trace(prolog, Goal). @@ -1205,32 +1762,66 @@ % % @arg Exec is the compiled execution result. % @arg Goal is the goal being compiled and executed. +% +% @example +% % Compile and print the result of a goal. +% ?- write_compiled_exec(Result, my_goal). +% #114411: answer2(Result) :- my_goal +% write_compiled_exec(Exec, Goal):- % Compile the goal for execution and store the result in Res. compile_for_exec(Res, Exec, Goal), % Print the compiled goal with formatting. notrace((color_g_mesg('#114411', print_pl_source(answer2(Res) :- Goal)))). - %! verbose_unify(+Term) is det. -%! verbose_unify(+What, +Term) is det. % -% Activates verbose unification mode for variables in the term, optionally specifying a tracing context. +% Activates verbose unification mode for variables in the given term. If no +% specific trace context is provided, it defaults to 'trace'. % -% @arg What specifies the trace context for verbose unification. -% @arg Term is the term whose variables will be traced. -verbose_unify(Term):- - % Default to 'trace' for verbose unification if no context is provided. +% @arg Term The term whose variables will be traced. +% +% @example +% % Enable verbose unification on a term. +% ?- verbose_unify(X + Y). +% true. +% +verbose_unify(Term) :- + % Default to 'trace' context for verbose unification. verbose_unify(trace, Term). -% Apply verbose unification to all variables in the term with a specified context. -verbose_unify(What, Term):- - % Extract variables from the term and apply verbose_unify0 to each variable. - term_variables(Term, Vars), maplist(verbose_unify0(What), Vars), !. +%! verbose_unify(+What, +Term) is det. +% +% Activates verbose unification mode for variables in the term with the specified context. +% +% @arg What The trace context for verbose unification. +% @arg Term The term whose variables will be traced. +% +% @example +% % Enable verbose unification with a custom context. +% ?- verbose_unify(my_trace, X + Y). +% true. +% +verbose_unify(What, Term) :- + % Extract variables from the term and apply `verbose_unify0` to each. + term_variables(Term, Vars), + maplist(verbose_unify0(What), Vars), + !. -% Applies verbose unification to individual variables. -verbose_unify0(What, Var):- - % Assign the 'verbose_unify' attribute to the variable. +%! verbose_unify0(+What, +Var) is det. +% +% Applies verbose unification to individual variables by assigning the `verbose_unify` attribute. +% +% @arg What The trace context for verbose unification. +% @arg Var The variable to which the attribute will be assigned. +% +% @example +% % Assign the 'verbose_unify' attribute to a variable. +% ?- verbose_unify0(trace, X). +% true. +% +verbose_unify0(What, Var) :- + % Set the 'verbose_unify' attribute for the variable. put_attr(Var, verbose_unify, What). % Attribute unification hook for verbose_unify, logs when variables are unified. @@ -1373,7 +1964,7 @@ %! el_wrap_metta(+Input) is det. % -% Wraps the input stream in editline (or readline) for use with mettalog, if it's a TTY (terminal). +% Wraps the input stream in editline (or readline) for use with mettalog, if it is a TTY (terminal). % % @arg Input is the input stream to be wrapped. % @@ -1438,7 +2029,7 @@ %! install_readline(+Input) is det. % % Installs readline functionality for the input stream, providing useful editing commands and history. -% This predicate configures Prolog's input stream to support terminal history and command completion using the editline library. +% This predicate configures the Prolog input stream to support terminal history and command completion using the editline library. % % @arg Input is the input stream for which readline features should be installed. % @@ -1467,7 +2058,7 @@ %nop(catch(load_history,_,true)), % Unwrap the Prolog input wrapper, so that the custom readline features can be used. ignore(el_unwrap(Input)), - % Wrap the input with Metta's own readline handler. + % Wrap the input with the Metta readline handler. ignore(el_wrap_metta(Input)), % Load command history from a file, if it exists. history_file_location(HistoryFile), @@ -1504,7 +2095,7 @@ setup_done, % Check if setup has already been done. !. % Cut to prevent further execution if setup_done is true. -% If setup_done isn't true, assert it and continue with the installation process. +% If setup_done is not true, assert it and continue with the installation process. install_readline_editline1 :- asserta(setup_done). % Assert that setup is now complete. @@ -1519,7 +2110,7 @@ % init_debug_flags, % Initialize debugging flags. % start_pldoc, % Start the Prolog documentation server (pldoc). % opt_attach_packs, % Attach optional packs (libraries). -% load_init_file, % Load the user's initialization file. +% load_init_file, % Load the user initialization file. % catch(setup_backtrace, E1, print_message(warning, E1)), % Setup backtrace handling, catching errors. % %catch(setup_readline, E2, print_message(warning, E2)), % Setup readline, previously caught and skipped. % %catch(setup_history, E3, print_message(warning, E3)), % Setup history management, previously skipped. From 68152f0309f21c4e2ce242a02150667a39563dd8 Mon Sep 17 00:00:00 2001 From: MikeArchbold Date: Fri, 18 Oct 2024 16:14:20 -0700 Subject: [PATCH 08/11] add comments --- src/canary/metta_repl.pl | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/canary/metta_repl.pl b/src/canary/metta_repl.pl index 31aed373cbe..7f6803f8247 100755 --- a/src/canary/metta_repl.pl +++ b/src/canary/metta_repl.pl @@ -313,7 +313,7 @@ % Throw `restart_reading` to restart the REPL input process after execution. nop(notrace(throw(restart_reading))))),!. -%! check_has_directive(+V) is semidet. +%! check_has_directive(+V) is nondet. % % Processes a given input `V` to determine if it contains a recognized directive % and executes the associated logic. This predicate handles several types of directives, @@ -429,7 +429,7 @@ % Get global variable names for the term. get_global_varnames(NamedVarsList). -%! balanced_parentheses(+Str) is semidet. +%! balanced_parentheses(+Str) is nondet. % Checks if parentheses are balanced in a string or list of characters `Str`. % This version handles both string input and list input by converting the string to a list of characters. % @@ -454,7 +454,7 @@ % If input is already a list of characters, check the balance starting at count 0. balanced_parentheses(Chars) :- balanced_parentheses(Chars, 0). -%! balanced_parentheses(+Chars, +N) is semidet. +%! balanced_parentheses(+Chars, +N) is nondet. % Recursive helper predicate to check if parentheses are balanced in a list of characters `Chars`. % The second argument `N` keeps track of the net balance of opening and closing parentheses. % @@ -533,7 +533,7 @@ next_expr(ExprI, Expr). % maybe Write any stored comments to the output? -%! comment_buffer(-Comment) is semidet. +%! comment_buffer(-Comment) is nondet. % % Retrieves and removes a comment from the metta file comment buffer. % It retracts a `metta_file_comment/5` fact and unifies its `Comment` field @@ -782,7 +782,7 @@ % Handle case with more than one variable, generating a call_nth. call_for_term_variables5(Term,_,SVars,Vars,call_nth(Term,Count),[Vars,SVars],Count). -%! is_interactive(+From) is semidet. +%! is_interactive(+From) is nondet. % % Checks if the input source is interactive, such as the REPL or a terminal. % This predicate delegates the check to an internal helper `is_interactive0/1`. @@ -800,7 +800,7 @@ % Delegate to the internal helper predicate. is_interactive(From) :- notrace(is_interactive0(From)). -%! is_interactive0(+From) is semidet. +%! is_interactive0(+From) is nondet. % % Internal helper to determine if the given input source is interactive. % This predicate checks various cases, including symbolic streams, explicit flags, @@ -1572,7 +1572,7 @@ into_named_vars(VVs,L). -%! has_sub_var(+AllVars, +Equality) is semidet. +%! has_sub_var(+AllVars, +Equality) is nondet. % % Succeeds if V is a sub-variable of any of the variables in AllVars. % @@ -1589,7 +1589,7 @@ sub_var(V,AllVars). -%! underscore_vars(+Var) is semidet. +%! underscore_vars(+Var) is nondet. % % Succeeds if the variable or name represents a do-not-care variable (underscore). % @@ -1695,7 +1695,7 @@ % Convert the variable V to an atom representing its name. term_to_atom(V,N),!. -%! really_trace is semidet. +%! really_trace is nondet. % % Activates tracing if 'exec' or 'eval' tracing options are enabled, or if debugging is enabled for exec or eval. % Used as a helper to conditionally invoke tracing logic. @@ -1724,7 +1724,7 @@ with_debug((e), with_debug((exec), Goal)). -%! rtrace_on_existence_error(:G) is semidet. +%! rtrace_on_existence_error(:G) is nondet. % % Attempts to execute the goal G, but if an existence error is encountered, it switches to tracing and retries G. % @@ -1740,7 +1740,7 @@ !, catch_err(G, E, (fbug(E = G), \+ tracing, trace, rtrace(G))). -%! prolog_only(:Goal) is semidet. +%! prolog_only(:Goal) is nondet. % % Runs the goal if tracing is enabled for Prolog operations. % From 486afbf044a8993f90d36ed243626712e2694046 Mon Sep 17 00:00:00 2001 From: MikeArchbold Date: Fri, 18 Oct 2024 16:32:32 -0700 Subject: [PATCH 09/11] add comments --- src/canary/metta_repl.pl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/canary/metta_repl.pl b/src/canary/metta_repl.pl index 7f6803f8247..97778b660b7 100755 --- a/src/canary/metta_repl.pl +++ b/src/canary/metta_repl.pl @@ -429,7 +429,7 @@ % Get global variable names for the term. get_global_varnames(NamedVarsList). -%! balanced_parentheses(+Str) is nondet. +%! balanced_parentheses(+Str) is semidet. % Checks if parentheses are balanced in a string or list of characters `Str`. % This version handles both string input and list input by converting the string to a list of characters. % @@ -454,7 +454,7 @@ % If input is already a list of characters, check the balance starting at count 0. balanced_parentheses(Chars) :- balanced_parentheses(Chars, 0). -%! balanced_parentheses(+Chars, +N) is nondet. +%! balanced_parentheses(+Chars, +N) is semidet. % Recursive helper predicate to check if parentheses are balanced in a list of characters `Chars`. % The second argument `N` keeps track of the net balance of opening and closing parentheses. % From 083e0f70dd7580dca9558a22af6e1dfda7c92dc3 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sat, 19 Oct 2024 02:27:55 -0700 Subject: [PATCH 10/11] @doc for Bool --- src/canary/stdlib_mettalog.metta | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/canary/stdlib_mettalog.metta b/src/canary/stdlib_mettalog.metta index f47818a0be3..69f4af0ec3b 100644 --- a/src/canary/stdlib_mettalog.metta +++ b/src/canary/stdlib_mettalog.metta @@ -1,6 +1,7 @@ (: Any Type) (: Atom Type) (: Bool Type) +(@doc Bool (@desc "Boolean type of True or False.")) (: Expression Type) (: Number Type) (: hyperon::space::DynSpace Type) @@ -8,6 +9,8 @@ (: Symbol Type) (: StateMonad Type) (: Type Type) +(: True Bool) +(: False Bool) (: %Undefined% Type) (: Variable Type) ; (: if-decons (-> Atom Variable Variable Atom Atom Atom)) was a misnamed if-decons-expr From 1a44e536ff939e20dc923c2d967e52c3d2a24a26 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sat, 19 Oct 2024 02:28:25 -0700 Subject: [PATCH 11/11] Group declarations by type --- .../prolog/lsp_metta_outline.pl | 103 ++++++++++++------ 1 file changed, 69 insertions(+), 34 deletions(-) diff --git a/src/packs/lsp_server_metta/prolog/lsp_metta_outline.pl b/src/packs/lsp_server_metta/prolog/lsp_metta_outline.pl index 912d4c21302..9fbf241e191 100644 --- a/src/packs/lsp_server_metta/prolog/lsp_metta_outline.pl +++ b/src/packs/lsp_server_metta/prolog/lsp_metta_outline.pl @@ -289,6 +289,10 @@ banner_for(Type,Target):- format('~N```~n---~n ## ~w: ~w ~n```lisp~n',[Type, Target]). lsp_separator():- format('~N```~n---~n```lisp~n',[]). +show_checked(Name, Value, Caption) :- fail, + format("[~w](file:command:myExtension.toggleValue?{\"name\":\"~w\",\"value\":\"~w\"}) ~w ", [Value, Name, Value, Caption]). +show_checked(Name, Value, Caption) :- format("[~w](file://toggleValue_~w.metta) ~w ", [Value, Name, Caption]). + %! grovel_some_help(+Target, +Arity) is det. @@ -302,7 +306,7 @@ forall(member(RefType,[definition,declaration,typeDefinition,implementation,references]), (banner_for(RefType,Target), %ignore((defined_at(Type, HintPath, Target, Clause,Path,Loc), - forall(member(each_type_at(Target,Type,Clause,Path,Loc),Sort), + forall(member(each_type_at(Target,Clause,Path,Loc,Type),Sort), ignore(( once(type_expand(RefType,Type)), write_src_xref(Clause,Type,Path,Loc),nl))))), @@ -313,29 +317,61 @@ grovel_some_help(Target, Arity):- number(Arity), Arity > 1, findall(A, is_documented_arity(Target, A), ArityDoc), % Retrieve documented arities for the term. ArityDoc \== [], % Ensure the documentation is not empty. - \+ memberchk(Arity, ArityDoc), % Verify if the term's arity DOES NOT matches the documented arity. - + \+ memberchk(Arity, ArityDoc), % Verify if the term's arity DOES NOT matches the documented arity. format('Arity expected: ~w vs ~w~n', [ArityDoc, Arity]),lsp_separator() . % Output a message if there's an arity mismatch. + grovel_some_help(Target, _) :- - each_type_at_sorted(Target, Type,Clause,Path,Loc), - format('~@', [write_src_xref(Clause,Type,Path,Loc)]). % Write the source cross-reference for the atom. + format("~n```~n",[]), + show_checked("show_docs","(-)","Show Docs "), + show_checked("show_refs","(+)","Show Refs "), + show_checked("show_menu","(+)","Show Menu "), + format("for: ~w", [Target]), + format("~n```~n",[]). + +grovel_some_help(Target, _) :- + each_type_at_sorted(Target,Clause,Path,Loc,Type), + write_src_xref(Clause,Type,Path,Loc). % Write the source cross-reference for the atom. %xref_call(G):- catch(G,E,debug(server(high), "xref_call ~w", [G])). %xref_call(G):- catch(with_no_debug(G),E,debug(server(high), "xref_call ~w", [G->E])). xref_call(G):- with_no_debug(G). %xref_call(G):- call(G). -each_type_at_sorted(Target,Type,Clause,Path,Loc):- +each_type_at_sorted(Target,Clause,Path,Loc,Type):- each_type_at_sorted(Target, Sort), - member(each_type_at(Target,Type,Clause,Path,Loc),Sort). + member(each_type_at(Target,Clause,Path,Loc,Type),Sort). each_type_at_sorted(Target, Sort):- - findall(each_type_at(Target,Type,Clause,Path,Loc), - each_type_at(Target,Type,Clause,Path,Loc), + findall(each_type_at(Target,Clause,Path,Loc,Type), + each_type_at(Target,Clause,Path,Loc,Type), List), - sort(List,Sort). - -each_type_at(Target,Type,Clause,Path,Loc):- + group_by_last_arg(List,Sort). + +%% group_by_last_arg(+Terms, -SortedList) is det. +% This predicate groups terms by their last argument, sorts the groups by the last argument, +% and preserves the original order of terms within each group. +group_by_last_arg(TermL, SortedList) :- + list_to_set(TermL, Terms), + % Find all unique group keys (last argument of each term) + findall(GroupKey, (member(Term, Terms), functor(Term, _, Arity), arg(Arity, Term, GroupKey)), GroupKeysUnsorted), + % Sort group keys lexicographically (to define group order) + sort(GroupKeysUnsorted, GroupKeys), + % Group terms by their last argument (group key) without sorting the terms inside each group + findall(Group, + (member(GroupKey, GroupKeys), + include(is_in_group(GroupKey), Terms, Group)), + SortedGroups), + % Flatten the sorted groups into a single list + append(SortedGroups, SortedList). +% is_in_group(+GroupKey, +Term) +% Helper predicate to check if Term belongs to the specified GroupKey +is_in_group(GroupKey, Term) :- + functor(Term, _, Arity), + arg(Arity, Term, GroupKey). + + + +each_type_at(Target,Clause,Path,Loc,Type):- no_repeats_var(ClauseV), metta_atom_xref(Clause, Path, Loc), ClauseV = Clause, % Cross-reference the term with known atoms. about_term(Clause, Target), % Determine if the atom is related to the term. @@ -377,9 +413,12 @@ % Outputs source code or its reference based on the nesting of the source. % % @arg Src The source code or reference to output. -write_src_xref_oneloc(Src):- - write_src_xref(Src), - maybe_link_xref(Src). +write_src_xref(Src):- % fail, + very_nested_src(Src), % Check if the source is complex. + write_src_wi(Src), !. % Write the full source content if it's complex. +write_src_xref(Src):- + write_src_woi(Src). % Otherwise, write the source content without additional information. + write_src_xref(Clause,Type,Path,Loc):- catch_skip((write_src_xref(Clause), @@ -391,16 +430,12 @@ catch_skip(G):- ignore(catch(G,_,true)). -write_src_xref(Src):- % fail, - very_nested_src(Src), !, % Check if the source is complex. - wots(S, pp_sexi_l(Src)), write(S). % Write the full source content if it's complex. -write_src_xref(Src):- - write_src_woi(Src). % Otherwise, write the source content without additional information. % Check for deeply nested lists very_nested_src([_, _ | Src]):- is_list(Src), member(M, Src), is_list(M), - member(E, M), is_list(E), + member(E, M), is_list(E), member(I, E), is_list(I), !. + maybe_link_xref(What):- ignore(once(( metta_file_buffer(_,Atom,_,Path,Pos), @@ -920,9 +955,9 @@ op_type(_,Op):- \+ atom(Op),!,fail. op_type(import,Op):- import_op(Op). -op_type(var,'bind!'). op_type(var,'pragma!'). op_type(decl(doc),'@doc'). -op_type(assert,Op):- atom_concat(assert,_,Op). -op_type(decl(=),'='). op_type(decl(type),':'). op_type(decl(type),':<'). +op_type(decl(use),'bind!'). op_type(decl(use),'pragma!'). op_type(decl(doc),'@doc'). +op_type(ref_assert,Op):- atom_concat(assert,_,Op). +op_type(decl(impl),'='). op_type(decl(ftype),':'). op_type(decl(ftype),':<'). import_op(Op):- \+ atom(Op),!,fail. import_op(Op):- atom_contains(Op,"include"). @@ -1085,7 +1120,7 @@ metta_caller(CallerLine, By). metta_caller(Clause, Symbol):- is_definition(decl(_),Symbol,Clause). -metta_callee(Clause, Symbol):- is_definition(ref ,Symbol,Clause). +metta_callee(Clause, Symbol):- is_definition(ref(_) ,Symbol,Clause). into_op_head_body(Clause,Op,Head,Body):- var(Clause),!,freeze(into_op_head_body(Clause,Op,Head,Body)). into_op_head_body(exec(List),Op,Head,Body):- !, into_op_head_body_exec(List,Op,Head,Body). @@ -1121,10 +1156,10 @@ split_head([Fun|Rest],Fun,Rest):- is_list(Rest),!. split_head(Head,Head,[]). -type_op_head_rest_body(var, Symbol, Op,_Head,_Rest, Body):- op_type(import,Op), sub_symbol(Symbol,Body). -type_op_head_rest_body(ref, Symbol, Op, Head,_Rest,_Body):- op_type(import,Op), !, sub_symbol(Symbol,Head). +type_op_head_rest_body(decl(use), Symbol, Op,_Head,_Rest, Body):- op_type(import,Op), sub_symbol(Symbol,Body). +type_op_head_rest_body(ref(a), Symbol, Op, Head,_Rest,_Body):- op_type(import,Op), !, sub_symbol(Symbol,Head). -type_op_head_rest_body(ref, Symbol,_Op,_Head, Rest, Body):- not_promiscuous(Symbol),sub_symbol(Symbol,[Body, Rest]). +type_op_head_rest_body(ref(a), Symbol,_Op,_Head, Rest, Body):- not_promiscuous(Symbol),sub_symbol(Symbol,[Body, Rest]). type_op_head_rest_body(Type,Symbol, Op, Head,_Rest,_Body):- op_type(Type,Op),!,sub_symbol(Symbol,Head). not_promiscuous(Symbol):- var(Symbol), !, freeze(Symbol,not_promiscuous(Symbol)). @@ -1139,7 +1174,7 @@ sub_symbol(Symbol,Head):- sub_term(Symbol,Head),!. xref_defined(Path, Target, Ref):- - xref_defined(Type, Target, Path, Ref), Type\==ref. + xref_defined(Type, Target, Path, Ref), Type\=ref(_). xref_defined(Type, Target, Path, Ref):- xref_defined(Type, Target, _Clause, Path, Ref). @@ -1152,10 +1187,10 @@ type_expand(Var,Var):- var(Var),!. type_expand(definition,RefType):- member(RefType, [decl(_)]). -type_expand(declaration,RefType):- member(RefType, [var]). -type_expand(references,RefType):- member(RefType, [ref]). -type_expand(typeDefinition,RefType):- member(RefType, [decl(type)]). -type_expand(implementation,RefType):- member(RefType, [decl(_),var]). +type_expand(declaration,RefType):- member(RefType, [decl(use)]). +type_expand(references,RefType):- member(RefType, [ref(_)]). +type_expand(typeDefinition,RefType):- member(RefType, [decl(ftype)]). +type_expand(implementation,RefType):- member(RefType, [decl(_),decl(use)]). % textDocument/declaration: returns the specific location of the symbol's type declaration, which can include its function definition, symbol definition, etc. Since only one location can be returned, the system chooses the most relevant type declaration for the symbol. % textDocument/implementation: returns a list of specific locations where the symbol is implemented. Additionally, it includes the locations returned by both textDocument/definition and textDocument/declaration, showing the full picture of where the symbol is implemented and its type associations. @@ -1168,7 +1203,7 @@ xref_mettalog(HintPath), name_callable(NameArity, Target), each_type_at_sorted(Target, Sort),!, - member(each_type_at(Target,Type, Clause, Path, Ref),Sort), + member(each_type_at(Target,Clause, Path, Ref, Type),Sort), once(type_expand(RefType,Type)), atom_concat('file://', Path, Doc), once(relative_ref_location(Doc, Clause, Ref, Location)).