From 65bd7f9dd3a8f789a1854bf1e65c35d20614f1d5 Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 23 Aug 2024 10:41:33 -0500 Subject: [PATCH 01/77] have ci.yml & run_commit_tests.sh install mettalog and run tests --- .github/workflows/ci.yml | 4 +++- scripts/run_commit_tests.sh | 16 +++++++++++----- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index b70a5e2f36a..41d49fdab3b 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -26,8 +26,10 @@ jobs: with: python-version: '3.x' - - name: Install junit2html + - name: Install python packages run: | + pip install ansi2html + pip install hyperon pip install junit2html - name: Make Shell Script Executable diff --git a/scripts/run_commit_tests.sh b/scripts/run_commit_tests.sh index ae0e0a22c9f..2945d9de2f0 100755 --- a/scripts/run_commit_tests.sh +++ b/scripts/run_commit_tests.sh @@ -1,8 +1,14 @@ #!/bin/bash +set -e # stop if any step fails -# This script generates the input file used by the Python script. -# Replace the following lines with the actual commands to generate the input file. +# install mettalog +chmod +x INSTALL.sh # Make sure the script is executable +. ./INSTALL.sh --easy -#echo "| ANTI-REGRESSION.BC-COMP.01 | PASS |(https://example.com/test-report) | (assertEqualToResult (add-atom &kb (: axiom (nums 2 3)))) | (()) | (()) |" > /tmp/SHARED.UNITS -cat ./reports/SHARED.UNITS.PREV.md > /tmp/SHARED.UNITS -# You can add more lines or commands to generate additional input data +# generate the output directory with timestamp +timestamp=$(date +"%Y-%m-%dT%H:%M:%S") +output=reports/tests_output/baseline-compat-$timestamp/ + +# run the tests +echo Running baseline_compat tests to $output +mettalog --output=$output tests/baseline_compat > /dev/null 2>&1 From 007bd6349c83060806339793bd68712f5a0e4cc4 Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 23 Aug 2024 11:03:56 -0500 Subject: [PATCH 02/77] separate install and run tests step, show test output (for now) --- .github/workflows/ci.yml | 10 ++++++++-- scripts/run_commit_tests.sh | 7 +------ 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 41d49fdab3b..1e92d61c23a 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -32,10 +32,16 @@ jobs: pip install hyperon pip install junit2html - - name: Make Shell Script Executable + - name: Make Install Script Executable + run: chmod +x INSTALL.sh + + - name: Run Install Script to install Mettalog + run: . ./INSTALL.sh --easy + + - name: Make Test Script Executable run: chmod +x scripts/run_commit_tests.sh - - name: Run Shell Script to Generate Input File + - name: Run Test Script to Generate Input File continue-on-error: true run: | ./scripts/run_commit_tests.sh diff --git a/scripts/run_commit_tests.sh b/scripts/run_commit_tests.sh index 2945d9de2f0..43b61bf5930 100755 --- a/scripts/run_commit_tests.sh +++ b/scripts/run_commit_tests.sh @@ -1,9 +1,4 @@ #!/bin/bash -set -e # stop if any step fails - -# install mettalog -chmod +x INSTALL.sh # Make sure the script is executable -. ./INSTALL.sh --easy # generate the output directory with timestamp timestamp=$(date +"%Y-%m-%dT%H:%M:%S") @@ -11,4 +6,4 @@ output=reports/tests_output/baseline-compat-$timestamp/ # run the tests echo Running baseline_compat tests to $output -mettalog --output=$output tests/baseline_compat > /dev/null 2>&1 +mettalog --output=$output tests/baseline_compat #> /dev/null 2>&1 From 00f805338714cf70eeff3f5cbec343802a2ab2a0 Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 23 Aug 2024 11:11:41 -0500 Subject: [PATCH 03/77] try running tests with venv --- scripts/run_commit_tests.sh | 1 + 1 file changed, 1 insertion(+) diff --git a/scripts/run_commit_tests.sh b/scripts/run_commit_tests.sh index 43b61bf5930..54ec025e754 100755 --- a/scripts/run_commit_tests.sh +++ b/scripts/run_commit_tests.sh @@ -5,5 +5,6 @@ timestamp=$(date +"%Y-%m-%dT%H:%M:%S") output=reports/tests_output/baseline-compat-$timestamp/ # run the tests +. ./scripts/ensure_venv echo Running baseline_compat tests to $output mettalog --output=$output tests/baseline_compat #> /dev/null 2>&1 From 53856540250bd00d41dfa9f8c69507b5b9af9624 Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 23 Aug 2024 11:26:33 -0500 Subject: [PATCH 04/77] store /home/atench/.vscode-server/bin/fee1edb8d6d72a0ddff41e5f71a671c23ed924b9/bin/remote-cli:/home/atench/.cargo/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games:/usr/lib/wsl/lib:/mnt/c/windows/system32:/mnt/c/windows:/mnt/c/windows/System32/Wbem:/mnt/c/windows/System32/WindowsPowerShell/v1.0/:/mnt/c/windows/System32/OpenSSH/:/mnt/c/Program Files (x86)/NVIDIA Corporation/PhysX/Common:/mnt/c/WINDOWS/system32:/mnt/c/WINDOWS:/mnt/c/WINDOWS/System32/Wbem:/mnt/c/WINDOWS/System32/WindowsPowerShell/v1.0/:/mnt/c/WINDOWS/System32/OpenSSH/:/mnt/c/Program Files/NVIDIA Corporation/NVIDIA NvDLISR:/mnt/c/Program Files/dotnet/:/mnt/c/Program Files/Git/cmd:/mnt/c/Program Files/HP/HP One Agent:/mnt/c/Users/adric/AppData/Local/Microsoft/WindowsApps:/mnt/c/Users/adric/AppData/Local/Programs/Microsoft VS Code/bin:/snap/bin:/home/atench/.local/bin:/home/atench/mettalog/metta-wam to after mettalog install --- .github/workflows/ci.yml | 4 +++- scripts/run_commit_tests.sh | 1 - 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 1e92d61c23a..28b72599974 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -36,7 +36,9 @@ jobs: run: chmod +x INSTALL.sh - name: Run Install Script to install Mettalog - run: . ./INSTALL.sh --easy + run: | + . ./INSTALL.sh --easy + echo $PATH >> $GITHUB_PATH - name: Make Test Script Executable run: chmod +x scripts/run_commit_tests.sh diff --git a/scripts/run_commit_tests.sh b/scripts/run_commit_tests.sh index 54ec025e754..43b61bf5930 100755 --- a/scripts/run_commit_tests.sh +++ b/scripts/run_commit_tests.sh @@ -5,6 +5,5 @@ timestamp=$(date +"%Y-%m-%dT%H:%M:%S") output=reports/tests_output/baseline-compat-$timestamp/ # run the tests -. ./scripts/ensure_venv echo Running baseline_compat tests to $output mettalog --output=$output tests/baseline_compat #> /dev/null 2>&1 From bea51495679d59884ead75e6de92917f71bff6c4 Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 23 Aug 2024 11:49:07 -0500 Subject: [PATCH 05/77] set xterm-256color and only run subset of tests --- .github/workflows/ci.yml | 1 + scripts/run_commit_tests.sh | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 28b72599974..1e6caa44f52 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -46,6 +46,7 @@ jobs: - name: Run Test Script to Generate Input File continue-on-error: true run: | + TERM=xterm-256color ./scripts/run_commit_tests.sh - name: Run JUnit Report Generation Script diff --git a/scripts/run_commit_tests.sh b/scripts/run_commit_tests.sh index 43b61bf5930..7390ff29064 100755 --- a/scripts/run_commit_tests.sh +++ b/scripts/run_commit_tests.sh @@ -6,4 +6,4 @@ output=reports/tests_output/baseline-compat-$timestamp/ # run the tests echo Running baseline_compat tests to $output -mettalog --output=$output tests/baseline_compat #> /dev/null 2>&1 +mettalog --output=$output tests/baseline_compat/anti-regression #> /dev/null 2>&1 From c757a38bf485bc2de1826255a53a1c5808f6f407 Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 23 Aug 2024 11:58:02 -0500 Subject: [PATCH 06/77] set xterm-256color in yml --- .github/workflows/ci.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 1e6caa44f52..b269a406d56 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -46,8 +46,9 @@ jobs: - name: Run Test Script to Generate Input File continue-on-error: true run: | - TERM=xterm-256color ./scripts/run_commit_tests.sh + env: + TERM: xterm-256color - name: Run JUnit Report Generation Script continue-on-error: true From 2be694335204038f8fd6ce864b55785fa98353ab Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 23 Aug 2024 12:26:14 -0500 Subject: [PATCH 07/77] print SHARED.UNITS --- .github/workflows/ci.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index b269a406d56..d4e465b17b0 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -47,6 +47,7 @@ jobs: continue-on-error: true run: | ./scripts/run_commit_tests.sh + cat /tmp/SHARED.UNITS env: TERM: xterm-256color From 1af58e46dd16d77643eacaf4404ba88f021e3744 Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 23 Aug 2024 12:43:36 -0500 Subject: [PATCH 08/77] only run one test file --- .github/workflows/ci.yml | 1 + scripts/run_commit_tests.sh | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index d4e465b17b0..d0803416598 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -54,6 +54,7 @@ jobs: - name: Run JUnit Report Generation Script continue-on-error: true run: | + cat /tmp/SHARED.UNITS python scripts/into_junit.py /tmp/SHARED.UNITS > junit.xml - name: Convert JUnit XML to Standard HTML Report diff --git a/scripts/run_commit_tests.sh b/scripts/run_commit_tests.sh index 7390ff29064..35de3a54c43 100755 --- a/scripts/run_commit_tests.sh +++ b/scripts/run_commit_tests.sh @@ -6,4 +6,4 @@ output=reports/tests_output/baseline-compat-$timestamp/ # run the tests echo Running baseline_compat tests to $output -mettalog --output=$output tests/baseline_compat/anti-regression #> /dev/null 2>&1 +mettalog --output=$output tests/baseline_compat/anti-regression/comma_is_not_special.metta #> /dev/null 2>&1 From b504da73714152c1f5c41bc151f827e3dbe5823d Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 23 Aug 2024 13:47:58 -0500 Subject: [PATCH 09/77] don't run tests for now --- .github/workflows/ci.yml | 1 - scripts/run_commit_tests.sh | 3 ++- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index d0803416598..0ee3f84b983 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -47,7 +47,6 @@ jobs: continue-on-error: true run: | ./scripts/run_commit_tests.sh - cat /tmp/SHARED.UNITS env: TERM: xterm-256color diff --git a/scripts/run_commit_tests.sh b/scripts/run_commit_tests.sh index 35de3a54c43..2be15520ddf 100755 --- a/scripts/run_commit_tests.sh +++ b/scripts/run_commit_tests.sh @@ -6,4 +6,5 @@ output=reports/tests_output/baseline-compat-$timestamp/ # run the tests echo Running baseline_compat tests to $output -mettalog --output=$output tests/baseline_compat/anti-regression/comma_is_not_special.metta #> /dev/null 2>&1 +cat ./reports/SHARED.UNITS.PREV.md > /tmp/SHARED.UNITS +#mettalog --output=$output tests/baseline_compat/anti-regression/comma_is_not_special.metta #> /dev/null 2>&1 From ca9b23709f63688d8043d3d39eef200cadf4c01f Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 23 Aug 2024 14:14:29 -0500 Subject: [PATCH 10/77] update auto-approve-action version --- .github/workflows/ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 0ee3f84b983..4d276f798c8 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -150,7 +150,7 @@ jobs: - name: Auto-Approve the Pull Request if: github.event_name == 'pull_request_target' - uses: hmarr/auto-approve-action@v3 + uses: hmarr/auto-approve-action@v4 with: github-token: ${{ secrets.GITHUB_TOKEN }} From 9338f474016f30503ac2ce3ac29e8205a75c5b56 Mon Sep 17 00:00:00 2001 From: "Douglas R. Miles" Date: Fri, 23 Aug 2024 12:30:01 -0700 Subject: [PATCH 11/77] Run 1 test again to see output --- scripts/run_commit_tests.sh | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/scripts/run_commit_tests.sh b/scripts/run_commit_tests.sh index 2be15520ddf..1f33cab79a8 100755 --- a/scripts/run_commit_tests.sh +++ b/scripts/run_commit_tests.sh @@ -6,5 +6,6 @@ output=reports/tests_output/baseline-compat-$timestamp/ # run the tests echo Running baseline_compat tests to $output -cat ./reports/SHARED.UNITS.PREV.md > /tmp/SHARED.UNITS -#mettalog --output=$output tests/baseline_compat/anti-regression/comma_is_not_special.metta #> /dev/null 2>&1 +#cat ./reports/SHARED.UNITS.PREV.md > /tmp/SHARED.UNITS +cat /dev/null> /tmp/SHARED.UNITS +mettalog --output=$output tests/baseline_compat/anti-regression/comma_is_not_special.metta From 1d83e17b0ff4e59e9f8e08b4edfee826279513bc Mon Sep 17 00:00:00 2001 From: "Douglas R. Miles" Date: Fri, 23 Aug 2024 12:52:59 -0700 Subject: [PATCH 12/77] to run one test you have to use --test --- scripts/run_commit_tests.sh | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/scripts/run_commit_tests.sh b/scripts/run_commit_tests.sh index 1f33cab79a8..912c99e3b2b 100755 --- a/scripts/run_commit_tests.sh +++ b/scripts/run_commit_tests.sh @@ -6,6 +6,6 @@ output=reports/tests_output/baseline-compat-$timestamp/ # run the tests echo Running baseline_compat tests to $output -#cat ./reports/SHARED.UNITS.PREV.md > /tmp/SHARED.UNITS -cat /dev/null> /tmp/SHARED.UNITS -mettalog --output=$output tests/baseline_compat/anti-regression/comma_is_not_special.metta +cat ./reports/SHARED.UNITS.PREV.md > /tmp/SHARED.UNITS +#cat /dev/null> /tmp/SHARED.UNITS +#mettalog --output=$output --test --clean tests/baseline_compat/anti-regression/comma_is_not_special.metta From ce1aa72bf4afa37fca84f1bf0f77fda3fd4ea4bd Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 23 Aug 2024 15:08:32 -0500 Subject: [PATCH 13/77] make test run timestamp available --- .github/workflows/ci.yml | 5 ++++- scripts/run_commit_tests.sh | 18 +++++++++++++++++- 2 files changed, 21 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 4d276f798c8..cec2507a341 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -46,13 +46,16 @@ jobs: - name: Run Test Script to Generate Input File continue-on-error: true run: | - ./scripts/run_commit_tests.sh + TIMESTAMP=$(date +"%Y-%m-%dT%H:%M:%S") + ./scripts/run_commit_tests.sh -t $TIMESTAMP + echo "TIMESTAMP=$(echo $TIMESTAMP)" >> $GITHUB_ENV env: TERM: xterm-256color - name: Run JUnit Report Generation Script continue-on-error: true run: | + echo $TIMESTAMP cat /tmp/SHARED.UNITS python scripts/into_junit.py /tmp/SHARED.UNITS > junit.xml diff --git a/scripts/run_commit_tests.sh b/scripts/run_commit_tests.sh index 912c99e3b2b..b4677f8c50f 100755 --- a/scripts/run_commit_tests.sh +++ b/scripts/run_commit_tests.sh @@ -1,7 +1,23 @@ #!/bin/bash +# parse arguments +while [[ $# -gt 0 ]]; do + case $1 in + -t|--timestamp) + timestamp="$2" + shift # past argument + shift # past value + ;; + *) + # Ignore unknown options + ;; + esac +done + # generate the output directory with timestamp -timestamp=$(date +"%Y-%m-%dT%H:%M:%S") +if [ -z $timestamp ]; then + timestamp=$(date +"%Y-%m-%dT%H:%M:%S") +fi output=reports/tests_output/baseline-compat-$timestamp/ # run the tests From 5a703a1603888faca8ba73d3a770fbd13e8560d5 Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 23 Aug 2024 15:25:42 -0500 Subject: [PATCH 14/77] include timestamp in junit.xml --- .github/workflows/ci.yml | 4 +--- scripts/into_junit.py | 11 ++++++----- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index cec2507a341..7d10f2aea8b 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -55,9 +55,7 @@ jobs: - name: Run JUnit Report Generation Script continue-on-error: true run: | - echo $TIMESTAMP - cat /tmp/SHARED.UNITS - python scripts/into_junit.py /tmp/SHARED.UNITS > junit.xml + python scripts/into_junit.py /tmp/SHARED.UNITS $TIMESTAMP > junit.xml - name: Convert JUnit XML to Standard HTML Report continue-on-error: true diff --git a/scripts/into_junit.py b/scripts/into_junit.py index b08a9334a18..e09f10e0fa8 100644 --- a/scripts/into_junit.py +++ b/scripts/into_junit.py @@ -47,8 +47,8 @@ def parse_test_line(line): return testpackage, testname, stdout, full_identifier, got, expected, status, url -def generate_junit_xml(input_file): - testsuites = ET.Element("testsuites") +def generate_junit_xml(input_file, timestamp): + testsuites = ET.Element("testsuites", timestamp=timestamp) packages_dict = defaultdict(list) # Dictionary to group test cases by their testpackage with open(input_file, 'r') as file: @@ -76,10 +76,11 @@ def generate_junit_xml(input_file): return ET.tostring(testsuites, encoding="utf-8", xml_declaration=True).decode("utf-8") if __name__ == "__main__": - if len(sys.argv) != 2: - print("Usage: python scripts/into_junit.py ") + if len(sys.argv) != 3: + print("Usage: python scripts/into_junit.py ") sys.exit(1) input_file = sys.argv[1] - junit_xml = generate_junit_xml(input_file) + timestamp = sys.argv[2] + junit_xml = generate_junit_xml(input_file, timestamp) print(junit_xml) From 673f4577bb8ed79f8d2c46387db77263eaf11432 Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 23 Aug 2024 16:13:58 -0500 Subject: [PATCH 15/77] include test time in junit.xml --- scripts/into_junit.py | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/scripts/into_junit.py b/scripts/into_junit.py index e09f10e0fa8..2c400f15792 100644 --- a/scripts/into_junit.py +++ b/scripts/into_junit.py @@ -3,9 +3,9 @@ import re from collections import defaultdict -def create_testcase_element(testclass, testname, stdout, identifier, got, expected, status, url): +def create_testcase_element(testclass, testname, stdout, identifier, got, expected, status, url, time): # Create the testcase XML element with the class and test name attributes - testcase = ET.Element("testcase", classname=testclass, name=testname) + testcase = ET.Element("testcase", classname=testclass, name=testname, time=time) test_res = f"Assertion: {stdout}\nExpected: {expected}\nActual: {got}" sys_out_text = f"Test Report\n\n{test_res}\n]]>" @@ -44,11 +44,12 @@ def parse_test_line(line): raise ValueError("Test package or test name is empty after splitting.") except ValueError as e: raise ValueError(f"Identifier does not contain the expected format: {full_identifier}. Error: {str(e)}") + + time = '.01' # bogus time until tests actually note their runtime - return testpackage, testname, stdout, full_identifier, got, expected, status, url + return testpackage, testname, stdout, full_identifier, got, expected, status, url, time def generate_junit_xml(input_file, timestamp): - testsuites = ET.Element("testsuites", timestamp=timestamp) packages_dict = defaultdict(list) # Dictionary to group test cases by their testpackage with open(input_file, 'r') as file: @@ -57,19 +58,26 @@ def generate_junit_xml(input_file, timestamp): if line.startswith("|"): try: parts = re.split(r'\s*\|\s*(?![^()]*\))', line.strip()) - testpackage, testname, stdout, full_identifier, got, expected, status, url = parse_test_line(line) - testcase = create_testcase_element(testpackage, testname, stdout, full_identifier, got, expected, status, url) + testpackage, testname, stdout, full_identifier, got, expected, status, url, time = parse_test_line(line) + testcase = create_testcase_element(testpackage, testname, stdout, full_identifier, got, expected, status, url, time) packages_dict[testpackage].append(testcase) print(f"Processing {testpackage}.{testname}: {status}", file=sys.stderr) except ValueError as e: print(f"Skipping line due to error: {e}\nLine: {line}\nParts: {parts}", file=sys.stderr) # Create a testsuite for each testpackage group + testsuites = ET.Element("testsuites", timestamp=timestamp) + testsuites_time = 0.0 for testpackage, testcases in packages_dict.items(): testsuite = ET.Element("testsuite", name=testpackage) + testsuite_time = 0.0 for testcase in testcases: + testsuite_time += float(testcase.get('time')) testsuite.append(testcase) + testsuites_time += testsuite_time + testsuite.set('time', str(testsuite_time)) testsuites.append(testsuite) + testsuites.set('time', str(testsuites_time)) # Generate the XML tree and return it as a string tree = ET.ElementTree(testsuites) From 91893c38db2ad58b73ce45d4badff86fee408553 Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 23 Aug 2024 16:52:55 -0500 Subject: [PATCH 16/77] track commit SHA and branch --- .github/workflows/ci.yml | 1 + scripts/generate_allure_environment.py | 10 ++++++++++ 2 files changed, 11 insertions(+) create mode 100644 scripts/generate_allure_environment.py diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 7d10f2aea8b..ac3a086ee08 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -133,6 +133,7 @@ jobs: if [ -f "previous-junit.xml" ]; then cp previous-junit.xml ./allure-results/ fi + python scripts/generate_allure_environment.py ${{ github.sha }} ${{ github.ref_name }} > ./allure-results/environment.properties - name: Generate Allure Report run: | diff --git a/scripts/generate_allure_environment.py b/scripts/generate_allure_environment.py new file mode 100644 index 00000000000..6e7f2809916 --- /dev/null +++ b/scripts/generate_allure_environment.py @@ -0,0 +1,10 @@ +import sys + +if __name__ == "__main__": + if len(sys.argv) != 3: + print("Usage: python scripts/generate_allure_environment.py ") + sys.exit(1) + + commit_SHA = sys.argv[1] + branch = sys.argv[2] + print("COMMIT_SHA = {}\nBRANCH = {}".format(commit_SHA, branch)) \ No newline at end of file From c59a78be874604dadaaf8fd43959dee64fd674b7 Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 23 Aug 2024 17:40:11 -0500 Subject: [PATCH 17/77] generate executor.json --- .github/workflows/ci.yml | 1 + scripts/generate_allure_executor.py | 15 +++++++++++++++ 2 files changed, 16 insertions(+) create mode 100644 scripts/generate_allure_executor.py diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index ac3a086ee08..a8bffaedc70 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -134,6 +134,7 @@ jobs: cp previous-junit.xml ./allure-results/ fi python scripts/generate_allure_environment.py ${{ github.sha }} ${{ github.ref_name }} > ./allure-results/environment.properties + python scripts/generate_allure_executor.py ${{ github.server_url }} ${{ github.repository }} ${{ github.run_id }} > ./allure-results/executor.json - name: Generate Allure Report run: | diff --git a/scripts/generate_allure_executor.py b/scripts/generate_allure_executor.py new file mode 100644 index 00000000000..73bf4e63a4b --- /dev/null +++ b/scripts/generate_allure_executor.py @@ -0,0 +1,15 @@ +import sys, json + +if __name__ == "__main__": + if len(sys.argv) != 4: + print("Usage: python scripts/generate_allure_executor.py ") + sys.exit(1) + + server_url = sys.argv[1] + repo = sys.argv[2] + run_id = sys.argv[3] + data = { 'name':'GitHub Actions', 'type':'github' } + data['buildUrl'] = '{}/{}/actions/runs/{}'.format(server_url, repo, run_id) + data['buildName'] = 'GitHub Actions Run #{}'.format(run_id) + + print(json.dumps(data)) \ No newline at end of file From c4da025888163ec5ef8db5c9b02a8cbb99650889 Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 23 Aug 2024 18:16:25 -0500 Subject: [PATCH 18/77] include timestamps for test suites --- scripts/into_junit.py | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/scripts/into_junit.py b/scripts/into_junit.py index 2c400f15792..a45466ba2fd 100644 --- a/scripts/into_junit.py +++ b/scripts/into_junit.py @@ -2,6 +2,7 @@ import sys import re from collections import defaultdict +import datetime def create_testcase_element(testclass, testname, stdout, identifier, got, expected, status, url, time): # Create the testcase XML element with the class and test name attributes @@ -50,6 +51,8 @@ def parse_test_line(line): return testpackage, testname, stdout, full_identifier, got, expected, status, url, time def generate_junit_xml(input_file, timestamp): + dt = datetime.datetime.fromisoformat(timestamp) + timestamps_dict = {} packages_dict = defaultdict(list) # Dictionary to group test cases by their testpackage with open(input_file, 'r') as file: @@ -60,6 +63,9 @@ def generate_junit_xml(input_file, timestamp): parts = re.split(r'\s*\|\s*(?![^()]*\))', line.strip()) testpackage, testname, stdout, full_identifier, got, expected, status, url, time = parse_test_line(line) testcase = create_testcase_element(testpackage, testname, stdout, full_identifier, got, expected, status, url, time) + dt += datetime.timedelta(seconds=float(time)) + if testpackage not in timestamps_dict: + timestamps_dict[testpackage] = dt packages_dict[testpackage].append(testcase) print(f"Processing {testpackage}.{testname}: {status}", file=sys.stderr) except ValueError as e: @@ -69,7 +75,8 @@ def generate_junit_xml(input_file, timestamp): testsuites = ET.Element("testsuites", timestamp=timestamp) testsuites_time = 0.0 for testpackage, testcases in packages_dict.items(): - testsuite = ET.Element("testsuite", name=testpackage) + testsuite_timestamp = timestamps_dict[testpackage].isoformat(timespec='seconds') + testsuite = ET.Element("testsuite", name=testpackage, timestamp=testsuite_timestamp) testsuite_time = 0.0 for testcase in testcases: testsuite_time += float(testcase.get('time')) From 3ba9a270ea7ec63f68619b18e1296e2c550cff5f Mon Sep 17 00:00:00 2001 From: TeamSPoon Date: Fri, 23 Aug 2024 18:16:43 -0700 Subject: [PATCH 19/77] tests/performance/knowledge_graphs/graphml --- .gitignore | 3 + Test-files.vpj | 84 ++++++++++++++++++++++++++++ library/graphml/tests/simple.graphml | 31 ++++++++++ 3 files changed, 118 insertions(+) create mode 100755 Test-files.vpj create mode 100644 library/graphml/tests/simple.graphml diff --git a/.gitignore b/.gitignore index d4d5e44edac..debb77957d4 100755 --- a/.gitignore +++ b/.gitignore @@ -16,6 +16,9 @@ ftp.flybase.net/** *~ *.buffer.pl *.metta.pl +*.mine +venv/ +src/canary-*/ .* *.qlf *.datalog diff --git a/Test-files.vpj b/Test-files.vpj new file mode 100755 index 00000000000..be2fb2a3adb --- /dev/null +++ b/Test-files.vpj @@ -0,0 +1,84 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/library/graphml/tests/simple.graphml b/library/graphml/tests/simple.graphml new file mode 100644 index 00000000000..c3ce36c4c54 --- /dev/null +++ b/library/graphml/tests/simple.graphml @@ -0,0 +1,31 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + From 9d651455f7ea11be5d87a15db4c981dc2dba1a6f Mon Sep 17 00:00:00 2001 From: TeamSPoon Date: Fri, 23 Aug 2024 18:27:17 -0700 Subject: [PATCH 20/77] Docker towards https://github.com/trueagi-io/metta-wam/issues/32 --- Dockerfile | 30 +-------- README.md | 176 ++++++++++++++++++++++++++--------------------------- 2 files changed, 86 insertions(+), 120 deletions(-) diff --git a/Dockerfile b/Dockerfile index ca85c9e394c..d14e158f39c 100644 --- a/Dockerfile +++ b/Dockerfile @@ -16,34 +16,6 @@ RUN chsh -s /bin/bash user ENV HOME=/home/${USER} WORKDIR ${HOME} -# Install hyperonpy - -# MeTTaLog is already taking enough time we will have a separate one for Rustr MeTTa -RUN curl --proto '=https' --tlsv1.2 -sSf https://sh.rustup.rs > /tmp/rustup.sh -RUN sh /tmp/rustup.sh -y && rm /tmp/rustup.sh -ENV PATH="${PATH}:/home/user/.cargo/bin" -RUN cargo install cbindgen - -RUN python3 -m pip install conan==1.60.2 pip==23.1.2 -ENV PATH="${PATH}:/home/user/.local/bin" -RUN conan profile new --detect default - -RUN git clone https://github.com/trueagi-io/hyperon-experimental.git -WORKDIR ${HOME}/hyperon-experimental -RUN mkdir build - -WORKDIR ${HOME}/hyperon-experimental/lib -RUN cargo build -RUN cargo test - -WORKDIR ${HOME}/hyperon-experimental/build -RUN cmake .. -RUN make -RUN make check - -WORKDIR ${HOME}/hyperon-experimental -RUN python3 -m pip install -e ./python[dev] - # Install MeTTaLog ENV METTALOG_DIR="${HOME}/metta-wam" @@ -52,7 +24,7 @@ ENV PATH="${PATH}:${METTALOG_DIR}" WORKDIR ${HOME} # RUN git clone https://github.com/trueagi-io/metta-wam.git -RUN mkdir -p ${METTALOG_DIR}" +RUN mkdir -p "${METTALOG_DIR}" WORKDIR ${METTALOG_DIR} # This COPY is in case we have made local changes # so we dont have to commit to Github to test them out diff --git a/README.md b/README.md index 80ab4df1b2a..601e73001de 100755 --- a/README.md +++ b/README.md @@ -1,13 +1,17 @@ - # :rocket: An Implementation of MeTTa designed to run on the Warren Abstract Machine (WAM) -Info at [./docs/OVERVIEW.md](docs/OVERVIEW.md) in this repository. - -See [Tests](tests/) for MeTTa as well as [Results](reports/TEST_LINKS.md) +## Quick Links +- [Getting Started](#getting-started) + - [Installation](#installation) +- [Running MeTTaLog](#neckbeard-running-mettalog) + - [With Docker](#whale-running-mettalog-with-docker) +- [Test Reports](https://trueagi-io.github.io/metta-wam/) +- [Tests](tests/) and [Result Links](reports/TEST_LINKS.md) +- [Overview Documentation](./docs/OVERVIEW.md). -## :package: Getting Started +## Getting Started -### :toolbox: Installation +### :gear: Installation _Before you get started make sure `pip` and `venv` are working good._ @@ -15,126 +19,104 @@ Clone and set up MeTTaLog with the following commands: ``` git clone https://github.com/trueagi-io/metta-wam cd metta-wam -. scripts/ensure_venv # ensures we are running in a python venv -pip install ansi2html # needed for running tests -pip install hyperon # needed for running tests -pip install junit2html # needed for test report generation -chmod +x INSTALL.sh # Make sure the script is executable -. ./INSTALL.sh # Follow the default prompts - +source ./INSTALL.sh # Follow the default prompts ``` -The INSTALL.sh script handles the installation of essential components and updates: -#### Python Packages +#### The INSTALL.sh script handles the installation of essential components and updates: - Ensures Python's `pip` is installed or installs it. -- **Installs mettalog**: Allows Rust MeTTa use extra functionality found in mettalog -- **Installs mettalog-jupyter-kernal**: Work with metta files in Jupyter Notebooks -- **Installs metakernal**: (No relation!) but allows our Jypter Kernel to work -- **Checks** if SWI-Prolog is already installed. -- **Installs or Updates** to ensure version 9.1 or higher is present. +- **Installs or Updates SWI-Prolog** to ensure version 9.3.9 or higher is present. - **Installs janus**: A Python package that interfaces with SWI-Prolog. -- **Installs pyswip**: Another Python package that provides further integration +- **Installs pyswip**: Another Python package that provides further integration. +- **Installs hyperon**: Hyperon pip package needed for running compatibility tests. +- **Installs ansi2html**: Unit Test Visibility. +- **Installs junit2html**: Unit Test Reporting. +- **Installs mettalog-vspace**: Allows Rust MeTTa use extra functionality found in mettalog. +- **Installs mettalog-jupyter-kernel**: Work with metta files in Jupyter Notebooks. +- **Installs metakernel**: (No relation!) but allows our Jupyter Kernel to work. + **Note**: Running this script modifies software configurations and installs packages. Ensure you're prepared for these changes. -## :whale: Docker +## :whale: Running MeTTaLog with Docker -To build a docker image containing MeTTaLog readily available run the -following command +
+ This section guides you through using Docker to set up -```bash -docker build -t mettalog . -``` +Ensures that MeTTaLog is isolated from your local filesystem and operates in a controlled environment. + +### Building the Docker Image -You may then enter a corresponding containter with the following -command +To create a Docker image with MeTTaLog installed, use the following command: ```bash -docker run -it --entrypoint 'bash -i' mettalog +docker build -t mettalog . ``` -Once inside the container you may enter the MeTTaLog REPL with the -following command +This command constructs a Docker image named `mettalog` based on the Dockerfile in the current directory. -```bash -mettalog --repl -``` +### Interacting with MeTTaLog in Docker + +After building the image, you can run MeTTaLog inside a Docker container. This isolates it from your local filesystem, which means it won't have direct access to your local files unless explicitly configured to do so. -or run a metta script as follows +To start an interactive container with a bash shell, use: ```bash -mettalog myprg.metta +docker run -it mettalog bash -l ``` -or run/load a metta script and debug in the repl +Once inside the container, you have several options to interact with MeTTaLog. See [Running MeTTaLog](#neckbeard-running-mettalog). -```bash -mettalog myprg.metta --repl -``` +### Transferring Files to and from the Container +Docker allows you to copy files between the host and the container, which can be useful for moving scripts or data into the container before running them, or extracting results afterward. Refer to the Docker documentation on [copying files](https://docs.docker.com/engine/reference/commandline/container_cp/) for more details. -Docker has a rich functionality set. In particular it allows you to -[copy](https://docs.docker.com/engine/reference/commandline/container_cp/) -files back and forth between the host and the container. For more -information about Docker you may refer to its -[manuals](https://docs.docker.com/manuals/) and its [reference -documentation](https://docs.docker.com/reference/). +For comprehensive information about Docker's capabilities, consult the [Docker manuals](https://docs.docker.com/manuals/) and [reference documentation](https://docs.docker.com/reference/). +
-## :computer: Usage and Demos +## :neckbeard: Running MeTTaLog Interact directly with MeTTaLog through the REPL: ```bash mettalog --repl metta+> !(+ 1 1) -!(+ 1 1) - Deterministic: 2 ; Execution took 0.000105 secs. (105.29 microseconds) -metta+> +metta+>^D # Exit the REPL with `ctrl-D`. ``` -Exit the REPL with `ctrl-D`. -**To run a script:** +To run a script: ```bash -mettalog tests/baseline_compat/hyperon-experimental_scripts/b0_chaining_prelim.metta +mettalog tests/baseline_compat/metta-morph_tests/nalifier.metta ``` -**Note:** Remember, the `MeTTa` script's name is case-sensitive. Do not confuse it with `metta`, which refers to the MeTTa Interpreter written in Rust. - - - - - -** Launch Jupyter notebook: (in progress) ** - - Contains a Jupyter Kernel for MeTTa (allows runing of MeTTa scripts remotely) -``` -./scripts/start_jupyter.sh +To run a script and then enter the repl: +```bash +mettalog tests/baseline_compat/metta-morph_tests/nalifier.metta --repl ``` -### Running Tests Execute a unit test: ```bash -mettalog --test --clean tests/baseline_compat/hyperon-experimental_scripts/00_lang_case.metta -``` -The output is saved as an HTML file in the same directory. - -- Execute baseline sanity tests: +# The output is saved as an HTML file in the same directory. +mettalog --test tests/baseline_compat/metta-morph_tests/tests0.metta ``` -mettalog --test --clean ./tests/baseline-compat +Execute baseline sanity tests: +```bash +mettalog --test --clean ./tests/baseline_compat/ ``` -### Troubleshooting +## :toolbox: Troubleshooting -#### Some prolog commands not found +
+ Some prolog commands not found -If you already have a recent enough version of SWI-prolog installed, that will be used instead of mettalog installing its own. Some of the packages might not be installed, and mettalog might give an error such as: +If you already have a recent enough version of SWI-Prolog installed, that will be used instead of mettalog installing its own. Some of the packages might not be installed, and mettalog might give an error such as: ``` ERROR: save_history/0: Unknown procedure el_write_history/2 ``` -In that case, you need rebuild your SWI-prolog installation to include the missing packages. The most reliable way to do this is to make sure the following Debian/Ubuntu packages are installed using: +In that case, you need to rebuild your SWI-Prolog installation to include the missing packages. The most reliable way to do this is to make sure the following Debian/Ubuntu packages are installed using: ``` sudo apt install build-essential autoconf git cmake libpython3-dev libgmp-dev libssl-dev unixodbc-dev \ @@ -143,7 +125,7 @@ sudo apt install build-essential autoconf git cmake libpython3-dev libgmp-dev li pkg-config libdb-dev libpcre3-dev libyaml-dev libedit-dev ``` -then rebuild swi-prolog using the instructions from The [SWI-Prolog -- Installation on Linux, *BSD (Unix)](https://www.swi-prolog.org/build/unix.html). The main part of this (assuming that you are in the `swipl` or `swipl-devel` directory) is: +then rebuild SWI-Prolog using the instructions from the [SWI-Prolog -- Installation on Linux, *BSD (Unix)](https://www.swi-prolog.org/build/unix.html). The main part of this (assuming that you are in the `swipl` or `swipl-devel` directory) is: ``` cd build @@ -152,10 +134,12 @@ ninja ctest -j $(nproc) --output-on-failure ninja install ``` -If you installed swi-prolog as a package from your Linux distribition and run into issues, it is likely that you will need to `apt remove` it and then either -* build SWI-prolog from source making sure that all the operating system packages are installed first, or +If you installed SWI-Prolog as a package from your Linux distribution and run into issues, it is likely that you will need to `apt remove` it and then either +* build SWI-Prolog from source making sure that all the operating system packages are installed first, or * rerun the metta-wam `INSTALL.sh` script. +
+ ## :raised_hands: Acknowledgments Thanks to the Hyperon Experimental MeTTa, PySWIP teams, and Flybase for their contributions to this project. @@ -165,8 +149,8 @@ For queries or suggestions, please open an issue on our [GitHub Issues Page](htt ## :scroll: License MeTTaLog is distributed under the LGPL License, facilitating open collaboration and use. - -## :gear: Prerequisites for using MeTTaLog in Rust +
+ Prerequisites for using MeTTaLog in Rust - A build of [Hyperon Experimental](https://github.com/trueagi-io/hyperon-experimental) is required. ```bash @@ -185,7 +169,6 @@ MeTTaLog is distributed under the LGPL License, facilitating open collaboration ``` - ```shell metta> !(test_custom_v_space) @@ -206,7 +189,9 @@ Pass Test:(remove_atom on a missing atom should return false) ; (get-atoms &vspace_9) Pass Test:( [a, c] == [a, c] ) ; (add-atom &vspace_10 a) -; (add-atom &vspace_10 b) +; (add-atom &v + +space_10 b) ; (add-atom &vspace_10 c) ; (atom-replace &vspace_10 b d) ; (add-atom &vspace_10 d) @@ -234,9 +219,10 @@ Pass Test:( [ { $v <- B } ] == [{v: B}] ) Pass Test:(Values same: [[B]] == [[B]]) ``` +
- -## Python interaction +
+ Python interaction Module loading ; using the python default module resolver $PYTHONPATH @@ -259,7 +245,10 @@ Module loading (pyr! &self ../path/to/motto/test_llm_gate.py "run_tests" ((= verbose $verbose)))) ``` -## MeTTaLog Extras +
+ +
+ MeTTaLog Extras ``` ; For the compiler to know that the member function will be a predicate @@ -283,8 +272,6 @@ Module loading !(include! &self https://somewhere/test_llm_gate.metta) ``` - - ``` ; interfacing to Prolog (:> OptionsList (List (^ Expresson (Arity 2)))) @@ -314,8 +301,6 @@ clear ; mettalog --test --v=./src/canary --log --html tests/*baseline*/ \ --output=4-06-canary-wd-both --clean ``` - - Vs for diffing ``` @@ -327,8 +312,10 @@ clear ; mettalog --test --v=./src/canary --log --html --compile=false tests/base ``` +
-# Metta Functions Task List +
+ Metta Functions Task List | Function Name | Doc. (@doc) | Test Created | Impl. in Interpreter | Impl. in Transpiler | Arg Types Declared | |----------------|-------------|--------------|----------------------|---------------------|--------------------| @@ -336,5 +323,12 @@ clear ; mettalog --test --v=./src/canary --log --html --compile=false tests/base | `functionB` | - [ ] | - [ ] | - [ ] | - [ ] | - [ ] | | `functionC` | - [ ] | - [ ] | - [ ] | - [ ] | - [ ] | +
- +
+ Launch Jupyter notebook + - Contains a Jupyter Kernel for MeTTa (in-progress) +``` +./scripts/start_jupyter.sh +``` +
From 1c5463d7026c18298a390e66c24836c039e7b756 Mon Sep 17 00:00:00 2001 From: TeamSPoon Date: Fri, 23 Aug 2024 19:12:09 -0700 Subject: [PATCH 21/77] record_call_duration --- .Attic/metta_lang/metta_testing.pl | 41 +++++++++++++++++++++++++----- 1 file changed, 35 insertions(+), 6 deletions(-) diff --git a/.Attic/metta_lang/metta_testing.pl b/.Attic/metta_lang/metta_testing.pl index 686dd625c2c..93634e5d72d 100755 --- a/.Attic/metta_lang/metta_testing.pl +++ b/.Attic/metta_lang/metta_testing.pl @@ -132,16 +132,45 @@ UNITS = '/tmp/SHARED.UNITS', open(UNITS, append, Stream,[encoding(utf8)]), once(getenv('HTML_FILE',HTML_OUT);sformat(HTML_OUT,'~w.metta.html',[Base])), - format(Stream,'| ~w | ~w |[~w](https://logicmoo.org/public/metta/reports/~w#~w) | ~@ | ~@ | ~@ |~n', + compute_html_out_per_test(HTML_OUT,TEE_FILE,TestName,HTML_OUT_PerTest), + get_last_call_duration(Duration), + format(Stream,'| ~w | ~w |[~w](https://logicmoo.org/public/metta/reports/~w#~w) | ~@ | ~@ | ~@ | ~w | ~w |~n', [TestName,PASS_FAIL,TestName,HTML_OUT,TestName, - trim_gstring_bar_I(write_src_woi([P,C]),200), - trim_gstring_bar_I(write_src_woi(G1),100), - trim_gstring_bar_I(write_src_woi(G2),100)]),!, + trim_gstring_bar_I(write_src_woi([P,C]),400), + trim_gstring_bar_I(write_src_woi(G1),200), + trim_gstring_bar_I(write_src_woi(G2),200), + Duration, + HTML_OUT_PerTest]),!, close(Stream))). +% currently in a shared file per TestCase class.. +% but we might make each test dump its stuffg to its own html file for easier spotting why test failed +compute_html_out_per_test(HTML_OUT,_TEE_FILE,_TestName,HTML_OUT_PerTest):- + HTML_OUT=HTML_OUT_PerTest. + +% Executes Goal and records the execution duration in '$last_call_duration'. +% The duration is recorded regardless of whether Goal succeeds or fails. +record_call_duration(Goal) :- + nb_setval('$last_call_duration', 120), + statistics(cputime, Start), % Get the start CPU time + ( call(Goal) % Call the Goal + *-> EndResult = true % If Goal succeeds, proceed + ; EndResult = false % If Goal fails, record it but proceed + ), + statistics(cputime, End), % Get the end CPU time + Duration is End - Start, % Calculate the CPU duration + nb_setval('$last_call_duration', Duration), % Set the global variable non-backtrackably + EndResult. % Preserve the result of the Goal + +% Helper to retrieve the last call duration stored in the global variable. +get_last_call_duration(Duration) :- + nb_getval('$last_call_duration', Duration),!. + + trim_gstring_bar_I(Goal, MaxLen) :- wots(String0,Goal), - string_replace(String0,'|','I',String), + string_replace(String0,'|','I',String1), + string_replace(String1,'\n','\\n',String), atom_length(String, Len), ( Len =< MaxLen -> Trimmed = String @@ -151,7 +180,7 @@ ), write(Trimmed). -loonit_asserts1(TestSrc,Pre,G) :- _=nop(Pre),call(G), +loonit_asserts1(TestSrc,Pre,G) :- _=nop(Pre),record_call_duration(call(G)), give_pass_credit(TestSrc,Pre,G),!. /* From 95ca2769ac140ed6883bed67eb6832b5d56415b3 Mon Sep 17 00:00:00 2001 From: TeamSPoon Date: Fri, 23 Aug 2024 19:33:25 -0700 Subject: [PATCH 22/77] Just for TeamSPOon Repo for 100 --- scripts/run_commit_tests.sh | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/scripts/run_commit_tests.sh b/scripts/run_commit_tests.sh index b4677f8c50f..a5b60918e4f 100755 --- a/scripts/run_commit_tests.sh +++ b/scripts/run_commit_tests.sh @@ -22,6 +22,7 @@ output=reports/tests_output/baseline-compat-$timestamp/ # run the tests echo Running baseline_compat tests to $output -cat ./reports/SHARED.UNITS.PREV.md > /tmp/SHARED.UNITS -#cat /dev/null> /tmp/SHARED.UNITS +#cat ./reports/SHARED.UNITS.PREV.md > /tmp/SHARED.UNITS +cat /dev/null > /tmp/SHARED.UNITS #mettalog --output=$output --test --clean tests/baseline_compat/anti-regression/comma_is_not_special.metta +mettalog --output=$output --test --clean tests/baseline_compat/module-system/ From ddb2ab4f0d0991f60cb4c883c5204caffd99d648 Mon Sep 17 00:00:00 2001 From: TeamSPoon Date: Fri, 23 Aug 2024 19:57:52 -0700 Subject: [PATCH 23/77] lets assume the output path contains reports/ dir --- .Attic/metta_lang/metta_testing.pl | 2 +- scripts/run_commit_tests.sh | 1 + scripts/test_in_metta.sh | 15 ++++++++------- 3 files changed, 10 insertions(+), 8 deletions(-) diff --git a/.Attic/metta_lang/metta_testing.pl b/.Attic/metta_lang/metta_testing.pl index 93634e5d72d..2071ef7a3c1 100755 --- a/.Attic/metta_lang/metta_testing.pl +++ b/.Attic/metta_lang/metta_testing.pl @@ -134,7 +134,7 @@ once(getenv('HTML_FILE',HTML_OUT);sformat(HTML_OUT,'~w.metta.html',[Base])), compute_html_out_per_test(HTML_OUT,TEE_FILE,TestName,HTML_OUT_PerTest), get_last_call_duration(Duration), - format(Stream,'| ~w | ~w |[~w](https://logicmoo.org/public/metta/reports/~w#~w) | ~@ | ~@ | ~@ | ~w | ~w |~n', + format(Stream,'| ~w | ~w |[~w](https://logicmoo.org/public/metta/~w#~w) | ~@ | ~@ | ~@ | ~w | ~w |~n', [TestName,PASS_FAIL,TestName,HTML_OUT,TestName, trim_gstring_bar_I(write_src_woi([P,C]),400), trim_gstring_bar_I(write_src_woi(G1),200), diff --git a/scripts/run_commit_tests.sh b/scripts/run_commit_tests.sh index a5b60918e4f..9a18fa2f16a 100755 --- a/scripts/run_commit_tests.sh +++ b/scripts/run_commit_tests.sh @@ -21,6 +21,7 @@ fi output=reports/tests_output/baseline-compat-$timestamp/ # run the tests +mkdir -p $output echo Running baseline_compat tests to $output #cat ./reports/SHARED.UNITS.PREV.md > /tmp/SHARED.UNITS cat /dev/null > /tmp/SHARED.UNITS diff --git a/scripts/test_in_metta.sh b/scripts/test_in_metta.sh index 8c58d7015cd..faf2df9544b 100755 --- a/scripts/test_in_metta.sh +++ b/scripts/test_in_metta.sh @@ -1,7 +1,7 @@ #!/bin/bash SHOULD_EXIT=0 -SHARED_UNITS=/tmp/SHARED.UNITS +export SHARED_UNITS=/tmp/SHARED.UNITS DEBUG_WHY() { DEBUG "${GREEN}WHY: ${BOLD}${*}${NC}" @@ -189,7 +189,7 @@ METTALOG_MAX_TIME=75 SCRIPT_NAME=$(basename "$0") run_tests_auto_reply="" generate_report_auto_reply="" -METTALOG_OUTPUT="tests_output/testrun_$(date +%Y%m%d_%H%M%S)" +METTALOG_OUTPUT="reports/tests_output/testrun_$(date +%Y%m%d_%H%M%S)" fresh=0 clean=0 # 0 means don't clean, 1 means do clean if_failures=0 @@ -431,12 +431,13 @@ generate_final_MeTTaLog() { # Change to the script directory cd "$METTALOG_DIR" || exit 1 - python3 ./scripts/into_junit.py "${SHARED_UNITS}" > "$METTALOG_OUTPUT/junit.xml" - - junit2html "$METTALOG_OUTPUT/junit.xml" - junit2html "$METTALOG_OUTPUT/junit.xml" --summary-matrix - echo "saved to $METTALOG_OUTPUT/junit.xml.html" + if [ 1 -eq 0 ]; then + python3 ./scripts/into_junit.py "${SHARED_UNITS}" > "$METTALOG_OUTPUT/junit.xml" + junit2html "$METTALOG_OUTPUT/junit.xml" + junit2html "$METTALOG_OUTPUT/junit.xml" --summary-matrix + echo "saved to $METTALOG_OUTPUT/junit.xml.html" + fi # Calculate the number of passed and failed tests passed=$(grep -c "| PASS |" "${SHARED_UNITS}") From 0510d1a10a1afca046a37749cee51cbf251cb50e Mon Sep 17 00:00:00 2001 From: TeamSPoon Date: Fri, 23 Aug 2024 20:54:01 -0700 Subject: [PATCH 24/77] INSTALL detects if on github actions and might use PPA --- INSTALL.sh | 20 ++++++++++++++++++++ scripts/run_commit_tests.sh | 6 ++++-- 2 files changed, 24 insertions(+), 2 deletions(-) diff --git a/INSTALL.sh b/INSTALL.sh index 269aa8576e8..a5f43957628 100755 --- a/INSTALL.sh +++ b/INSTALL.sh @@ -196,6 +196,26 @@ install_or_update_swipl() { } + +# Check if SWI-Prolog is NOT installed with Janus and on GITHUB ACTIONS +if [ -n "$GITHUB_ACTIONS" ]; then + echo "This script is running in a GitHub Actions environment." + if ! command -v swipl &> /dev/null || ! swipl -g "use_module(library(janus)), halt(0)." -t "halt(1)" 2>/dev/null; then + : # + else + swi_prolog_version=$(swipl_version) + required_version="9.3.8" + if version_ge $swi_prolog_version $required_version; then + echo -e "${GREEN}SWI-Prolog version $swi_prolog_version is installed and meets the required version $required_version or higher.${NC}" + else + sudo add-apt-repository ppa:swi-prolog/devel -y + sudo apt update + sudo install swi-prolog + fi + fi +fi + + # Check if SWI-Prolog is installed with Janus if ! command -v swipl &> /dev/null || ! swipl -g "use_module(library(janus)), halt(0)." -t "halt(1)" 2>/dev/null; then if confirm_with_default "Y" "SWI-Prolog is not installed with Janus support. Would you like to install it?"; then diff --git a/scripts/run_commit_tests.sh b/scripts/run_commit_tests.sh index 9a18fa2f16a..705b663bce4 100755 --- a/scripts/run_commit_tests.sh +++ b/scripts/run_commit_tests.sh @@ -18,7 +18,7 @@ done if [ -z $timestamp ]; then timestamp=$(date +"%Y-%m-%dT%H:%M:%S") fi -output=reports/tests_output/baseline-compat-$timestamp/ +output=./reports/tests_output/baseline-compat-$timestamp/ # run the tests mkdir -p $output @@ -26,4 +26,6 @@ echo Running baseline_compat tests to $output #cat ./reports/SHARED.UNITS.PREV.md > /tmp/SHARED.UNITS cat /dev/null > /tmp/SHARED.UNITS #mettalog --output=$output --test --clean tests/baseline_compat/anti-regression/comma_is_not_special.metta -mettalog --output=$output --test --clean tests/baseline_compat/module-system/ +mettalog --test --clean --output=$output tests/baseline_compat/module-system/ + +cat /tmp/SHARED.UNITS From f109c595c7b746eba2bfe258f6a2d739b54a51dd Mon Sep 17 00:00:00 2001 From: TeamSPoon Date: Sat, 24 Aug 2024 12:15:31 -0700 Subject: [PATCH 25/77] Detect Github --- INSTALL.sh | 85 ++++++++++++++++++++++++++++++------------------------ 1 file changed, 48 insertions(+), 37 deletions(-) diff --git a/INSTALL.sh b/INSTALL.sh index a5f43957628..6d072e82678 100755 --- a/INSTALL.sh +++ b/INSTALL.sh @@ -6,14 +6,12 @@ IS_SOURCED=$( [[ "${BASH_SOURCE[0]}" != "${0}" ]] && echo 1 || echo 0) if [ "$IS_SOURCED" -eq "0" ]; then SCRIPT=$(readlink -f "$0"); else SCRIPT=$(readlink -f "${BASH_SOURCE[0]}"); fi export MeTTa=$(realpath "$SCRIPT") export METTALOG_DIR=$(dirname "$MeTTa") -export PIP_BREAK_SYSTEM_PACKAGES=1 # cd "$METTALOG_DIR" || { echo "Failed to navigate to $METTALOG_DIR"; [[ "$IS_SOURCED" == "1" ]] && return 1 || exit 1; } -(cd $METTALOG_DIR ; git update-index --assume-unchanged .bash_history) || true +#(cd $METTALOG_DIR ; git update-index --assume-unchanged .bash_history) || true # Run this file with ./INSTALL.md # ``` -. ./scripts/ensure_venv # Function to prompt for user confirmation with 'N' as the default confirm_with_default() { @@ -37,7 +35,6 @@ confirm_with_default() { done } - # Function to prompt for input with a default value prompt_for_input() { read -e -i "$2" -p "$1" value @@ -74,23 +71,6 @@ do esac done -# Ask the user if easy_install is still '?' -if [ "$easy_install" == "?" ]; then - if confirm_with_default "Y" "Would you like to use easy installation mode?"; then - easy_install="Y" - else - easy_install="N" - fi -fi - -if [ -f /.dockerenv ]; then - inside_docker="-y" -else - inside_docker="" -fi - - -echo -e "${BLUE}Starting the installation process..${NC}." # Function to compare versions version_ge() { @@ -180,7 +160,7 @@ install_or_update_swipl() { #sudo apt-get remove -y swi-prolog??* #sudo apt-get install -y swi-prolog swi_prolog_version=$(swipl_version) - required_version="9.3.8" + required_version="9.3.9" if version_ge $swi_prolog_version $required_version; then echo -e "${GREEN}SWI-Prolog version $swi_prolog_version is installed and meets the required version $required_version or higher.${NC}" else @@ -196,25 +176,56 @@ install_or_update_swipl() { } +# Is a Docker VM Allow more System modifications +if [ -f /.dockerenv ] || grep -qa docker /proc/1/cgroup; then + export PIP_BREAK_SYSTEM_PACKAGES=1 + export ALLOW_MODIFY_SYSTEM=1 + INSTALL_TYPE=docker_vm + if [ "$easy_install" == "?" ]; then + easy_install="Y" + fi +else + INSTALL_TYPE=non_docker +fi + +echo "INSTALL_TYPE=$INSTALL_TYPE" -# Check if SWI-Prolog is NOT installed with Janus and on GITHUB ACTIONS +# Is a Github VM if [ -n "$GITHUB_ACTIONS" ]; then - echo "This script is running in a GitHub Actions environment." - if ! command -v swipl &> /dev/null || ! swipl -g "use_module(library(janus)), halt(0)." -t "halt(1)" 2>/dev/null; then - : # + + INSTALL_TYPE=github_vm + export PIP_BREAK_SYSTEM_PACKAGES=1 + export ALLOW_MODIFY_SYSTEM=1 + echo "INSTALL_TYPE=$INSTALL_TYPE" + + if [ "$easy_install" == "?" ]; then + easy_install="Y" + fi + sudo add-apt-repository ppa:swi-prolog/devel -y + sudo apt update + sudo apt install -y swi-prolog + #bsdutils: /usr/bin/script + sudo apt install -y time libedit-dev bsdutils + sudo apt install -y build-essential autoconf git cmake libpython3-dev libgmp-dev libssl-dev unixodbc-dev \ + libreadline-dev zlib1g-dev libarchive-dev libossp-uuid-dev libxext-dev \ + libice-dev libjpeg-dev libxinerama-dev libxft-dev libxpm-dev libxt-dev \ + pkg-config libdb-dev libpcre3-dev libyaml-dev libedit-dev + +fi + +# Ask the user if easy_install is still '?' +if [ "$easy_install" == "?" ]; then + if confirm_with_default "Y" "Would you like to use easy installation mode?"; then + easy_install="Y" else - swi_prolog_version=$(swipl_version) - required_version="9.3.8" - if version_ge $swi_prolog_version $required_version; then - echo -e "${GREEN}SWI-Prolog version $swi_prolog_version is installed and meets the required version $required_version or higher.${NC}" - else - sudo add-apt-repository ppa:swi-prolog/devel -y - sudo apt update - sudo install swi-prolog - fi + easy_install="N" fi fi +echo -e "${BLUE}Starting the installation process..${NC}." + +. ./scripts/ensure_venv + # Check if SWI-Prolog is installed with Janus if ! command -v swipl &> /dev/null || ! swipl -g "use_module(library(janus)), halt(0)." -t "halt(1)" 2>/dev/null; then @@ -226,7 +237,7 @@ if ! command -v swipl &> /dev/null || ! swipl -g "use_module(library(janus)), ha fi else swi_prolog_version=$(swipl_version) - required_version="9.3.8" + required_version="9.3.9" if version_ge $swi_prolog_version $required_version; then echo -e "${GREEN}SWI-Prolog version $swi_prolog_version is installed and meets the required version $required_version or higher.${NC}" else @@ -360,7 +371,7 @@ check_metalog_in_path() { # Call the function to perform the check and update check_metalog_in_path -which swipl +echo "SWIPL executable is: `which swipl`" echo -e "${GREEN}Installation and setup complete!${NC}." From 4871949c410a42e79010902f7b45c3847d811584 Mon Sep 17 00:00:00 2001 From: TeamSPoon Date: Sat, 24 Aug 2024 12:16:32 -0700 Subject: [PATCH 26/77] detect stdio --- mettalog | 236 +++++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 177 insertions(+), 59 deletions(-) diff --git a/mettalog b/mettalog index f374667b18f..d676318d4c7 100755 --- a/mettalog +++ b/mettalog @@ -26,15 +26,82 @@ use_rc_file=~/.mettalogrc debug_this_script=false contains_halt=false dry_run=0 -#debug_this_script=true -stdout_is_to_file=false -if [ -t 1 ]; then - #echo "stdout is connected to a terminal" - stdout_is_to_file=false -else - #echo "stdout is being piped or redirected" - stdout_is_to_file=true -fi + +# Function to add a flag to a list +add_to_list() { + local flag=$1 + local -n options=$2 + if [[ -n "$flag" ]]; then + options+=("$flag") + fi +} + +# Function to set input, output, and error flags based on the I/O sources +set_io_flags() { + #local -n STDIO_OPTIONS=$1 + + # Handle stdin flags + if [ -p /dev/stdin ]; then + add_to_list "--stdin=pipe" STDIO_OPTIONS + elif [ -f /dev/stdin ]; then + local input_filename + input_filename=$(readlink /proc/self/fd/0) + add_to_list "--stdin=file" STDIO_OPTIONS + add_to_list "--input-filename=${input_filename}" STDIO_OPTIONS + else + add_to_list "--stdin=tty" STDIO_OPTIONS + fi + + # Handle stdout flags + if [ ! -t 1 ]; then + if [ -p /dev/stdout ]; then + add_to_list "--stdout=pipe" STDIO_OPTIONS + elif [ -f /dev/stdout ]; then + local output_filename + output_filename=$(readlink /proc/self/fd/1) + add_to_list "--stdout=file" STDIO_OPTIONS + add_to_list "--output-filename=${output_filename}" STDIO_OPTIONS + fi + else + add_to_list "--stdout=tty" STDIO_OPTIONS + fi + + # Handle stderr flags + if [ ! -t 2 ]; then + if [ -p /dev/stderr ]; then + add_to_list "--stderr=pipe" STDIO_OPTIONS + elif [ -f /dev/stderr ]; then + local error_filename + error_filename=$(readlink /proc/self/fd/2) + add_to_list "--stderr=file" STDIO_OPTIONS + add_to_list "--error-filename=${error_filename}" STDIO_OPTIONS + fi + else + add_to_list "--stderr=tty" STDIO_OPTIONS + fi +} + +# Initialize the STDIO_OPTIONS array +STDIO_OPTIONS=() + +# Set the input, output, and error flags +set_io_flags + +# Function to check if SWI-Prolog is installed +check_swipl_installed() { + if ! command -v swipl &> /dev/null; then + echo -e "\033[0;31mError: SWI-Prolog is not installed. Please install it and try again.\033[0m" + exit 1 + fi +} + +# Function to check if SWI-Prolog has Janus support (optional, based on your needs) +check_janus_support() { + if ! swipl -g "use_module(library(janus)), halt(0)." -t "halt(1)" 2>/dev/null; then + echo -e "\033[0;31mError: SWI-Prolog does not have Janus support. Please install Janus and try again.\033[0m" + python_flag=disable + fi +} # Capture original auto margins setting and terminal size @@ -168,7 +235,6 @@ do_DEBUG() { local screen_width=$(tput cols) local threshold=$((screen_width * 74 / 100)) - # Construct the debug message # Construct the debug message local msg="; ${YELLOW}DEBUG${NC} $*" @@ -422,6 +488,8 @@ fi PRE_METTALOG_OPTIONS=() SWI_FLAG_WITH_ARG=false python_flag=enable +# Optional: Check if SWI-Prolog has Janus support +check_janus_support LIST_OF_FILE_ARGS=() wants_print_help=0 @@ -542,14 +610,15 @@ function handle_args { #METTALOG_OPTIONS=("--timeout=$TIMEOUT" "${METTALOG_OPTIONS[@]}") #add_to_list "$arg" METTALOG_OPTIONS continue - elif [[ "$arg" =~ ^--python=(enable|false)$ ]]; then + elif [[ "$arg" =~ ^--python=(enable|disable|false)$ ]]; then python_flag="${BASH_REMATCH[1]}" - continue + continue elif [[ "$arg" == "--python" ]]; then python_flag=enable - continue + continue elif [[ "$arg" == "--no-python" ]]; then python_flag=false + continue elif [[ "$arg" == "--repl" ]]; then #add_to_list "$arg" METTALOG_OPTIONS_LAST repl_flag=true @@ -861,30 +930,33 @@ if [[ -z "$reference_file" ]]; then fi if [[ -f "$reference_file" ]]; then - : # rm -f $reference_file + : # Placeholder in case something needs to be done here + # rm -f $reference_file fi if [[ -f "$reference_file" ]]; then - MLOG="$reference_file --" + MLOG="$reference_file" + if [[ "${#SWI_OPTIONS[@]}" -gt 0 ]]; then - MLOG="swipl -x $reference_file ${SWI_OPTIONS[*]} --" + MLOG="swipl -x $reference_file ${SWI_OPTIONS[*]}" fi if [[ "$never_compile" -eq 1 ]]; then - MLOG="swipl ${SWI_OPTIONS[*]} -l $INTERP_SRC_DIR/metta_interp.pl --" + MLOG="swipl ${SWI_OPTIONS[*]} $INTERP_SRC_DIR/metta_interp.pl" fi else - MLOG="swipl ${SWI_OPTIONS[*]} -l $INTERP_SRC_DIR/metta_interp.pl --" -fi - -if [[ "$stdout_is_to_file" == true ]]; then - add_to_list "--piped" METTALOG_OPTIONS + MLOG="swipl ${SWI_OPTIONS[*]} $INTERP_SRC_DIR/metta_interp.pl" fi #add_to_list "--log" METTALOG_OPTIONS #html_flag=enable #add_to_list "--html" METTALOG_OPTIONS -METTA_CMD="$MLOG --python=$python_flag ${PRE_METTALOG_OPTIONS[*]} ${METTALOG_OPTIONS[*]} ${METTALOG_OPTIONS_LAST[*]}" +STDIO_OPTIONS=() +set_io_flags STDIO_OPTIONS + +# Generate the final command +METTA_CMD="$MLOG --python=$python_flag ${PRE_METTALOG_OPTIONS[*]} ${METTALOG_OPTIONS[*]} ${METTALOG_OPTIONS_LAST[*]} ${STDIO_OPTIONS[*]}" + OS=$(uname) TIMEOUT_CMD="timeout" @@ -915,7 +987,7 @@ cleanup() { else METTA_CMD_EXIT_STATUS=${METTA_CMD_EXIT_STATUS:-$?} fi - DEBUG "Exit code of METTA_CMD: $METTA_CMD_EXIT_STATUS" + do_DEBUG "Exit code of METTA_CMD: $METTA_CMD_EXIT_STATUS" if [ ! -z "$TEE_FILE" ];then if [ ! -z "$HTML_OUT" ];then @@ -933,13 +1005,11 @@ cleanup() { } # Trap exit signal to execute cleanup function - -#DEBUG "TIMEOUT=$TIMEOUT" - +trap cleanup EXIT if [[ -n "$TIMEOUT" && "$TIMEOUT" -gt 0 ]]; then export TIMEOUT - METTA_CMD="$TIMEOUT_CMD --preserve-status --signal=SIGTERM --kill-after=5s $TIMEOUT ${METTA_CMD}" + METTA_CMD="$TIMEOUT_CMD --preserve-status --foreground --signal=SIGTERM --kill-after=5s $TIMEOUT ${METTA_CMD}" fi function escape_quotes { @@ -950,6 +1020,59 @@ function escape_quotes { cd "${RPWD}" set +e +# Function to execute the command with the appropriate redirections +execute_with_pipes() { + local input_redirection="" + local output_redirection="" + local error_redirection="" + + # Handle stdin redirection + if [[ "${STDIO_OPTIONS[*]}" =~ "--stdin=file" ]]; then + input_file=$(echo "${STDIO_OPTIONS[*]}" | grep -oP '(?<=--input-filename=)[^ ]+') + input_redirection="<\"$input_file\"" + elif [[ "${STDIO_OPTIONS[*]}" =~ "--stdin=pipe" ]]; then + # stdin is already a pipe, no action needed + : + else + # stdin is a tty, no redirection needed + : + fi + + # Handle stdout redirection + if [[ "${STDIO_OPTIONS[*]}" =~ "--stdout=file" ]]; then + output_file=$(echo "${STDIO_OPTIONS[*]}" | grep -oP '(?<=--output-filename=)[^ ]+') + output_redirection=">\"$output_file\"" + elif [[ "${STDIO_OPTIONS[*]}" =~ "--stdout=pipe" ]]; then + # stdout is already a pipe, no action needed + : + else + # stdout is a tty, no redirection needed + : + fi + + # Handle stderr redirection + if [[ "${STDIO_OPTIONS[*]}" =~ "--stderr=file" ]]; then + error_file=$(echo "${STDIO_OPTIONS[*]}" | grep -oP '(?<=--error-filename=)[^ ]+') + error_redirection="2>\"$error_file\"" + elif [[ "${STDIO_OPTIONS[*]}" =~ "--stderr=pipe" ]]; then + # stderr is already a pipe, no action needed + : + else + # stderr is a tty, no redirection needed + : + fi + + # Construct the full command with all necessary redirections + local full_command="eval \"$METTA_CMD\" $input_redirection $output_redirection $error_redirection" + + # Check if SWI-Prolog is installed + check_swipl_installed + + # Execute the command using IF_REALLY_DO + IF_REALLY_DO "$full_command" +} + + # Conditional to check if html_flag is enabled if [[ "$html_flag" == "enable" ]]; then # Generate a random filename for TEE_FILE with date,time,PID @@ -967,38 +1090,33 @@ if [[ "$html_flag" == "enable" ]]; then export TYPESCRIPT=1 if [[ "$OS" == "Darwin" ]]; then # macOS - METTA_CMD="/usr/bin/script -q -f -a \"$TEE_FILE\" \"${METTA_CMD//\"/\\\"}\"" + METTA_CMD="/usr/bin/script -q -f -a \"$TEE_FILE\" -c \\\"$(printf '%q ' ${METTA_CMD[@]})\\\"" else # Assume Linux - METTA_CMD="/usr/bin/script -q -f --force -e -a \"$TEE_FILE\" -c \"${METTA_CMD//\"/\\\"}\"" - fi - - [[ "$wants_print_help" == "1" ]] && { print_help; } - DEBUG "" - DEBUG "Afterwhich ansi2html -u < $TEE_FILE > '$HTML_OUT'" - DEBUG "" - [[ -n "${EXIT_SCRIPT+x}" ]] && { [[ "$IS_SOURCED" == "1" ]] && return "$EXIT_SCRIPT" || exit "$EXIT_SCRIPT"; } - - #( - IF_REALLY_DO "touch '$TEE_FILE'" - IF_REALLY_DO "chmod 777 '$TEE_FILE'" - IF_REALLY_DO "cat /dev/null > '$TEE_FILE'" - #if [[ "$contains_halt" == "true" ]]; then - DEBUG "METTA_CMD: $METTA_CMD" - #fi - trap 'cleanup' EXIT - eval "$METTA_CMD" - echo $? > "$TEMP_EXIT_CODE_FILE" - #) + METTA_CMD="/usr/bin/script -q -f --force -e -a \"$TEE_FILE\" -c \\\"$(echo "${METTA_CMD}" | sed 's/"/\\"/g')\\\"" + fi + + [[ "$wants_print_help" == "1" ]] && { print_help; } + DEBUG "" + DEBUG "Afterwhich ansi2html -u < $TEE_FILE > '$HTML_OUT'" + DEBUG "" + [[ -n "${EXIT_SCRIPT+x}" ]] && { [[ "$IS_SOURCED" == "1" ]] && return "$EXIT_SCRIPT" || exit "$EXIT_SCRIPT"; } + + IF_REALLY_DO "touch '$TEE_FILE'" + IF_REALLY_DO "chmod 777 '$TEE_FILE'" + IF_REALLY_DO "cat /dev/null > '$TEE_FILE'" + if [[ "$contains_halt" == "true" ]]; then + do_DEBUG "METTA_CMD: $METTA_CMD" + fi + execute_with_pipes + echo $? > "$TEMP_EXIT_CODE_FILE" else - [[ "$wants_print_help" == "1" ]] && { print_help; [[ "$IS_SOURCED" == "1" ]] && return "$EXIT_SCRIPT" || exit "$EXIT_SCRIPT"; } - [[ -n "${EXIT_SCRIPT+x}" ]] && { [[ "$IS_SOURCED" == "1" ]] && return "$EXIT_SCRIPT" || exit "$EXIT_SCRIPT"; } - if [[ "$contains_halt" == "true" ]]; then - do_DEBUG "METTA_CMD: $METTA_CMD" - fi - #( - trap 'cleanup' EXIT - IF_REALLY_DO eval "$METTA_CMD" - IF_REALLY_DO "echo $? > '$TEMP_EXIT_CODE_FILE'" - #) + [[ "$wants_print_help" == "1" ]] && { print_help; [[ "$IS_SOURCED" == "1" ]] && return "$EXIT_SCRIPT" || exit "$EXIT_SCRIPT"; } + [[ -n "${EXIT_SCRIPT+x}" ]] && { [[ "$IS_SOURCED" == "1" ]] && return "$EXIT_SCRIPT" || exit "$EXIT_SCRIPT"; } + if [[ "$contains_halt" == "true" ]]; then + do_DEBUG "METTA_CMD: $METTA_CMD" + fi + execute_with_pipes + IF_REALLY_DO "echo $? > '$TEMP_EXIT_CODE_FILE'" fi +cd "${RPWD}" From 101182867d7b156926881acf64bbd4891ef88f38 Mon Sep 17 00:00:00 2001 From: TeamSPoon Date: Sat, 24 Aug 2024 12:18:09 -0700 Subject: [PATCH 27/77] py_* trampolines --- .Attic/metta_lang/metta_printer.pl | 11 ++- .Attic/metta_lang/metta_python.pl | 120 +++++++++++++++++++++++++---- 2 files changed, 112 insertions(+), 19 deletions(-) diff --git a/.Attic/metta_lang/metta_printer.pl b/.Attic/metta_lang/metta_printer.pl index 5c318fed386..450d66d6d6a 100755 --- a/.Attic/metta_lang/metta_printer.pl +++ b/.Attic/metta_lang/metta_printer.pl @@ -139,16 +139,19 @@ setup_call_cleanup(nb_setval(W,true), once(Mesg),nb_setval(W,false)),nb_setval(W,false). -py_is_enabled:- predicate_property(py_is_object(_),foreign). +:- dynamic(py_is_enabled/0). +py_is_enabled:- predicate_property(py_is_object(_),foreign), asserta((py_is_enabled:-!)). -write_src(V):- \+ \+ quietly(pp_sex(V)),!. + +%write_src(V):- !, \+ \+ quietly(pp_sex(V)),!. +write_src(V):- \+ \+ (pp_sex(V)),!. pp_sex(V):- pp_sexi(V),!. % Various 'write_src' and 'pp_sex' rules are handling the writing of the source, % dealing with different types of values, whether they are lists, atoms, numbers, strings, compounds, or symbols. pp_sexi(V):- is_final_write(V),!. -pp_sexi(V):- atomic(V),py_is_enabled,py_is_object(V),metta_py_pp(V),!. -pp_sexi(V):- py_is_enabled,once((py_is_object(V),py_to_pl(V,PL))),V\=@=PL,!,print(PL). +pp_sexi(V):- atomic(V),py_is_enabled,py_is_object(V),!,py_ppp(V),!. +pp_sexi(V):- py_is_enabled,py_ppp(V),!. pp_sexi(V):- is_dict(V),!,print(V). pp_sexi((USER:Body)) :- USER==user,!, pp_sex(Body). pp_sexi(V):- allow_concepts,!,with_concepts('False',pp_sex(V)),flush_output. diff --git a/.Attic/metta_lang/metta_python.pl b/.Attic/metta_lang/metta_python.pl index 32ae4fdb31f..2f5b2cc8b99 100755 --- a/.Attic/metta_lang/metta_python.pl +++ b/.Attic/metta_lang/metta_python.pl @@ -124,6 +124,12 @@ local_vars = locals() return exec(s,global_vars,local_vars) +def py_nth(s,nth): + return s[nth] + +def identity(s): + return s + def get_globals(): return globals() @@ -165,9 +171,27 @@ def string_representation(s): return repr(s) -def get_length(s): +def py_len(s): return len(s) +def py_list(s): + return list(s) + +def py_dict(s): + return dict(s) + +def py_dict0(): + return dict() + +def py_map(s): + return map(s) + +def py_tuple(s): + return tuple(s) + +def py_set(s): + return set(s) + def absolute_value(num): return abs(num) @@ -231,6 +255,9 @@ def isinstance_of(obj, classinfo): return isinstance(obj, classinfo) +def print_nonl(sub): + return print(sub, end="") + def issubclass_of(sub, superclass): return issubclass(sub, superclass) @@ -277,7 +304,23 @@ '). +pych_chars(Chars,P):- \+ is_list(Chars), !, P = Chars. +pych_chars(Chars,P):- append(O,`\r@(none)`,Chars),!,pych_chars(O,P). +pych_chars(Chars,P):- append(O,`\n@(none)`,Chars),!,pych_chars(O,P). +pych_chars(Chars,P):- append(O,`@(none)`,Chars),!,pych_chars(O,P). +pych_chars(Chars,P):- append(O,[WS],Chars),code_type(WS,new_line),!,pych_chars(O,P). +pych_chars(Chars,P):- append(O,[WS],Chars),code_type(WS,end_of_line),!,pych_chars(O,P). +pych_chars(P,P). + +py_ppp(V):-flush_output, with_output_to(codes(Chars), once(py_pp(V))), + pych_chars(Chars,P),!,format('~s',[P]),!,flush_output. + +%atom_codes(Codes,P),writeq(Codes), +%py_ppp(V):- !, flush_output, py_mbi(print_nonl(V),_),!,flush_output. +%py_ppp(V):- writeq(py(V)),!. +%py_ppp(V):-once((py_is_object(V),py_to_pl(V,PL))),V\=@=PL,!,print(PL). +%py_ppp(V):-metta_py_pp(V). % Evaluations and Iterations load_hyperon_module:- py_module(hyperon_module, @@ -308,11 +351,18 @@ py_mcall(I,O):- catch(py_call(I,M,[py_object(false),py_string_as(string),py_dict_as({})]),error(_,_),fail),!,O=M. +py_scall(I,O):- catch(py_call(I,M,[py_string_as(string)]),error(_,_),fail),!,O=M. +py_acall(I,O):- catch(py_call(I,M,[py_string_as(atom)]),error(_,_),fail),!,O=M. +py_ocall(I,O):- catch(py_call(I,M,[py_object(true),py_string_as(string)]),error(_,_),fail),!,O=M. -get_str_rep(I,O):- py_mcall(builtin_module:get_str_rep(I),O),!. +py_bi(I,O,Opts):- catch(py_call(builtin_module:I,M,Opts),error(_,_),fail),!,O=M. +py_obi(I,O):- py_ocall(builtin_module:I,O). +py_mbi(I,O):- py_mcall(builtin_module:I,O). +%?- py_call(type(hi-there), P),py_pp(P). +get_str_rep(I,O):- py_mbi(get_str_rep(I),O),!. py_atom(I,O):- var(I),!,O=I. -py_atom([I|Is],O):-!, py_dot(I,II),py_dot_from(II,Is,O). +py_atom([I|Is],O):-!, py_dot(I,II),py_dot_from(II,Is,O),!. py_atom(I,O):- atomic(I),!,py_atomic(I,O). py_atom(I,O):- py_mcall(I,O),!. py_atom(I,O):- I=O. @@ -332,12 +382,12 @@ py_atomic(I,O):- string(I), py_dot(I,O),!. py_atomic(I,O):- I=O. -get_globals(O):- py_mcall(builtin_module:get_globals(),O). -get_locals(O):- py_mcall(builtin_module:get_locals(),O). -merge_modules_and_globals(O):- py_mcall(builtin_module:merge_modules_and_globals(),O). -py_eval(I,O):- py_mcall(builtin_module:eval_string(I),O). +get_globals(O):- py_mbi(get_globals(),O). +get_locals(O):- py_mbi(get_locals(),O). +merge_modules_and_globals(O):- py_mbi(merge_modules_and_globals(),O). +py_eval(I,O):- py_mbi(eval_string(I),O). py_eval(I):- py_eval(I,O),pybug(O). -py_exec(I,O):- py_mcall(builtin_module:exec_string(I),O). +py_exec(I,O):- py_mbi(exec_string(I),O). py_exec(I):- py_exec(I,O),pybug(O). py_dot(I,O):- string(I),atom_string(A,I),py_atom(A,O),A\==O,!. @@ -484,6 +534,8 @@ py_to_pl(VL, Par, Cir, CirO, O, E) :- py_is_object(O), py_class(O, Cl), !, pyo_to_pl(VL, Par, [O = E | Cir], CirO, Cl, O, E). % If L is in the Cir list, unify E with L. + +%py_to_pl(_VL,_Par,Cir,Cir,L,E):- py_is_dict(L),!,py_mbi(identity(L),E). py_to_pl(_VL,_Par,Cir,Cir,L,E):- member(N-NE,Cir), N==L, !, (E=L;NE=E), !. % If LORV is a variable or nil, unify it directly. py_to_pl(_VL,_Par,Cir,Cir, LORV:B,LORV:B):- is_var_or_nil(LORV), !. @@ -578,17 +630,55 @@ %pyo_to_pl(_VL,_Par,Cir,Cir,Cl,O,E):- get_str_rep(O,Str), E=..[Cl,Str]. pyo_to_pl(_VL,_Par,Cir,Cir,_Cl,O,E):- O = E,!. +pl_to_rust(Var,Py):- pl_to_rust(_VL,Var,Py). +pl_to_rust(VL,Var,Py):- var(VL),!,ignore(VL=[vars]),pl_to_rust(VL,Var,Py). + +pl_to_rust(_VL,Sym,Py):- is_list(Sym),!, maplist(pl_to_rust,Sym,PyL), py_call(src:'mettalog':'MkExpr'(PyL),Py),!. +pl_to_rust(VL,Var,Py):- var(Var), !, real_VL_var(Sym,VL,Var), py_call('hyperon.atoms':'V'(Sym),Py),!. +pl_to_rust(VL,'$VAR'(Sym),Py):- !, real_VL_var(Sym,VL,_),py_call('hyperon.atoms':'V'(Sym),Py),!. +pl_to_rust(VL,DSym,Py):- atom(DSym),atom_concat('$',VName,DSym), rinto_varname(VName,Sym),!, pl_to_rust(VL,'$VAR'(Sym),Py). +pl_to_rust(_VL,Sym,Py):- atom(Sym),!, py_call('hyperon.atoms':'S'(Sym),Py),!. +%pl_to_rust(VL,Sym,Py):- is_list(Sym), maplist(pl_to_rust,Sym,PyL), py_call('hyperon.atoms':'E'(PyL),Py),!. +pl_to_rust(_VL,Sym,Py):- string(Sym),!, py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. +pl_to_rust(_VL,Sym,Py):- py_is_object(Sym),py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. +pl_to_rust(_VL,Sym,Py):- py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. + +py_list(MeTTa,PyList):- pl_to_py(MeTTa,PyList). +py_tuple(O,Py):- py_mcall(tuple(O),Py),!. +py_tuple(O,Py):- py_mbi(py_tuple(O),Py),!. +py_dict(O,Py):- py_mcall(dict(O),Py),!. +py_dict(O,Py):- catch(py_is_dict(O),_,fail),!,O=Py. + +% ?- py_list([1, 2.0, "string"], X),py_type(X,Y). +% ?- py_list_index([1, 2.0, "string"], X),py_type(X,Y). +py_nth(L,Nth,E):- py_mbi(py_nth(L,Nth),E). +py_len(L,E):- py_mbi(py_len(L),E). +py_o(O,Py):- py_obi(identity(O),Py),!. +py_m(O,Py):- py_mbi(identity(O),Py),!. pl_to_py(Var,Py):- pl_to_py(_VL,Var,Py). pl_to_py(VL,Var,Py):- var(VL),!,ignore(VL=[vars]),pl_to_py(VL,Var,Py). -pl_to_py(_VL,Sym,Py):- is_list(Sym),!, maplist(pl_to_py,Sym,PyL), py_call(src:'mettalog':'MkExpr'(PyL),Py),!. +pl_to_py(_VL,Sym,Py):- py_is_object(Sym),!,Sym=Py. +%pl_to_py(_VL,O,Py):- py_is_dict(O),!,py_obi(identity(O),Py). +pl_to_py(_VL,MeTTa,Python):- float(MeTTa), !, py_obi(float_conversion(MeTTa),Python). +pl_to_py(_VL,MeTTa,Python):- string(MeTTa), !, py_obi(string_conversion(MeTTa),Python). +pl_to_py(_VL,MeTTa,Python):- integer(MeTTa), !, py_obi(int_conversion(MeTTa),Python). +pl_to_py(VL,Sym,Py):- is_list(Sym),!, maplist(pl_to_py(VL),Sym,PyL), py_obi(py_list(PyL),Py). pl_to_py(VL,Var,Py):- var(Var), !, real_VL_var(Sym,VL,Var), py_call('hyperon.atoms':'V'(Sym),Py),!. pl_to_py(VL,'$VAR'(Sym),Py):- !, real_VL_var(Sym,VL,_),py_call('hyperon.atoms':'V'(Sym),Py),!. -pl_to_py(VL,DSym,Py):- atom(DSym),atom_concat('$',VName,DSym), rinto_varname(VName,Sym),!, pl_to_py(VL,'$VAR'(Sym),Py). -pl_to_py(_VL,Sym,Py):- atom(Sym),!, py_call('hyperon.atoms':'S'(Sym),Py),!. -pl_to_py(_VL,Sym,Py):- string(Sym),!, py_call('hyperon.atoms':'S'(Sym),Py),!. +pl_to_py(_VL,O,Py):- py_type(O,_),!,O=Py. +% % %pl_to_py(_VL,O,Py):- py_is_dict(O),!,O=Py. +%pl_to_py(VL,DSym,Py):- atom(DSym),atom_concat('$',VName,DSym), rinto_varname(VName,Sym),!, pl_to_py(VL,'$VAR'(Sym),Py). +%pl_to_py(_VL,Sym,Py):- atom(Sym),!, py_call('hyperon.atoms':'S'(Sym),Py),!. +%pl_to_py(_VL,Sym,Py):- string(Sym),!, py_call('hyperon.atoms':'S'(Sym),Py),!. %pl_to_py(VL,Sym,Py):- is_list(Sym), maplist(pl_to_py,Sym,PyL), py_call('hyperon.atoms':'E'(PyL),Py),!. -pl_to_py(_VL,Sym,Py):- py_is_object(Sym),py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. -pl_to_py(_VL,Sym,Py):- py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. +%pl_to_py(_VL,Sym,Py):- py_is_object(Sym),py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. +pl_to_py(_VL,MeTTa,MeTTa). +%pl_to_py(_VL,Sym,Py):- py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. + +py_key(O,I):- py_m(O,M),key(M,I). +py_items(O,I):- py_m(O,M),items(M,I). +%py_values(O,K,V):- py_m(O,M),values(M,K,V). +py_values(O,K,V):- py_items(O,L),member(K:V,L). %elements(Atoms,E):- is_list(Atoms),!, meets_dir(L,M):- atom(M),!,member(M,L),!. @@ -606,7 +696,7 @@ with_output_to(string(Str),py_pp(PyObj,[nl(false)])). tafs:- - atoms_from_space(Space, _),py_to_pl(VL,Space,AA), print_tree(aa(Pl,aa)),pl_to_py(VL,AA,Py), print_tree(py(Pl,py)),pl_to_py(VL,Py,Pl),print_tree(pl(Pl,pl)) + atoms_from_space(Space, _),py_to_pl(VL,Space,AA), print_tree(aa(Pl,aa)),pl_to_rust(VL,AA,Py), print_tree(py(Pl,py)),pl_to_rust(VL,Py,Pl),print_tree(pl(Pl,pl)) , atoms_from_space(Space, [A]),py_to_pl(VL,A,AA), atoms_from_space(Space, [A]),py_obj_dir(A,D),writeq(D),!,py_to_pl(VL,D:get_object(),AA),writeq(AA),!,fail. From 1b796770b53f224c4060265a1fa28ce5fef26eee Mon Sep 17 00:00:00 2001 From: TeamSPoon Date: Sat, 24 Aug 2024 12:24:42 -0700 Subject: [PATCH 28/77] initial starts of py-* --- .Attic/metta_lang/metta_eval.pl | 29 +++++++++++++++++++++++++++-- 1 file changed, 27 insertions(+), 2 deletions(-) diff --git a/.Attic/metta_lang/metta_eval.pl b/.Attic/metta_lang/metta_eval.pl index 218a378ec24..f36dd1dac6f 100755 --- a/.Attic/metta_lang/metta_eval.pl +++ b/.Attic/metta_lang/metta_eval.pl @@ -60,6 +60,8 @@ :- multifile(color_g_mesg/2). self_eval0(X):- \+ callable(X),!. +self_eval0(X):- py_is_object(X),!. +self_eval0(X):- py_type(X,List), List\==list,!. self_eval0(X):- is_valid_nb_state(X),!. %self_eval0(X):- string(X),!. %self_eval0(X):- number(X),!. @@ -274,6 +276,16 @@ eval_20(Eq,RetType,Depth,Self,X,Y):- atom(Eq), ( Eq \== ('=')) ,!, call(Eq,'=',RetType,Depth,Self,X,Y). + +eval_20(_Eq,_RetType,_Depth,_Self,[V|VI],VO):- atomic(V), py_is_object(V),!, + is_list(VI),!, py_eval_object([V|VI],VO). + +eval_20(Eq,RetType,Depth,Self,[V|VI],VO):- is_list(V), V \== [], + eval_20(Eq,_FRype,Depth,Self,V,VV), V\==VV, atomic(VV), !, + eval_20(Eq,RetType,Depth,Self,[VV|VI],VO). + + + % DMILES @ TODO make sure this isnt an implicit curry eval_20(Eq,_RetType,Depth,Self,[V|VI],VO):- \+ callable(V), is_list(VI),!, maplist(eval_ret(Eq,_ArgRetType,Depth,Self),[V|VI],VOO),VO=VOO. @@ -1659,8 +1671,8 @@ RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), RetVal). -eval_20(Eq,RetType,_Dpth,_Slf,['py-list',Atom_list],CDR_Y):- - !, Atom=[_|CDR],!,do_expander(Eq,RetType,Atom_list, CDR_Y ). +%eval_20(Eq,RetType,_Dpth,_Slf,['py-list',Atom_list],CDR_Y):- +% !, Atom=[_|CDR],!,do_expander(Eq,RetType,Atom_list, CDR_Y ). eval_20(Eq,RetType,Depth,Self,['intersection',Eval1,Eval2],RetVal):- !, lazy_intersection(RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), @@ -1783,6 +1795,19 @@ must_det_ll((rust_metta_run(exec(PredDecl),Res), nop(write_src(res(Res))))). +eval_70(_Eq,_RetType,_Depth,_Self,['py-atom',Arg],Res):- !, + must_det_ll((py_atom(Arg,Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-atom',Arg,Type],Res):- !, + must_det_ll((py_atom_type(Arg,Type,Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-dot',Arg1,Arg2],Res):- !, + must_det_ll((py_dot([Arg1,Arg2],Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-list',Arg],Res):- !, + must_det_ll((py_list(Arg,Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-dict',Arg],Res):- !, + must_det_ll((py_dict(Arg,Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-tuple',Arg],Res):- !, + must_det_ll((py_tuple(Arg,Res))). + eval_40(Eq,RetType,Depth,Self,['length',L],Res):- !, eval_args(Depth,Self,L,LL), (is_list(LL)->length(LL,Res);Res=1), check_returnval(Eq,RetType,Res). From 6ac8097f076d48b967812135ddbb6aa00f496f3f Mon Sep 17 00:00:00 2001 From: TeamSPoon Date: Sat, 24 Aug 2024 13:17:42 -0700 Subject: [PATCH 29/77] copy_outter_venv --- scripts/ensure_venv | 33 +++++++++++++++++++++++++++++---- 1 file changed, 29 insertions(+), 4 deletions(-) diff --git a/scripts/ensure_venv b/scripts/ensure_venv index 9b94eb10deb..e820e82ffeb 100755 --- a/scripts/ensure_venv +++ b/scripts/ensure_venv @@ -1,11 +1,21 @@ #!/bin/bash # Name of the virtual environment directory +# Check if VENV_DIR is not set or is empty +if [ -z "$VENV_DIR" ]; then + # Then check if VIRTUAL_ENV is set and points to a valid directory + if [ -n "$VIRTUAL_ENV" ] && [ -d "$VIRTUAL_ENV" ]; then + # If VIRTUAL_ENV is valid, use it for VENV_DIR + VENV_DIR="$VIRTUAL_ENV" + else + # Otherwise, default to 'venv' VENV_DIR="venv" + fi +fi # Function to activate the virtual environment activate_venv() { - echo "Activating the virtual environment..." + echo "Activating the virtual environment: $VENV_DIR" source "$VENV_DIR/bin/activate" } @@ -22,16 +32,31 @@ is_inside_venv() { # Function to create a virtual environment create_venv() { if [ ! -d "$VENV_DIR" ]; then - echo "Creating a virtual environment..." + echo "Creating a virtual environment: $VENV_DIR" python3 -m venv "$VENV_DIR" + # Assuming the script is run from a virtual environment with useful packages + if [ -n "$VIRTUAL_ENV" ] && [ -d "$VIRTUAL_ENV" ]; then + echo "Inheriting packages from existing environment: $VIRTUAL_ENV" + source "$VIRTUAL_ENV/bin/activate" + pip freeze > /tmp/requirements.txt + deactivate + activate_venv + pip install -r /tmp/requirements.txt + rm /tmp/requirements.txt + fi + if [ -f "requirements.txt" ]; then + : + #echo "Found local requirements.txt, installing packages..." + #pip install -r requirements.txt + fi else - echo "Virtual environment already exists." + echo "Virtual environment already exists: $VENV_DIR" fi } # Main logic of the script if is_inside_venv; then - echo "Script is running inside a virtual environment." + echo "Script is running inside a virtual environment: $VIRTUAL_ENV" else echo "Script is not running inside a virtual environment." create_venv From 4ff2d20481b3e64e1163460b5f774df98fb5854b Mon Sep 17 00:00:00 2001 From: TeamSPoon Date: Sat, 24 Aug 2024 13:18:33 -0700 Subject: [PATCH 30/77] ensure_loaded(metta_python). --- .Attic/metta_lang/metta_interp.pl | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/.Attic/metta_lang/metta_interp.pl b/.Attic/metta_lang/metta_interp.pl index 6a591acaa05..9ce92f03af2 100755 --- a/.Attic/metta_lang/metta_interp.pl +++ b/.Attic/metta_lang/metta_interp.pl @@ -74,7 +74,7 @@ is_win64:- current_prolog_flag(windows,_). is_win64_ui:- is_win64,current_prolog_flag(hwnd,_). - +dont_change_streams:- true. :- dynamic(user:is_metta_src_dir/1). :- prolog_load_context(directory,Dir), @@ -208,6 +208,7 @@ is_compatio0:- !. keep_output:- !. +keep_output:- dont_change_streams,!. keep_output:- is_win64,!. keep_output:- is_mettalog,!. keep_output:- is_testing,!. @@ -222,6 +223,7 @@ unnullify_output:- current_output(MFS), original_user_output(OUT), MFS==OUT, !. unnullify_output:- original_user_output(MFS), set_prolog_IO(user_input,MFS,user_error). +null_output(MFS):- dont_change_streams,!, original_user_output(MFS),!. null_output(MFS):- use_module(library(memfile)), new_memory_file(MF),open_memory_file(MF,append,MFS). :- dynamic(null_user_output/1). @@ -230,11 +232,12 @@ nullify_output:- keep_output,!. +nullify_output:- dont_change_streams,!. nullify_output:- nullify_output_really. nullify_output_really:- current_output(MFS), null_user_output(OUT), MFS==OUT, !. nullify_output_really:- null_user_output(MFS), set_prolog_IO(user_input,MFS,MFS). -%set_output_stream :- !. +set_output_stream :- dont_change_streams,!. set_output_stream :- \+ keep_output -> nullify_output; unnullify_output. :- set_output_stream. % :- nullify_output. @@ -970,7 +973,7 @@ %rtrace_on_error(G):- catch(G,_,fail). rtrace_on_error(G):- catch_err(G,E, - (notrace, + (%notrace, write_src_uo(E=G), %catch(rtrace(G),E,throw(E)), catch(rtrace(G),E,throw(give_up(E=G))), @@ -982,7 +985,7 @@ ignore(rtrace(G)), write_src_uo(rtrace_on_failure(G)), !,fail)),E, - (notrace, + (%notrace, write_src_uo(E=G), %catch(rtrace(G),E,throw(E)), catch(rtrace(G),E,throw(give_up(E=G))), @@ -994,7 +997,7 @@ ignore(rtrace(G)), write_src(rtrace_on_failure(G)), !,break,fail)),E, - (notrace, + (%notrace, write_src_uo(E=G), %catch(rtrace(G),E,throw(E)), catch(rtrace(G),E,throw(give_up(E=G))), @@ -1787,17 +1790,19 @@ :- ensure_loaded(metta_server). :- initialization(update_changed_files,restore). -nts:- !. +%nts:- !. nts:- redefine_system_predicate(system:notrace/1), abolish(system:notrace/1), meta_predicate(system:notrace(0)), asserta((system:notrace(G):- (!,once(G)))). nts:- !. +:- nts. + nts0:- redefine_system_predicate(system:notrace/0), abolish(system:notrace/0), asserta((system:notrace:- wdmsg(notrace))). - +%:- nts0. override_portray:- forall( @@ -1833,6 +1838,7 @@ %:- ensure_loaded('../../library/genome/flybase_loader'). +:- ensure_loaded(metta_python). :- initialization(use_corelib_file). :- ignore((( From 98aeb9fc059889436d7903a591a06c6c9182ab2e Mon Sep 17 00:00:00 2001 From: TeamSPoon Date: Sat, 24 Aug 2024 13:20:23 -0700 Subject: [PATCH 31/77] Added generation of WHOLE-TESTS. --- scripts/test_in_metta.sh | 75 ++++++++++++++++++++++++++++++++++------ 1 file changed, 65 insertions(+), 10 deletions(-) diff --git a/scripts/test_in_metta.sh b/scripts/test_in_metta.sh index faf2df9544b..fa44ba4a225 100755 --- a/scripts/test_in_metta.sh +++ b/scripts/test_in_metta.sh @@ -1,7 +1,10 @@ #!/bin/bash SHOULD_EXIT=0 + +if [ -z "$SHARED_UNITS" ]; then export SHARED_UNITS=/tmp/SHARED.UNITS +fi DEBUG_WHY() { DEBUG "${GREEN}WHY: ${BOLD}${*}${NC}" @@ -156,20 +159,71 @@ process_file() { TEST_CMD="./mettalog '--output=$METTALOG_OUTPUT' --timeout=$METTALOG_MAX_TIME --html --repl=false ${extra_args[@]} ${passed_along_to_mettalog[@]} \"$file\" --halt=true" # DEBUG "${BOLD}$TEST_CMD${NC}" - IF_REALLY_DO "$TEST_CMD" - TEST_EXIT_CODE=$? + + EXTRA_INFO="Under $METTALOG_MAX_TIME seconds" + + # Start the timer + local START_TIME=$(date +%s) + + # Run the test command using eval to handle the single string properly + IF_REALLY_DO eval "$TEST_CMD" + local TEST_EXIT_CODE=$? + + # Stop the timer and calculate elapsed time + local END_TIME=$(date +%s) + local ELAPSED_TIME=$((END_TIME - START_TIME)) + + # Determine the test status based on the exit code + local DEBUG_MESSAGE + local PASS_OR_FAIL + local SHOULD_DELETE_HTML=0 if [ $TEST_EXIT_CODE -eq 124 ]; then - DEBUG "${RED}Killed (definitely due to timeout) (EXITCODE=$TEST_EXIT_CODE) after $METTALOG_MAX_TIME seconds: ${TEST_CMD}${NC}" - IF_REALLY_DO [ "$if_failures" -eq 1 ] && rm -f "$file_html" + DEBUG_MESSAGE="${RED}Killed (definitely due to timeout) (EXITCODE=$TEST_EXIT_CODE) after $EXTRA_INFO seconds: $TEST_CMD${NC}" + [ "$if_failures" -eq 1 ] && SHOULD_DELETE_HTML=1 + PASS_OR_FAIL="FAIL" elif [[ $TEST_EXIT_CODE -eq 4 ]] || [[ $TEST_EXIT_CODE -eq 134 ]]; then - DEBUG "${RED}Stopping tests (EXITCODE=$TEST_EXIT_CODE) under $METTALOG_MAX_TIME seconds: ${TEST_CMD}${NC}" - SHOULD_EXIT=1 + DEBUG_MESSAGE="${RED}Stopping tests (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" + SHOULD_DELETE_HTML=1 + PASS_OR_FAIL="FAIL" elif [ $TEST_EXIT_CODE -ne 7 ]; then - DEBUG "${YELLOW}Completed (EXITCODE=$TEST_EXIT_CODE) under $METTALOG_MAX_TIME seconds: ${TEST_CMD}${NC}" + DEBUG_MESSAGE="${YELLOW}Completed (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" + PASS_OR_FAIL="FAIL" else - DEBUG "${GREEN}Completed successfully (EXITCODE=$TEST_EXIT_CODE) under $METTALOG_MAX_TIME seconds: ${TEST_CMD}${NC}" + DEBUG_MESSAGE="${GREEN}Completed successfully (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" + PASS_OR_FAIL="PASS" fi + + # Generate the test name in the format WHOLE-TESTS.ParentDirectory.File + local PARENT_DIR=$(basename "$(dirname "$file")") + local BASE_FILE=$(basename "$file" .metta) # Replace .metta with the correct file extension + local TEST_NAME="WHOLE-TESTS.$PARENT_DIR.$BASE_FILE" + + # Generate the HTML link + local HTML_LINK="file://$file_html#${TEST_NAME}" + + # Determine if the HTML file should be used as the logfile or a separate .log file should be created + local LOGFILE + if [ $SHOULD_DELETE_HTML -eq 1 ]; then + # Create a separate .log file since the HTML file is planned for deletion + LOGFILE="${file_html}.log" + cp "$file_html" "$LOGFILE" + else + # Use the HTML file as the logfile since it won't be deleted + LOGFILE="$file_html" + fi + + # Redirect debug messages to both the logfile and console + echo "$DEBUG_MESSAGE" | tee -a "$LOGFILE" + + # Write the line to /tmp/SHARED.UNITS + echo "| $TEST_NAME | $PASS_OR_FAIL | [$TEST_NAME]($HTML_LINK) | $TEST_CMD | $TEST_EXIT_CODE | 7 | $ELAPSED_TIME seconds | $LOGFILE |" >> /tmp/SHARED.UNITS + + # Delete the HTML file if it was planned for deletion + if [ $SHOULD_DELETE_HTML -eq 1 ]; then + rm -f "$file_html" + fi + return $TEST_EXIT_CODE #set -e fi @@ -184,7 +238,7 @@ IS_SOURCED=$( [[ "${BASH_SOURCE[0]}" != "${0}" ]] && echo 1 || echo 0) METTALOG_DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && cd .. && pwd )" passed_along_to_mettalog=() -METTALOG_MAX_TIME=75 +METTALOG_MAX_TIME=45 SCRIPT_NAME=$(basename "$0") run_tests_auto_reply="" @@ -664,7 +718,8 @@ DEBUG "INTERP_SRC_DIR=$INTERP_SRC_DIR" DEBUG "METTALOG_OUTPUT=$METTALOG_OUTPUT" if [[ ! -f "${METTALOG_OUTPUT}/src/" ]]; then - cat /dev/null > "${SHARED_UNITS}" + : + #cat /dev/null > "${SHARED_UNITS}" fi mkdir -p "${METTALOG_OUTPUT}/src/" From 9939349bb559bcf3b5f4cd51f3bb0a11d80dbb26 Mon Sep 17 00:00:00 2001 From: TeamSPoon Date: Sat, 24 Aug 2024 16:44:47 -0700 Subject: [PATCH 32/77] gen_interp_stubs --- .Attic/metta_lang/metta_corelib.pl | 7 +- .Attic/metta_lang/metta_eval.pl | 49 +++-- .Attic/metta_lang/metta_interp.pl | 248 +++++++++--------------- .Attic/metta_lang/metta_printer.pl | 16 +- .Attic/metta_lang/stdlib_mettalog.metta | 5 + 5 files changed, 155 insertions(+), 170 deletions(-) diff --git a/.Attic/metta_lang/metta_corelib.pl b/.Attic/metta_lang/metta_corelib.pl index ed84feb9108..4c98d63977b 100755 --- a/.Attic/metta_lang/metta_corelib.pl +++ b/.Attic/metta_lang/metta_corelib.pl @@ -285,7 +285,12 @@ use_corelib_file:- using_corelib_file,!. use_corelib_file:- asserta(using_corelib_file), fail. -use_corelib_file:- load_corelib_file. +use_corelib_file:- load_corelib_file, generate_interpreter_stubs. + +generate_interpreter_stubs:- + forall(metta_type('&corelib',Symb,Def), + gen_interp_stubs('&corelib',Symb,Def)). + load_corelib_file:- is_metta_src_dir(Dir), really_use_corelib_file(Dir,'corelib.metta'),!. load_corelib_file:- is_metta_src_dir(Dir), really_use_corelib_file(Dir,'stdlib_mettalog.metta'),!. % !(import! &corelib "src/canary/stdlib_mettalog.metta") diff --git a/.Attic/metta_lang/metta_eval.pl b/.Attic/metta_lang/metta_eval.pl index f36dd1dac6f..55f649b0297 100755 --- a/.Attic/metta_lang/metta_eval.pl +++ b/.Attic/metta_lang/metta_eval.pl @@ -60,8 +60,8 @@ :- multifile(color_g_mesg/2). self_eval0(X):- \+ callable(X),!. -self_eval0(X):- py_is_object(X),!. -self_eval0(X):- py_type(X,List), List\==list,!. +self_eval0(X):- py_is_py(X),!. +%self_eval0(X):- py_type(X,List), List\==list,!. self_eval0(X):- is_valid_nb_state(X),!. %self_eval0(X):- string(X),!. %self_eval0(X):- number(X),!. @@ -284,6 +284,9 @@ eval_20(Eq,_FRype,Depth,Self,V,VV), V\==VV, atomic(VV), !, eval_20(Eq,RetType,Depth,Self,[VV|VI],VO). +eval_20(Eq,RetType,Depth,Self,[F,[Eval,V]|VI],VO):- Eval == eval,!, + ((eval_args(Eq,_FRype,Depth,Self,V,VV), V\=@=VV)*-> true; VV = V), + eval_20(Eq,RetType,Depth,Self,[F,VV|VI],VO). % DMILES @ TODO make sure this isnt an implicit curry @@ -487,18 +490,27 @@ eval_20(Eq,RetType,Depth,Self,['profile!',Cond],Res):- !, time_eval(profile(Cond),profile(eval_args(Eq,RetType,Depth,Self,Cond,Res))). eval_20(Eq,RetType,Depth,Self,['time!',Cond],Res):- !, time_eval(eval_args(Cond),eval_args(Eq,RetType,Depth,Self,Cond,Res)). eval_20(Eq,RetType,Depth,Self,['print',Cond],Res):- !, eval_args(Eq,RetType,Depth,Self,Cond,Res),format('~N'),print(Res),format('~N'). +% !(print! $1) +eval_20(Eq,RetType,Depth,Self,['princ!'|Cond],Res):- !, + maplist(eval_args(Eq,RetType,Depth,Self),Cond,Out), + maplist(princ_impl,Out), + make_nop(RetType,[],Res),check_returnval(Eq,RetType,Res). % !(println! $1) eval_20(Eq,RetType,Depth,Self,['println!'|Cond],Res):- !, maplist(eval_args(Eq,RetType,Depth,Self),Cond,Out), maplist(println_impl,Out), make_nop(RetType,[],Res),check_returnval(Eq,RetType,Res). - +println_impl(X):- format("~N~@~N",[write_sln(X)]),!. println_impl(X):- user_io((ansi_format(fg('#c7ea46'),"~N~@~N",[write_sln(X)]))). +princ_impl(X):- format("~@",[write_sln(X)]),!. + write_sln(X):- string(X), !, write(X). -write_sln(X):- with_indents(false,write_src(X)). +write_sln(X):- write_src_woi(X). +with_output_to_str( Sxx , Goal ):- + wots( Sxx , Goal ). % ================================================================= % ================================================================= @@ -754,8 +766,6 @@ eval_20(Eq,RetType,Depth,Self,['switch',A,CL|T],Res):- !, eval_20(Eq,RetType,Depth,Self,['case',A,CL|T],Res). -eval_20(Eq,RetType,Depth,Self,[P,X|More],YY):- is_list(X),X=[_,_,_],simple_math(X), - eval_selfless_2(X,XX),X\=@=XX,!, eval_20(Eq,RetType,Depth,Self,[P,XX|More],YY). % if there is only a void then always return nothing for each Case eval_20(Eq,_RetType,Depth,Self,['case',A,[[Void,_]]],Res):- '%void%' == Void, @@ -1228,10 +1238,10 @@ format_args_write('#\\'(Arg),_) :- !, write(Arg). format_args_write(Arg,_) :- write_src_woi(Arg). -format_args([], _, _). -format_args(['{','{'|FormatRest], Iterator, Args) :- !, put('{'), format_args(FormatRest, Iterator, Args). % escaped -format_args(['}','}'|FormatRest], Iterator, Args) :- !, put('}'), format_args(FormatRest, Iterator, Args). % escaped -format_args(['{'|FormatRest1], Iterator1, Args) :- +format_nth_args([], _, _). +format_nth_args(['{','{'|FormatRest], Iterator, Args) :- !, put('{'), format_nth_args(FormatRest, Iterator, Args). % escaped +format_nth_args(['}','}'|FormatRest], Iterator, Args) :- !, put('}'), format_nth_args(FormatRest, Iterator, Args). % escaped +format_nth_args(['{'|FormatRest1], Iterator1, Args) :- format_args_get_index(FormatRest1, FormatRest2, Index), format_args_get_format(FormatRest2, ['}'|FormatRest3], Format), % check that the closing '}' is not escaped with another '}' @@ -1241,14 +1251,14 @@ -> ((nth0(Iterator1,Args,Arg),Iterator2 is Iterator1+1)) ; ((nth0(Index,Args,Arg), Iterator2 is Iterator1))), format_args_write(Arg,Format), - format_args(FormatRest3, Iterator2, Args). -format_args([C|FormatRest], Iterator, Args) :- put(C), format_args(FormatRest, Iterator, Args). + format_nth_args(FormatRest3, Iterator2, Args). +format_nth_args([C|FormatRest], Iterator, Args) :- put(C), format_nth_args(FormatRest, Iterator, Args). eval_20(Eq,RetType,Depth,Self,['format-args',Format,Args],Result):- eval_args(Eq,RetType,Depth,Self,Format,EFormat), eval_args(Eq,RetType,Depth,Self,Args,EArgs), is_list(EArgs),string_chars(EFormat, FormatChars), !, - user_io(with_output_to(string(Result), format_args(FormatChars, 0, EArgs))). + user_io(with_output_to_str( Result, format_nth_args(FormatChars, 0, EArgs))). eval_20(Eq,RetType,Depth,Self,['format-args',_Fmt,Args],_Result) :- eval_args(Eq,RetType,Depth,Self,Args,EArgs), \+ is_list(EArgs),!,throw_metta_return(['Error',Args,'BadType']). @@ -1257,6 +1267,16 @@ ignore(RetType='Bool'), !, as_tf(random(0,2,0),Bool), check_returnval(Eq,RetType,Bool). +eval_20( Eq, RetType, Depth, Self, [ 'parse' , L ] , Exp ):- !, + eval_args( Eq, RetType, Depth, Self, L, Str ), + once(parse_sexpr_metta1( Str, Exp )). + +eval_20( _Eq, _RetType, _Depth, _Self, [ 'repr' , L ] , Sxx ):- !, + %eval_args( Eq, RetType, Depth, Self, L, Lis2 ), + with_output_to_str( Sxx , write_src_woi( L ) ). + +eval_20( Eq, RetType, Depth, Self, [ 'output-to-string' , L ] , Sxx ):- !, + with_output_to_str( Sxx , eval_args( Eq, RetType, Depth, Self, L, _ )). % ================================================================= % ================================================================= @@ -1813,6 +1833,9 @@ check_returnval(Eq,RetType,Res). +eval_20(Eq,RetType,Depth,Self,[P,X|More],YY):- is_list(X),X=[_,_,_],simple_math(X), + eval_selfless_2(X,XX),X\=@=XX,!, eval_20(Eq,RetType,Depth,Self,[P,XX|More],YY). + /* eval_40(Eq,RetType,Depth,Self,[P,A,X|More],YY):- is_list(X),X=[_,_,_],simple_math(X), eval_selfless_2(X,XX),X\=@=XX,!, diff --git a/.Attic/metta_lang/metta_interp.pl b/.Attic/metta_lang/metta_interp.pl index 9ce92f03af2..03790c8955e 100755 --- a/.Attic/metta_lang/metta_interp.pl +++ b/.Attic/metta_lang/metta_interp.pl @@ -479,159 +479,101 @@ :- set_is_unit_test(false). -% ============================ -% %%%% Arithmetic Operations -% ============================ - -'repr'( Atomx, String_metta ):- eval_H( [ repr, Atomx ], String_metta ). -'parse'( Strx, Atom_metta ):- eval_H( [ parse, Strx ], Atom_metta ). - -% Addition -%'+'(A, B, Sum):- \+ any_floats([A, B, Sum]),!,Sum #= A+B . -%'+'(A, B, Sum):- notrace(catch_err(plus(A, B, Sum),_,fail)),!. -'+'(A, B, Sum):- eval_H([+,A,B],Sum). -% Subtraction -'-'( A, B, Sum):- eval_H([-,A,B],Sum). -% Multiplication -'*'(A, B, Product):- eval_H([*,A,B],Product). -% Division -'/'(Dividend, Divisor, Quotient):- eval_H(['/',Dividend, Divisor], Quotient). %{Dividend = Quotient * Divisor}. -% Modulus -'mod'(Dividend, Divisor, Remainder):- eval_H(['mod',Dividend, Divisor], Remainder). -'%'(Dividend, Divisor, Remainder):- eval_H(['mod',Dividend, Divisor], Remainder). -% Exponentiation -'exp'(Base, Exponent, Result):- eval_H(['exp', Base, Exponent], Result). -% Square Root -'sqrt'(Number, Root):- eval_H(['sqrt', Number], Root). - -% 'substraction'( Lx1, Lx2 , Lx_intersct ):- !, eval_H( [ 'substraction', Lx1, Lx2 ], Lx_intersct ). - -% ============================ -% %%%% List Operations -% ============================ -% Retrieve Head of the List -'car-atom'(List, Head):- eval_H(['car-atom', List], Head). -% Retrieve Tail of the List -'cdr-atom'(List, Tail):- eval_H(['cdr-atom', List], Tail). -% Construct a List -'Cons'(Element, List, 'Cons'(Element, List)):- !. -% Collapse List -'collapse'(List, CollapsedList):- eval_H(['collapse', List], CollapsedList). -% Count Elements in List -%'CountElement'(List, Count):- eval_H(['CountElement', List], Count). -% Find Length of List -%'length'(List, Length):- eval_H(['length', List], Length). - -% ============================ -% %%%% Nondet Opteration -% ============================ -% Superpose a List -'superpose'(List, SuperposedList):- eval_H(['superpose', List], SuperposedList). - -% ============================ -% %%%% Testing -% ============================ - -% `assertEqual` Predicate -% This predicate is used for asserting that the Expected value is equal to the Actual value. -% Expected: The value that is expected. -% Actual: The value that is being checked against the Expected value. -% Result: The result of the evaluation of the equality. -% Example: `assertEqual(5, 5, Result).` would succeed, setting Result to true (or some success indicator). -%'assertEqual'(Expected, Actual, Result):- use_metta_compiler,!,as_tf((Expected=Actual),Result). -'assertEqual'(Expected, Actual, Result):- ignore(Expected=Actual), eval_H(['assertEqual', Expected, Actual], Result). - -% `assertEqualToResult` Predicate -% This predicate asserts that the Expected value is equal to the Result of evaluating Actual. -% Expected: The value that is expected. -% Actual: The expression whose evaluation is being checked against the Expected value. -% Result: The result of the evaluation of the equality. -% Example: If Actual evaluates to the Expected value, this would succeed, setting Result to true (or some success indicator). -'assertEqualToResult'(Expected, Actual, Result):- eval_H(['assertEqualToResult', Expected, Actual], Result). - -% `assertNotEqual` Predicate -% This predicate asserts that the Expected value is not equal to the Actual value. -% Expected: The value that is expected not to match the Actual value. -% Actual: The value that is being checked against the Expected value. -% Result: The result of the evaluation of the inequality. -% Example: `assertNotEqual(5, 6, Result).` would succeed, setting Result to true (or some success indicator). -'assertNotEqual'(Expected, Actual, Result):- eval_H(['assertNotEqual', Expected, Actual], Result). - - -% `assertFalse` Predicate -% This predicate is used to assert that the evaluation of EvalThis is false. -% EvalThis: The expression that is being evaluated and checked for falsehood. -% Result: The result of the evaluation. -% Example: `assertFalse((1 > 2), Result).` would fail, setting Result to False (or some success indicator), as 1 > 2 is false. -'assertFalse'(EvalThis, Result):- eval_H(['assertFalse', EvalThis], Result). - -% `assertTrue` Predicate -% This predicate is used to assert that the evaluation of EvalThis is true. -% EvalThis: The expression that is being evaluated and checked for truth. -% Result: The result of the evaluation. -% Example: `assertTrue((2 > 1), Result).` would succeed, setting Result to true (or some success indicator), as 2 > 1 is true. -'assertTrue'(EvalThis, Result):- eval_H(['assertTrue', EvalThis], Result). - -% `rtrace` Predicate -% This predicate is likely used for debugging; possibly for tracing the evaluation of Condition. -% Condition: The condition/expression being traced. -% EvalResult: The result of the evaluation of Condition. -% Example: `rtrace((2 + 2), EvalResult).` would trace the evaluation of 2 + 2 and store its result in EvalResult. -'rtrace!'(Condition, EvalResult):- eval_H(['rtrace', Condition], EvalResult). - -% `time` Predicate -% This predicate is used to measure the time taken to evaluate EvalThis. -% EvalThis: The expression whose evaluation time is being measured. -% EvalResult: The result of the evaluation of EvalThis. -% Example: `time((factorial(5)), EvalResult).` would measure the time taken to evaluate factorial(5) and store its result in EvalResult. -'time!'(EvalThis, EvalResult):- eval_H(['time', EvalThis], EvalResult). - -% ============================ -% %%%% Debugging, Printing and Utility Operations -% ============================ -% REPL Evaluation -'repl!'(EvalResult):- eval_H(['repl!'], EvalResult). -% Condition Evaluation -'!'(Condition, EvalResult):- eval_H(['!', Condition], EvalResult). -% Import File into Environment -'import!'(Environment, Filename, Namespace):- eval_H(['import!', Environment, Filename], Namespace). -% Evaluate Expression with Pragma -'pragma!'(Environment, Expression, EvalValue):- eval_H(['pragma!', Environment, Expression], EvalValue). -% Print Message to Console -'print'(Message, EvalResult):- eval_H(['print', Message], EvalResult). -% No Operation, Returns EvalResult unchanged -'nop'(Expression, EvalResult):- eval_H(['nop', Expression], EvalResult). - -% ============================ -% %%%% Variable Bindings -% ============================ -% Bind Variables -'bind!'(Environment, Variable, Value):- eval_H(['bind!', Environment, Variable], Value). -% Let binding for single variable -'let'(Variable, Expression, Body, Result):- eval_H(['let', Variable, Expression, Body], Result). -% Sequential let binding -'let*'(Bindings, Body, Result):- eval_H(['let*', Bindings, Body], Result). - -% ============================ -% %%%% Reflection -% ============================ -% Get Type of Value -'get-type'(Value, Type):- eval_H(['get-type', Value], Type). -% 'get-type-space'(Space, Value, Type):- eval_H(['get-type', Space, Value], Type). - - -% ============================ -% %%%% String Utilities -% ============================ -% conversion between String and List of Chars -'stringToChars'(String, Chars) :- eval_H(['stringToChars', String], Chars). -'charsToString'(Chars, String) :- eval_H(['charsToString', Chars], String). -'format-args'(Format, Args, Result) :- eval_H(['format-args', Format, Args], Result). - -% ============================ -% %%%% Random Utilities -% ============================ -'flip'(Bool) :- eval_H(['flip'], Bool). % see `flip` in metta_eval.pl as `eval_20/6` +extract_prolog_arity([Arrow|ParamTypes],PrologArity):- + Arrow == ('->'),!, + len_or_unbound(ParamTypes,PrologArity). + +add_prolog_code(_KB,AssertZIfNew):- + fbug(writeln(AssertZIfNew)), + assertz_if_new(AssertZIfNew). +gen_interp_stubs(KB,Symb,Def):- + ignore((is_list(Def), + must_det_ll(( + extract_prolog_arity(Def,PrologArity), + symbol(Symb), + symbol_concat('i_',Symb,Tramp), + length(PrologArgs,PrologArity), + append(MeTTaArgs,[RetVal],PrologArgs), + TrampH =.. [Tramp|PrologArgs], + add_prolog_code(KB, + (TrampH :- eval_H([Symb|MeTTaArgs], RetVal))))))). + +% 'int_fa_format-args'(FormatArgs, Result):- eval_H(['format-args'|FormatArgs], Result). +% 'ext_fa_format-args'([EFormat, EArgs], Result):- int_format-args'(EFormat, EArgs, Result) +/* + +'ext_format-args'(Shared,Format, Args, EResult):- + pred_in('format-args',Shared,3), + argn_in(1,Shared,Format,EFormat), + argn_in(2,Shared,Args,EArgs), + argn_in(3,Shared,EResult,Result), + int_format-args'(Shared,EFormat, EArgs, Result), + arg_out(1,Shared,EFormat,Format), + arg_out(2,Shared,EArgs,Args), + arg_out(3,Shared,Result,EResult). + + you are goign to create the clause based on the first 2 args + +?- gen_form_body('format-args',3, HrnClause). + +HrnClause = + ('ext_format-args'(Shared, Arg1, Arg2, EResult):- + pred_in('format-args',Shared,3), + argn_in(1,Shared,Arg1,EArg1), + argn_in(2,Shared,Arg2,EArg2), + argn_in(3,Shared,EResult,Result), + 'int_format-args'(Shared,EArg1, EArg2, Result), + arg_out(1,Shared,EArg1,Arg1), + arg_out(2,Shared,EArg2,Arg2), + arg_out(3,Shared,Result,EResult)). + +*/ + + + +% Helper to generate head of the clause +generate_head(Shared,Arity, FormName, Args, Head) :- + atom_concat('ext_', FormName, ExtFormName), + number_string(Arity, ArityStr), + atom_concat(ExtFormName, ArityStr, FinalFormName), % Append arity to form name for uniqueness + append([FinalFormName, Shared | Args], HeadArgs), + Head =.. HeadArgs. + +% Helper to generate body of the clause, swapping arguments +generate_body(Shared,Arity, FormName, Args, EArgs, Body) :- + atom_concat('int_', FormName, IntFormName), + number_string(Arity, ArityStr), + atom_concat(IntFormName, ArityStr, FinalIntFormName), % Append arity to internal form name for uniqueness + reverse(EArgs, ReversedEArgs), % Reverse the order of evaluated arguments for internal processing + % Generate predicates for input handling + findall(argn_in(Index, Shared, Arg, EArg), + (nth1(Index, Args, Arg), nth1(Index, EArgs, EArg)), ArgIns), + % Internal processing call with reversed arguments + append([Shared | ReversedEArgs], IntArgs), + InternalCall =.. [FinalIntFormName | IntArgs], + % Generate predicates for output handling + findall(arg_out(Index, Shared, EArg, Arg), + (nth1(Index, EArgs, EArg), nth1(Index, Args, Arg)), ArgOuts), + % Combine predicates + PredIn = pred_in(FormName, Shared, Arity), + append([PredIn | ArgIns], [InternalCall | ArgOuts], BodyParts), + list_to_conjunction(BodyParts, Body). + +% Main predicate to generate form body clause +gen_form_body(FormName, Arity, Clause) :- + length(Args,Arity), + length(EArgs,Arity), + generate_head(Shared,Arity, FormName, Args, Head), + generate_body(Shared,Arity, FormName, Args, EArgs, Body), + Clause = (Head :- Body). + + +% Helper to format atoms +format_atom(Format, N, Atom) :- format(atom(Atom), Format, [N]). + + +% 'int_format-args'(Shared,Format, Args, Result):- +% .... actual impl .... diff --git a/.Attic/metta_lang/metta_printer.pl b/.Attic/metta_lang/metta_printer.pl index 450d66d6d6a..4d242f5be1b 100755 --- a/.Attic/metta_lang/metta_printer.pl +++ b/.Attic/metta_lang/metta_printer.pl @@ -142,16 +142,26 @@ :- dynamic(py_is_enabled/0). py_is_enabled:- predicate_property(py_is_object(_),foreign), asserta((py_is_enabled:-!)). +py_is_py(_):- \+ py_is_enabled, !, fail. +py_is_py(V):-var(V), get_attr(V,pyobj,X),!,nonvar(X),!. +py_is_py(V):-atom(V), py_is_object(V),!. +py_is_py(V):- is_list(V),!,fail. +py_is_py(V):-py_is_tuple(V),!. +py_is_py(V):-py_is_pdict(V),!. + +py_is_tuple(V):- \+ var(V), \+ is_list(V), py_tuple(V,T),py_tuple(T,TT),T==TT, \+ py_type(V,str). +py_is_pdict(V):- \+ var(V), py_dict(V,T),py_dict(T,TT),T==TT. +py_is_list(V):- \+ var(V), \+ is_list(V),py_type(V,list). +%py_is_list(V):- py_is_tuple(V). %write_src(V):- !, \+ \+ quietly(pp_sex(V)),!. -write_src(V):- \+ \+ (pp_sex(V)),!. +write_src(V):- \+ \+ notrace(pp_sex(V)),!. pp_sex(V):- pp_sexi(V),!. % Various 'write_src' and 'pp_sex' rules are handling the writing of the source, % dealing with different types of values, whether they are lists, atoms, numbers, strings, compounds, or symbols. pp_sexi(V):- is_final_write(V),!. -pp_sexi(V):- atomic(V),py_is_enabled,py_is_object(V),!,py_ppp(V),!. -pp_sexi(V):- py_is_enabled,py_ppp(V),!. +pp_sexi(V):- py_is_py(V),!,py_ppp(V),!. pp_sexi(V):- is_dict(V),!,print(V). pp_sexi((USER:Body)) :- USER==user,!, pp_sex(Body). pp_sexi(V):- allow_concepts,!,with_concepts('False',pp_sex(V)),flush_output. diff --git a/.Attic/metta_lang/stdlib_mettalog.metta b/.Attic/metta_lang/stdlib_mettalog.metta index 838135aad46..931b8b8d472 100755 --- a/.Attic/metta_lang/stdlib_mettalog.metta +++ b/.Attic/metta_lang/stdlib_mettalog.metta @@ -664,6 +664,11 @@ ;; Public MeTTa? (:> hyperon::space::DynSpace Grounded) +(: stringToChars (-> String Expression)) +(: charsToString (-> Expression String)) +(: parse (-> String Atom)) +(: repr (-> Atom String)) + ;; Public MeTTa (@doc add-reduct (@desc "Prevents atom from being reduced") From ffa8ba24b531bf112e09cea74b5dc8715ec1c335 Mon Sep 17 00:00:00 2001 From: root Date: Sun, 25 Aug 2024 22:44:49 -0700 Subject: [PATCH 33/77] renamed misplaced test files --- Test-files.vpj | 4 +- hyperon-wam.vpw | 2 - scripts/run_nightly_tests.sh | 168 +++++++++++++++++++++++++++++++++++ 3 files changed, 170 insertions(+), 4 deletions(-) create mode 100755 scripts/run_nightly_tests.sh diff --git a/Test-files.vpj b/Test-files.vpj index be2fb2a3adb..eb1817ac708 100755 --- a/Test-files.vpj +++ b/Test-files.vpj @@ -71,8 +71,6 @@ Filters="" GUID="{6067A70F-D8B4-48B4-8254-E9D08E339303}"/> - - + + diff --git a/hyperon-wam.vpw b/hyperon-wam.vpw index 5a831624753..3bc76fb2bf6 100755 --- a/hyperon-wam.vpw +++ b/hyperon-wam.vpw @@ -3,8 +3,6 @@ - - diff --git a/scripts/run_nightly_tests.sh b/scripts/run_nightly_tests.sh new file mode 100755 index 00000000000..20529b90c9b --- /dev/null +++ b/scripts/run_nightly_tests.sh @@ -0,0 +1,168 @@ +#!/bin/bash + +# parse arguments +while [[ $# -gt 0 ]]; do + case $1 in + -t|--timestamp) + timestamp="$2" + shift # past argument + shift # past value + ;; + *) + # Ignore unknown options + ;; + esac +done + +# generate the output directory with timestamp +if [ -z $timestamp ]; then + timestamp=$(date +"%Y-%m-%dT%H:%M:%S") +fi +output=./reports/tests_output/baseline-compat-$timestamp/ + +# run the tests +mkdir -p $output +echo "Running Precommit tests to $output" + +#cat ./reports/SHARED.UNITS.PREV.md > /tmp/SHARED.UNITS + + +# this function hides output without the command being aware of the redirection +run_mettalog_tests() { + + local test_dir=$2 + shift 2 # Shift the first two arguments so the rest can be captured as additional arguments + + # Capture the rest of the arguments + local rest_args="$@" + + # Run the command with script, using tee and grep for filtered output + script -q -c "mettalog --continue --output=$output --test --timeout=$max_time_per_test $test_dir $rest_args" /dev/null | \ + tee >(grep -Ei --line-buffered '_CMD:|es[:] ' >&2) > /dev/null +} + + +run_single_timed_unit() { + local TEST_CMD="$1" # The command to run (passed as a single string) + local file_html="$2" # HTML output file + local file="$3" # Test file + local EXTRA_INFO="$4" # Renamed inside the function from METTALOG_MAX_TIME + + # Start the timer + local START_TIME=$(date +%s) + + # Run the test command using eval to handle the single string properly + eval "$TEST_CMD" + local TEST_EXIT_CODE=$? + + # Stop the timer and calculate elapsed time + local END_TIME=$(date +%s) + local ELAPSED_TIME=$((END_TIME - START_TIME)) + + # Determine the test status based on the exit code + local DEBUG_MESSAGE + local PASS_OR_FAIL + local SHOULD_DELETE_HTML=0 + + if [ $TEST_EXIT_CODE -eq 124 ]; then + DEBUG_MESSAGE="${RED}Killed (definitely due to timeout) (EXITCODE=$TEST_EXIT_CODE) after $EXTRA_INFO seconds: $TEST_CMD${NC}" + [ "$if_failures" -eq 1 ] && SHOULD_DELETE_HTML=1 + PASS_OR_FAIL="FAIL" + elif [[ $TEST_EXIT_CODE -eq 4 ]] || [[ $TEST_EXIT_CODE -eq 134 ]]; then + DEBUG_MESSAGE="${RED}Stopping tests (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" + SHOULD_DELETE_HTML=1 + PASS_OR_FAIL="FAIL" + elif [ $TEST_EXIT_CODE -ne 7 ]; then + DEBUG_MESSAGE="${YELLOW}Completed (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" + PASS_OR_FAIL="FAIL" + else + DEBUG_MESSAGE="${GREEN}Completed successfully (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" + PASS_OR_FAIL="PASS" + fi + + # Generate the test name in the format WHOLE_TESTS.ParentDirectory.File + local PARENT_DIR=$(basename "$(dirname "$file")") + local BASE_FILE=$(basename "$file" .metta) # Replace .metta with the correct file extension + local TEST_NAME="WHOLE_TESTS.$PARENT_DIR.$BASE_FILE" + + # Generate the HTML link + local HTML_LINK="file://$file_html#${TEST_NAME}" + + # Determine if the HTML file should be used as the logfile or a separate .log file should be created + local LOGFILE + if [ $SHOULD_DELETE_HTML -eq 1 ]; then + # Create a separate .log file since the HTML file is planned for deletion + LOGFILE="${file_html}.log" + cp "$file_html" "$LOGFILE" + else + # Use the HTML file as the logfile since it won't be deleted + LOGFILE="$file_html" + fi + + # Redirect debug messages to both the logfile and console + echo "$DEBUG_MESSAGE" | tee -a "$LOGFILE" + + # Write the line to /tmp/SHARED.UNITS + echo "| $TEST_NAME | $PASS_OR_FAIL | [$TEST_NAME]($HTML_LINK) | $TEST_CMD | $TEST_EXIT_CODE | 7 | $ELAPSED_TIME seconds | $LOGFILE |" >> /tmp/SHARED.UNITS + + # Delete the HTML file if it was planned for deletion + if [ $SHOULD_DELETE_HTML -eq 1 ]; then + rm -f "$file_html" + fi + + return $TEST_EXIT_CODE +} + + +# Construct the TEST_CMD string +#TEST_CMD="mettalog --output=$METTALOG_OUTPUT --timeout=$METTALOG_MAX_TIME --html --repl=false ${extra_args[*]} ${passed_along_to_mettalog[*]} \"$file\" --halt=true" + +# Call the function with the constructed command and other variables +#IF_REALLY_DO return run_single_timed_unit "$TEST_CMD" "$file_html" "$file" "Under $METTALOG_MAX_TIME seconds" + + +cat /dev/null > /tmp/SHARED.UNITS + +SKIP_LONG=1 + +# 23+ tests (~30 seconds) +run_mettalog_tests 40 tests/baseline_compat/module-system/ + +# 200+ tests (~4 minutes) +run_mettalog_tests 40 tests/baseline_compat/hyperon-experimental_scripts/ + +run_mettalog_tests 40 tests/baseline_compat/hyperon-mettalog_sanity/ + +# 50+ tests (~2 minutes) +run_mettalog_tests 40 tests/baseline_compat/metta-morph_tests/ + + +# Check if SKIP_LONG is not set to 1 +if [ "$SKIP_LONG" != "1" ]; then + + # 50+ tests (~2 minutes) + run_mettalog_tests 40 tests/baseline_compat/anti-regression/ + + # 400+ tests (~7 minutes) + run_mettalog_tests 40 tests/baseline_compat/ + + run_mettalog_tests 40 tests/nars_interp/ + + run_mettalog_tests 40 tests/more-anti-regression/ + run_mettalog_tests 40 tests/extended_compat/ + run_mettalog_tests 40 tests/douglas_pro_team_august_2024/ + run_mettalog_tests 40 tests/direct_comp/ + run_mettalog_tests 40 tests/features/ + run_mettalog_tests 40 tests/performance/ + #run_mettalog_tests 40 tests/compiler_baseline/ + #run_mettalog_tests 40 tests/nars_w_comp/ + # run_mettalog_tests 40 tests/python_compat/ +fi + +cat /tmp/SHARED.UNITS + +# if ran locally on our systme we might want to commit these +cat /tmp/SHARED.UNITS > ./reports/SHARED.UNITS.PREV.md + + + From 4c9f8d55e17348ba5317d3a2434adc19e06dc74a Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sun, 25 Aug 2024 23:40:44 -0700 Subject: [PATCH 34/77] py_is_module_unsafe --- .Attic/metta_lang/metta_printer.pl | 16 ++-------------- .Attic/metta_lang/metta_python.pl | 24 +++++++++++++++++++++++- scripts/test_in_metta.sh | 2 +- 3 files changed, 26 insertions(+), 16 deletions(-) diff --git a/.Attic/metta_lang/metta_printer.pl b/.Attic/metta_lang/metta_printer.pl index 4d242f5be1b..59a1daaa2fb 100755 --- a/.Attic/metta_lang/metta_printer.pl +++ b/.Attic/metta_lang/metta_printer.pl @@ -140,19 +140,7 @@ once(Mesg),nb_setval(W,false)),nb_setval(W,false). :- dynamic(py_is_enabled/0). -py_is_enabled:- predicate_property(py_is_object(_),foreign), asserta((py_is_enabled:-!)). - -py_is_py(_):- \+ py_is_enabled, !, fail. -py_is_py(V):-var(V), get_attr(V,pyobj,X),!,nonvar(X),!. -py_is_py(V):-atom(V), py_is_object(V),!. -py_is_py(V):- is_list(V),!,fail. -py_is_py(V):-py_is_tuple(V),!. -py_is_py(V):-py_is_pdict(V),!. - -py_is_tuple(V):- \+ var(V), \+ is_list(V), py_tuple(V,T),py_tuple(T,TT),T==TT, \+ py_type(V,str). -py_is_pdict(V):- \+ var(V), py_dict(V,T),py_dict(T,TT),T==TT. -py_is_list(V):- \+ var(V), \+ is_list(V),py_type(V,list). -%py_is_list(V):- py_is_tuple(V). +py_is_enabled:- predicate_property(py_ppp(_),foreign), asserta((py_is_enabled:-!)). %write_src(V):- !, \+ \+ quietly(pp_sex(V)),!. write_src(V):- \+ \+ notrace(pp_sex(V)),!. @@ -161,7 +149,7 @@ % Various 'write_src' and 'pp_sex' rules are handling the writing of the source, % dealing with different types of values, whether they are lists, atoms, numbers, strings, compounds, or symbols. pp_sexi(V):- is_final_write(V),!. -pp_sexi(V):- py_is_py(V),!,py_ppp(V),!. +pp_sexi(V):- py_is_enabled,py_is_py(V),!,py_ppp(V),!. pp_sexi(V):- is_dict(V),!,print(V). pp_sexi((USER:Body)) :- USER==user,!, pp_sex(Body). pp_sexi(V):- allow_concepts,!,with_concepts('False',pp_sex(V)),flush_output. diff --git a/.Attic/metta_lang/metta_python.pl b/.Attic/metta_lang/metta_python.pl index 2f5b2cc8b99..528b051dac9 100755 --- a/.Attic/metta_lang/metta_python.pl +++ b/.Attic/metta_lang/metta_python.pl @@ -102,7 +102,29 @@ py_call_c(G):- py_catch(py_call(G)). py_call_c(G,R):- py_catch(py_call(G,R)). -py_is_module(M):-notrace((with_safe_argv(catch((py_call(M,X),py_type(X,module)),_,fail)))). +py_is_module(M):-notrace((with_safe_argv(py_is_module_unsafe(M)))). + +py_is_module_unsafe(M):- py_is_object(M),!,py_type(M,module). +py_is_module_unsafe(M):- catch((py_call(M,X),py_type(X,module)),_,fail). + +py_is_py(_):- \+ py_is_enabled, !, fail. +py_is_py(V):- var(V),!, get_attr(V,pyobj,_),!. +py_is_py(V):- atomic(V), !, py_is_object(V),!. +py_is_py(V):- \+ callable(V),!,fail. +py_is_py(V):- is_list(V),!,fail. +py_is_py(V):- py_is_tuple(V),!. +py_is_py(V):- py_is_py_dict(V),!. +py_is_py(V):- py_is_list(V),!. + +py_resolve(V,Py):- var(V),!, get_attr(V,pyobj,Py),!. +py_resolve(V,Py):- \+ compound(V),!,py_is_object(V),Py=V. +py_resolve(V,Py):- is_list(V),!,fail,maplist(py_resolve,V,Py). +py_resolve(V,Py):- V=Py. + +py_is_tuple(X):- py_resolve(X,V), py_tuple(V,T),py_tuple(T,TT),T==TT, \+ py_type(V,str). +py_is_py_dict(X):- py_resolve(X,V), py_dict(V,T), py_dict(T,TT), T==TT. +py_is_list(X):- py_resolve(X,V), py_type(V,list). +%py_is_list(V):- py_is_tuple(V). % Evaluations and Iterations load_builtin_module:- py_module(builtin_module, diff --git a/scripts/test_in_metta.sh b/scripts/test_in_metta.sh index fa44ba4a225..b07fd2816b9 100755 --- a/scripts/test_in_metta.sh +++ b/scripts/test_in_metta.sh @@ -217,7 +217,7 @@ process_file() { echo "$DEBUG_MESSAGE" | tee -a "$LOGFILE" # Write the line to /tmp/SHARED.UNITS - echo "| $TEST_NAME | $PASS_OR_FAIL | [$TEST_NAME]($HTML_LINK) | $TEST_CMD | $TEST_EXIT_CODE | 7 | $ELAPSED_TIME seconds | $LOGFILE |" >> /tmp/SHARED.UNITS + echo "| $TEST_NAME | $PASS_OR_FAIL | [$TEST_NAME]($HTML_LINK) | $TEST_CMD | $TEST_EXIT_CODE | 7 | $ELAPSED_TIME | $LOGFILE |" >> /tmp/SHARED.UNITS # Delete the HTML file if it was planned for deletion if [ $SHOULD_DELETE_HTML -eq 1 ]; then From 90c970f23ebbb4e7c2b731a6bd1388cd14254165 Mon Sep 17 00:00:00 2001 From: root Date: Mon, 26 Aug 2024 02:00:24 -0700 Subject: [PATCH 35/77] Needs not to be absolute and not relative to CWD (since tests like all .metta files change their local CWD at least while "loading" --- .Attic/metta_lang/metta_eval.pl | 2 +- .Attic/metta_lang/metta_testing.pl | 10 +++++++- mettalog | 8 +++++- scripts/run_nightly_tests.sh | 39 +++++++++++++++++++----------- scripts/test_in_metta.sh | 26 ++++++++++++++------ 5 files changed, 61 insertions(+), 24 deletions(-) diff --git a/.Attic/metta_lang/metta_eval.pl b/.Attic/metta_lang/metta_eval.pl index 55f649b0297..74b0026cb4c 100755 --- a/.Attic/metta_lang/metta_eval.pl +++ b/.Attic/metta_lang/metta_eval.pl @@ -136,7 +136,7 @@ do_expander('=',_,X,X):-!. do_expander(':',_,X,Y):- !, get_type(X,Y)*->X=Y. -'get_type'(Arg,Type):- 'get-type'(Arg,Type). +get_type(Arg,Type):- eval_H(['get-type',Arg],Type). eval_true(X):- \+ iz_conz(X), callable(X), call(X). diff --git a/.Attic/metta_lang/metta_testing.pl b/.Attic/metta_lang/metta_testing.pl index 2071ef7a3c1..010a2eb7658 100755 --- a/.Attic/metta_lang/metta_testing.pl +++ b/.Attic/metta_lang/metta_testing.pl @@ -129,7 +129,7 @@ if_t( (tee_file(TEE_FILE)->true;'TEE.ansi'=TEE_FILE), (%atom_concat(TEE_FILE,'.UNITS',UNITS), - UNITS = '/tmp/SHARED.UNITS', + shared_units(UNITS), open(UNITS, append, Stream,[encoding(utf8)]), once(getenv('HTML_FILE',HTML_OUT);sformat(HTML_OUT,'~w.metta.html',[Base])), compute_html_out_per_test(HTML_OUT,TEE_FILE,TestName,HTML_OUT_PerTest), @@ -143,6 +143,14 @@ HTML_OUT_PerTest]),!, close(Stream))). +% Needs not to be absolute and not relative to CWD (since tests like all .metta files change their local CWD at least while "loading") +output_directory(OUTPUT_DIR):- getenv('METTALOG_OUTPUT',OUTPUT_DIR),!. +output_directory(OUTPUT_DIR):- getenv('OUTPUT_DIR',OUTPUT_DIR),!. + +shared_units(UNITS):- getenv('SHARED_UNITS',UNITS),!. % Needs not to be relative to CWD +shared_units(UNITS):- output_directory(OUTPUT_DIR),!,directory_file_path(OUTPUT_DIR,'SHARED.UNITS',UNITS). +shared_units(UNITS):- UNITS = '/tmp/SHARED.UNITS'. + % currently in a shared file per TestCase class.. % but we might make each test dump its stuffg to its own html file for easier spotting why test failed compute_html_out_per_test(HTML_OUT,_TEE_FILE,_TestName,HTML_OUT_PerTest):- diff --git a/mettalog b/mettalog index d676318d4c7..9943e7439ec 100755 --- a/mettalog +++ b/mettalog @@ -1,5 +1,6 @@ #!/bin/bash +source ./scripts/ensure_venv generate_junit_report=0 junit_report_file="" start_time=0 @@ -18,7 +19,7 @@ compatio=false RC_OPTIONS=() TIMEOUT=0 verbose="${VERBOSE:-0}" # Use the VERBOSE environment variable or default to '0' (not verbose) -export OUTPUT_DIR="./" +OUTPUT_DIR="${METTALOG_OUTPUT}" use_docker=auto repl_flag=auto @@ -655,6 +656,7 @@ function handle_args { add_to_list "$arg" METTALOG_OPTIONS if [[ "$arg" =~ ^--output=(.*)$ ]]; then OUTPUT_DIR="${BASH_REMATCH[1]}" + export METTALOG_OUTPUT="${OUTPUT_DIR}" fi continue ;; @@ -1083,6 +1085,7 @@ if [[ "$html_flag" == "enable" ]]; then if [ ! -z "$HTML_OUT" ];then HTML_OUT=$(realpath --relative-to="$(pwd)" "$HTML_OUT") if [ ! -z "$OUTPUT_DIR" ] ;then + export METTALOG_OUTPUT="${OUTPUT_DIR}" HTML_OUT="${OUTPUT_DIR}/${HTML_OUT}" fi export HTML_FILE="${HTML_OUT}" @@ -1112,6 +1115,9 @@ if [[ "$html_flag" == "enable" ]]; then else [[ "$wants_print_help" == "1" ]] && { print_help; [[ "$IS_SOURCED" == "1" ]] && return "$EXIT_SCRIPT" || exit "$EXIT_SCRIPT"; } [[ -n "${EXIT_SCRIPT+x}" ]] && { [[ "$IS_SOURCED" == "1" ]] && return "$EXIT_SCRIPT" || exit "$EXIT_SCRIPT"; } + if [ ! -z "$OUTPUT_DIR" ] ;then + export METTALOG_OUTPUT="${OUTPUT_DIR}" + fi if [[ "$contains_halt" == "true" ]]; then do_DEBUG "METTA_CMD: $METTA_CMD" fi diff --git a/scripts/run_nightly_tests.sh b/scripts/run_nightly_tests.sh index 20529b90c9b..730c2caf583 100755 --- a/scripts/run_nightly_tests.sh +++ b/scripts/run_nightly_tests.sh @@ -16,29 +16,42 @@ done # generate the output directory with timestamp if [ -z $timestamp ]; then - timestamp=$(date +"%Y-%m-%dT%H:%M:%S") + timestamp=$(date +"%Y-%m-%d") fi -output=./reports/tests_output/baseline-compat-$timestamp/ +output=./reports/BY_DATE/$timestamp +export METTALOG_OUTPUT=$(realpath $output) +export SHARED_UNITS=$METTALOG_OUTPUT/SHARED.UNITS + +if [ ! -d $output ]; then + mkdir -p $output +fi + +touch $SHARED_UNITS # run the tests -mkdir -p $output -echo "Running Precommit tests to $output" + +echo "Running nightly tests to $output with SHARED_UNITS=$SHARED_UNITS" #cat ./reports/SHARED.UNITS.PREV.md > /tmp/SHARED.UNITS # this function hides output without the command being aware of the redirection run_mettalog_tests() { - + + local max_time_per_test=$1 local test_dir=$2 shift 2 # Shift the first two arguments so the rest can be captured as additional arguments # Capture the rest of the arguments local rest_args="$@" - # Run the command with script, using tee and grep for filtered output - script -q -c "mettalog --continue --output=$output --test --timeout=$max_time_per_test $test_dir $rest_args" /dev/null | \ - tee >(grep -Ei --line-buffered '_CMD:|es[:] ' >&2) > /dev/null + # Run the command + eval "mettalog --continue --output=$output --test --timeout=$max_time_per_test $test_dir $rest_args" + + if [ $? -eq 4 ]; then + exit 4 + fi + } @@ -121,31 +134,29 @@ run_single_timed_unit() { #IF_REALLY_DO return run_single_timed_unit "$TEST_CMD" "$file_html" "$file" "Under $METTALOG_MAX_TIME seconds" -cat /dev/null > /tmp/SHARED.UNITS - -SKIP_LONG=1 +SKIP_LONG=0 # 23+ tests (~30 seconds) run_mettalog_tests 40 tests/baseline_compat/module-system/ # 200+ tests (~4 minutes) run_mettalog_tests 40 tests/baseline_compat/hyperon-experimental_scripts/ - run_mettalog_tests 40 tests/baseline_compat/hyperon-mettalog_sanity/ # 50+ tests (~2 minutes) run_mettalog_tests 40 tests/baseline_compat/metta-morph_tests/ - # Check if SKIP_LONG is not set to 1 if [ "$SKIP_LONG" != "1" ]; then + # 50+ tests (~2 minutes) run_mettalog_tests 40 tests/baseline_compat/anti-regression/ # 400+ tests (~7 minutes) run_mettalog_tests 40 tests/baseline_compat/ + run_mettalog_tests 40 tests/nars_interp/ run_mettalog_tests 40 tests/more-anti-regression/ @@ -159,7 +170,7 @@ if [ "$SKIP_LONG" != "1" ]; then # run_mettalog_tests 40 tests/python_compat/ fi -cat /tmp/SHARED.UNITS +cat $SHARED_UNITS > /tmp/SHARED.UNITS # if ran locally on our systme we might want to commit these cat /tmp/SHARED.UNITS > ./reports/SHARED.UNITS.PREV.md diff --git a/scripts/test_in_metta.sh b/scripts/test_in_metta.sh index b07fd2816b9..ecd900f3797 100755 --- a/scripts/test_in_metta.sh +++ b/scripts/test_in_metta.sh @@ -2,10 +2,6 @@ SHOULD_EXIT=0 -if [ -z "$SHARED_UNITS" ]; then -export SHARED_UNITS=/tmp/SHARED.UNITS -fi - DEBUG_WHY() { DEBUG "${GREEN}WHY: ${BOLD}${*}${NC}" } @@ -25,6 +21,8 @@ process_file() { export file_html="${METTALOG_OUTPUT}/${file}.html" + export METTALOG_OUTPUT="${METTALOG_OUTPUT}" + export HTML_OUT="${file}.html" DEBUG "===========================================================================" @@ -182,10 +180,15 @@ process_file() { DEBUG_MESSAGE="${RED}Killed (definitely due to timeout) (EXITCODE=$TEST_EXIT_CODE) after $EXTRA_INFO seconds: $TEST_CMD${NC}" [ "$if_failures" -eq 1 ] && SHOULD_DELETE_HTML=1 PASS_OR_FAIL="FAIL" - elif [[ $TEST_EXIT_CODE -eq 4 ]] || [[ $TEST_EXIT_CODE -eq 134 ]]; then + elif [ $TEST_EXIT_CODE -eq 134 ]; then + DEBUG_MESSAGE="${RED}Test aborted by user (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" + SHOULD_DELETE_HTML=1 + PASS_OR_FAIL="FAIL" + elif [ $TEST_EXIT_CODE -eq 4 ]; then DEBUG_MESSAGE="${RED}Stopping tests (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" SHOULD_DELETE_HTML=1 PASS_OR_FAIL="FAIL" + exit 4 elif [ $TEST_EXIT_CODE -ne 7 ]; then DEBUG_MESSAGE="${YELLOW}Completed (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" PASS_OR_FAIL="FAIL" @@ -216,8 +219,8 @@ process_file() { # Redirect debug messages to both the logfile and console echo "$DEBUG_MESSAGE" | tee -a "$LOGFILE" - # Write the line to /tmp/SHARED.UNITS - echo "| $TEST_NAME | $PASS_OR_FAIL | [$TEST_NAME]($HTML_LINK) | $TEST_CMD | $TEST_EXIT_CODE | 7 | $ELAPSED_TIME | $LOGFILE |" >> /tmp/SHARED.UNITS + # Write the line to "$SHARED_UNITS" + echo "| $TEST_NAME | $PASS_OR_FAIL | [$TEST_NAME]($HTML_LINK) | $TEST_CMD | $TEST_EXIT_CODE | 7 | $ELAPSED_TIME | $LOGFILE |" >> "${SHARED_UNITS}" # Delete the HTML file if it was planned for deletion if [ $SHOULD_DELETE_HTML -eq 1 ]; then @@ -670,6 +673,7 @@ while [ "$#" -gt 0 ]; do shift done +source ./scripts/ensure_venv python3 -m pip install ansi2html extract_all_parent_directories @@ -692,6 +696,13 @@ if [ $show_help -eq 1 ]; then show_help fi +if [ -z "$SHARED_UNITS" ]; then + if [ -d "$METTALOG_OUTPUT" ]; then + export SHARED_UNITS=$(realpath $METTALOG_OUTPUT)/SHARED.UNITS + fi +fi +touch $SHARED_UNITS + # Delete HTML files if the clean flag is set if [ $clean -eq 1 ]; then delete_html_files @@ -716,6 +727,7 @@ INTERP_SRC_DIR="$(realpath "${INTERP_SRC_DIR}")" DEBUG "INTERP_SRC_DIR=$INTERP_SRC_DIR" DEBUG "METTALOG_OUTPUT=$METTALOG_OUTPUT" +DEBUG "SHARED_UNITS=$SHARED_UNITS" if [[ ! -f "${METTALOG_OUTPUT}/src/" ]]; then : From ba07e8dc1c81db352f46ecaaba54381ba2d69c5a Mon Sep 17 00:00:00 2001 From: logicmoo Date: Mon, 26 Aug 2024 03:31:49 -0700 Subject: [PATCH 36/77] created scripts/cmd_as_test.sh so nightly isnt storing it --- scripts/cmd_as_test.sh | 75 +++++++++++++++++++ scripts/run_nightly_tests.sh | 141 +++++++++++------------------------ 2 files changed, 118 insertions(+), 98 deletions(-) create mode 100644 scripts/cmd_as_test.sh diff --git a/scripts/cmd_as_test.sh b/scripts/cmd_as_test.sh new file mode 100644 index 00000000000..080882b59ea --- /dev/null +++ b/scripts/cmd_as_test.sh @@ -0,0 +1,75 @@ +#!/bin/bash + +local TEST_NAME="$1" # HTML output file +local LOGFILE="$3" # Test file +local EXTRA_INFO="$4" + +local TEST_CMD="$@" # The command to run (passed as a single string) + +# Start the timer +local START_TIME=$(date +%s) + +# Run the test command using eval to handle the single string properly +eval "$TEST_CMD" +local TEST_EXIT_CODE=$? + +# Stop the timer and calculate elapsed time +local END_TIME=$(date +%s) +local ELAPSED_TIME=$((END_TIME - START_TIME)) + +# Determine the test status based on the exit code +local DEBUG_MESSAGE +local PASS_OR_FAIL +local SHOULD_DELETE_HTML=0 + +if [ $TEST_EXIT_CODE -eq 0 ]; then + DEBUG_MESSAGE="${GREEN}Completed successfully (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" + PASS_OR_FAIL="PASS" +elif [ $TEST_EXIT_CODE -eq 124 ]; then + DEBUG_MESSAGE="${RED}Killed (definitely due to timeout) (EXITCODE=$TEST_EXIT_CODE) after $EXTRA_INFO seconds: $TEST_CMD${NC}" + [ "$if_failures" -eq 1 ] && SHOULD_DELETE_HTML=1 + PASS_OR_FAIL="FAIL" +elif [ $TEST_EXIT_CODE -eq 134 ]; then + DEBUG_MESSAGE="${RED}Test aborted by user (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" + SHOULD_DELETE_HTML=1 + PASS_OR_FAIL="FAIL" +elif [ $TEST_EXIT_CODE -eq 4 ]; then + DEBUG_MESSAGE="${RED}Stopping tests (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" + SHOULD_DELETE_HTML=1 + PASS_OR_FAIL="FAIL" + exit 4 +elif [ $TEST_EXIT_CODE -ne 7 ]; then + DEBUG_MESSAGE="${YELLOW}Completed (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" + PASS_OR_FAIL="FAIL" +else + DEBUG_MESSAGE="${GREEN}Completed successfully (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" + PASS_OR_FAIL="PASS" +fi + +# Generate the HTML link +local HTML_LINK="file://$file_html#${TEST_NAME}" + +# Determine if the HTML file should be used as the logfile or a separate .log file should be created +if [ $SHOULD_DELETE_HTML -eq 1 ]; then + # Create a separate .log file since the HTML file is planned for deletion + LOGFILE="${file_html}.log" + cp "$file_html" "$LOGFILE" +else + # Use the HTML file as the logfile since it won't be deleted + LOGFILE="$file_html" +fi + +# Redirect debug messages to both the logfile and console +echo "$DEBUG_MESSAGE" | tee -a "$LOGFILE" + +# Write the line to /tmp/SHARED.UNITS +echo "| $TEST_NAME | $PASS_OR_FAIL | [$TEST_NAME]($HTML_LINK) | $TEST_CMD | $TEST_EXIT_CODE | 7 | $ELAPSED_TIME seconds | $LOGFILE |" >> /tmp/SHARED.UNITS + +# Delete the HTML file if it was planned for deletion +if [ $SHOULD_DELETE_HTML -eq 1 ]; then + rm -f "$file_html" +fi + +return $TEST_EXIT_CODE + + diff --git a/scripts/run_nightly_tests.sh b/scripts/run_nightly_tests.sh index 730c2caf583..7e8999e8c3c 100755 --- a/scripts/run_nightly_tests.sh +++ b/scripts/run_nightly_tests.sh @@ -1,5 +1,8 @@ #!/bin/bash +# Initialize the array for rest of the arguments +rest_of_args=() + # parse arguments while [[ $# -gt 0 ]]; do case $1 in @@ -8,134 +11,79 @@ while [[ $# -gt 0 ]]; do shift # past argument shift # past value ;; + --clean) + clean=true + shift # past argument + ;; *) - # Ignore unknown options + rest_of_args+=("$1") # store rest of arguments + shift ;; esac done -# generate the output directory with timestamp -if [ -z $timestamp ]; then +# Generate the output directory with timestamp +if [ -z "$timestamp" ]; then timestamp=$(date +"%Y-%m-%d") fi output=./reports/BY_DATE/$timestamp export METTALOG_OUTPUT=$(realpath $output) export SHARED_UNITS=$METTALOG_OUTPUT/SHARED.UNITS -if [ ! -d $output ]; then - mkdir -p $output -fi - +mkdir -p $output touch $SHARED_UNITS -# run the tests - -echo "Running nightly tests to $output with SHARED_UNITS=$SHARED_UNITS" - -#cat ./reports/SHARED.UNITS.PREV.md > /tmp/SHARED.UNITS - +echo "Running nightly tests to $output ($METTALOG_OUTPUT) with SHARED_UNITS=$SHARED_UNITS" -# this function hides output without the command being aware of the redirection +# This function runs MettaLog tests with configurable output suppression run_mettalog_tests() { - - local max_time_per_test=$1 - local test_dir=$2 + local max_time_per_test="$1" + local test_dir="$2" shift 2 # Shift the first two arguments so the rest can be captured as additional arguments - - # Capture the rest of the arguments - local rest_args="$@" - - # Run the command - eval "mettalog --continue --output=$output --test --timeout=$max_time_per_test $test_dir $rest_args" - - if [ $? -eq 4 ]; then - exit 4 + local args=("$@") + local status=666 + + # Construct the command using an array to handle spaces and special characters properly + local cmd=(mettalog --output="$output" --test --timeout=$max_time_per_test "$test_dir") + cmd+=("${args[@]}") + cmd+=("${rest_of_args[@]}") + + # Optionally remove --clean from subsequent runs + if [ "$clean" == true ]; then + cmd+=("--clean") + clean=false # Reset or remove the clean option after using it fi -} - + local SHOW_ALL_OUTPUT=true # Set to false normally, true for debugging -run_single_timed_unit() { - local TEST_CMD="$1" # The command to run (passed as a single string) - local file_html="$2" # HTML output file - local file="$3" # Test file - local EXTRA_INFO="$4" # Renamed inside the function from METTALOG_MAX_TIME - - # Start the timer - local START_TIME=$(date +%s) - - # Run the test command using eval to handle the single string properly - eval "$TEST_CMD" - local TEST_EXIT_CODE=$? - - # Stop the timer and calculate elapsed time - local END_TIME=$(date +%s) - local ELAPSED_TIME=$((END_TIME - START_TIME)) - - # Determine the test status based on the exit code - local DEBUG_MESSAGE - local PASS_OR_FAIL - local SHOULD_DELETE_HTML=0 - - if [ $TEST_EXIT_CODE -eq 124 ]; then - DEBUG_MESSAGE="${RED}Killed (definitely due to timeout) (EXITCODE=$TEST_EXIT_CODE) after $EXTRA_INFO seconds: $TEST_CMD${NC}" - [ "$if_failures" -eq 1 ] && SHOULD_DELETE_HTML=1 - PASS_OR_FAIL="FAIL" - elif [[ $TEST_EXIT_CODE -eq 4 ]] || [[ $TEST_EXIT_CODE -eq 134 ]]; then - DEBUG_MESSAGE="${RED}Stopping tests (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" - SHOULD_DELETE_HTML=1 - PASS_OR_FAIL="FAIL" - elif [ $TEST_EXIT_CODE -ne 7 ]; then - DEBUG_MESSAGE="${YELLOW}Completed (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" - PASS_OR_FAIL="FAIL" + if [ "$SHOW_ALL_OUTPUT" ]; then + # Execute the command and capture the status + "${cmd[@]}" + local status=$? else - DEBUG_MESSAGE="${GREEN}Completed successfully (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" - PASS_OR_FAIL="PASS" + # Execute the command silently and filter output, capturing status + script -q -c "${cmd[*]}" /dev/null | tee >(grep -Ei --line-buffered '_CMD:|es[:] ' >&2) > /dev/null + local status=$? fi - # Generate the test name in the format WHOLE_TESTS.ParentDirectory.File - local PARENT_DIR=$(basename "$(dirname "$file")") - local BASE_FILE=$(basename "$file" .metta) # Replace .metta with the correct file extension - local TEST_NAME="WHOLE_TESTS.$PARENT_DIR.$BASE_FILE" - - # Generate the HTML link - local HTML_LINK="file://$file_html#${TEST_NAME}" - - # Determine if the HTML file should be used as the logfile or a separate .log file should be created - local LOGFILE - if [ $SHOULD_DELETE_HTML -eq 1 ]; then - # Create a separate .log file since the HTML file is planned for deletion - LOGFILE="${file_html}.log" - cp "$file_html" "$LOGFILE" - else - # Use the HTML file as the logfile since it won't be deleted - LOGFILE="$file_html" + if [ $status -eq 4 ]; then + echo "Something purposely interupted testing... results will not be written!" + exit $status # exit this script fi - # Redirect debug messages to both the logfile and console - echo "$DEBUG_MESSAGE" | tee -a "$LOGFILE" - - # Write the line to /tmp/SHARED.UNITS - echo "| $TEST_NAME | $PASS_OR_FAIL | [$TEST_NAME]($HTML_LINK) | $TEST_CMD | $TEST_EXIT_CODE | 7 | $ELAPSED_TIME seconds | $LOGFILE |" >> /tmp/SHARED.UNITS - - # Delete the HTML file if it was planned for deletion - if [ $SHOULD_DELETE_HTML -eq 1 ]; then - rm -f "$file_html" - fi - - return $TEST_EXIT_CODE + return $status } +# Actual test calls and logic to manage test conditions +SKIP_LONG=0 + # Construct the TEST_CMD string #TEST_CMD="mettalog --output=$METTALOG_OUTPUT --timeout=$METTALOG_MAX_TIME --html --repl=false ${extra_args[*]} ${passed_along_to_mettalog[*]} \"$file\" --halt=true" # Call the function with the constructed command and other variables #IF_REALLY_DO return run_single_timed_unit "$TEST_CMD" "$file_html" "$file" "Under $METTALOG_MAX_TIME seconds" - -SKIP_LONG=0 - # 23+ tests (~30 seconds) run_mettalog_tests 40 tests/baseline_compat/module-system/ @@ -149,7 +97,6 @@ run_mettalog_tests 40 tests/baseline_compat/metta-morph_tests/ # Check if SKIP_LONG is not set to 1 if [ "$SKIP_LONG" != "1" ]; then - # 50+ tests (~2 minutes) run_mettalog_tests 40 tests/baseline_compat/anti-regression/ @@ -175,5 +122,3 @@ cat $SHARED_UNITS > /tmp/SHARED.UNITS # if ran locally on our systme we might want to commit these cat /tmp/SHARED.UNITS > ./reports/SHARED.UNITS.PREV.md - - From 0a923120d986936e6484caf6687c095f7e8f8c45 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Mon, 26 Aug 2024 03:32:57 -0700 Subject: [PATCH 37/77] fixed import-py! --- .Attic/metta_lang/metta_python.pl | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/.Attic/metta_lang/metta_python.pl b/.Attic/metta_lang/metta_python.pl index 528b051dac9..ee80c194bdd 100755 --- a/.Attic/metta_lang/metta_python.pl +++ b/.Attic/metta_lang/metta_python.pl @@ -806,18 +806,29 @@ (nonvar(File)-> Use=File ; Use=Module), pybug('extend-py!'(Use)), %py_call(mettalog:use_mettalog()), - (Use==mettalog->true;(py_call(mettalog:load_functions(Use),R),pybug(R))), + (Use==mettalog->true;py_load_modfile(Use)), %listing(ensure_rust_metta/1), %ensure_mettalog_py, nb_setval('$py_ready','true'), %working_directory(PWD,PWD), py_add_lib_dir(PWD), %replace_in_string(["/"="."],Module,ToPython), - %py_call(mettalog:import_module_to_rust(ToPython)), - %sformat(S,'!(import! &self ~w)',[ToPython]),rust_metta_run(S), + %py_mcall(mettalog:import_module_to_rust(ToPython)), + %sformat(S,'!(import! &self ~w)',[Use]),rust_metta_run(S,R), + R = [], %py_module_exists(Module), %py_call(MeTTa:load_py_module(ToPython),Result), true)),!. +py_load_modfile(Use):- py_mcall(mettalog:load_functions(Use),R),!,pybug(R). +py_load_modfile(Use):- exists_directory(Use),!,directory_file_path(Use,'_init_.py',File),py_load_modfile(File). +py_load_modfile(Use):- file_to_modname(Use,Mod),read_file_to_string(Use,Src),!,py_module(Mod,Src). + +file_to_modname(Filename,ModName):- symbol_concat('../',Name,Filename),!,file_to_modname(Name,ModName). +file_to_modname(Filename,ModName):- symbol_concat('./',Name,Filename),!,file_to_modname(Name,ModName). +file_to_modname(Filename,ModName):- symbol_concat(Name,'/_init_.py',Filename),!,file_to_modname(Name,ModName). +file_to_modname(Filename,ModName):- symbol_concat(Name,'.py',Filename),!,file_to_modname(Name,ModName). +file_to_modname(Filename,ModName):- replace_in_string(["/"="."],Filename,ModName). + %import_module_to_rust(ToPython):- sformat(S,'!(import! &self ~w)',[ToPython]),rust_metta_run(S). rust_metta_run(S,Run):- var(S),!,freeze(S,rust_metta_run(S,Run)). rust_metta_run(exec(S),Run):- \+ callable(S), string_concat('!',S,SS),!,rust_metta_run(SS,Run). From 11f838bb2bd3928fda03f64195cdcc71bbaf65c7 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Mon, 26 Aug 2024 12:39:01 -0700 Subject: [PATCH 38/77] disable overriding notrace/1 --- .Attic/metta_lang/metta_interp.pl | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/.Attic/metta_lang/metta_interp.pl b/.Attic/metta_lang/metta_interp.pl index 03790c8955e..5d5a29f6c59 100755 --- a/.Attic/metta_lang/metta_interp.pl +++ b/.Attic/metta_lang/metta_interp.pl @@ -411,10 +411,12 @@ % if_t( \+ TF , set_prolog_flag(debug_on_interrupt,true)), !. -fake_notrace(G):- tracing,!,notrace(G). +:- meta_predicate fake_notrace(0). +fake_notrace(G):- tracing,!,real_notrace(G). fake_notrace(G):- !,once(G). +% `quietly/1` allows breaking in and inspection (real `no_trace/1` does not) fake_notrace(G):- quietly(G),!. -real_notrace(Goal):-!,notrace(Goal). +:- meta_predicate real_notrace(0). real_notrace(Goal) :- setup_call_cleanup('$notrace'(Flags, SkipLevel), once(Goal), @@ -423,7 +425,7 @@ :- dynamic(is_answer_output_stream/2). answer_output(Stream):- is_testing,original_user_output(Stream),!. -answer_output(Stream):- !,original_user_output(Stream),!. +answer_output(Stream):- !,original_user_output(Stream),!. % yes, the cut is on purpose answer_output(Stream):- is_answer_output_stream(_,Stream),!. answer_output(Stream):- tmp_file('answers',File), open(File,write,Stream,[encoding(utf8)]), @@ -1617,7 +1619,7 @@ %if_t(is_compiled,ensure_mettalog_py), install_readline_editline, - nts, + %nts1, %install_ontology, metta_final, % ensure_corelib_types, @@ -1732,14 +1734,16 @@ :- ensure_loaded(metta_server). :- initialization(update_changed_files,restore). -%nts:- !. -nts:- redefine_system_predicate(system:notrace/1), +nts1:- !. % disable redefinition +nts1:- redefine_system_predicate(system:notrace/1), + %listing(system:notrace/1), abolish(system:notrace/1), + dynamic(system:notrace/1), meta_predicate(system:notrace(0)), asserta((system:notrace(G):- (!,once(G)))). -nts:- !. +nts1:- !. -:- nts. +:- nts1. nts0:- redefine_system_predicate(system:notrace/0), abolish(system:notrace/0), @@ -1789,7 +1793,7 @@ set_is_unit_test(UNIT_TEST), \+ prolog_load_context(reloading,true), initialization(loon(restore),restore), - % nts, + % nts1, metta_final ))). From e7199956711e1671682793c49a375904fc70f4b3 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Mon, 26 Aug 2024 12:40:11 -0700 Subject: [PATCH 39/77] skip over skipped files --- scripts/test_in_metta.sh | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/scripts/test_in_metta.sh b/scripts/test_in_metta.sh index ecd900f3797..75fb189a4b3 100755 --- a/scripts/test_in_metta.sh +++ b/scripts/test_in_metta.sh @@ -14,6 +14,11 @@ process_file() { #local file=$(find_override_file "$1") local file="$1" + # Check if the file path contains a tilde + if [[ "$file" == *"~"* ]]; then + return 7 + fi + local absfile=$(readlink -f "$file") local extra_args="${@:2}" @@ -32,6 +37,10 @@ process_file() { DEBUG "Testing: $file" cd "$METTALOG_DIR" DEBUG "Output: $file_html" + # Check if the file path contains a tilde + if [[ "$absfile" == *"~"* ]]; then + DEBUG "${RED}Warn on tilda'd path?${NC}" + fi DEBUG "" DEBUG "" DEBUG "${BLUE}${BOLD}===========================================================================${NC}" @@ -674,7 +683,6 @@ while [ "$#" -gt 0 ]; do done source ./scripts/ensure_venv -python3 -m pip install ansi2html extract_all_parent_directories From cfe485377ee2bc260d97210edf0318131c582b6e Mon Sep 17 00:00:00 2001 From: logicmoo Date: Mon, 26 Aug 2024 12:44:02 -0700 Subject: [PATCH 40/77] py_is_py_dict --- .Attic/metta_lang/metta_python.pl | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/.Attic/metta_lang/metta_python.pl b/.Attic/metta_lang/metta_python.pl index ee80c194bdd..b0cb5d9ee6d 100755 --- a/.Attic/metta_lang/metta_python.pl +++ b/.Attic/metta_lang/metta_python.pl @@ -122,7 +122,8 @@ py_resolve(V,Py):- V=Py. py_is_tuple(X):- py_resolve(X,V), py_tuple(V,T),py_tuple(T,TT),T==TT, \+ py_type(V,str). -py_is_py_dict(X):- py_resolve(X,V), py_dict(V,T), py_dict(T,TT), T==TT. +py_is_py_dict(X):- atomic(X),py_is_object(X),py_type(X,dict). +%py_is_py_dict(X):- py_resolve(X,V), py_dict(V,T), py_dict(T,TT), T==TT. py_is_list(X):- py_resolve(X,V), py_type(V,list). %py_is_list(V):- py_is_tuple(V). @@ -666,10 +667,12 @@ pl_to_rust(_VL,Sym,Py):- py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. py_list(MeTTa,PyList):- pl_to_py(MeTTa,PyList). -py_tuple(O,Py):- py_mcall(tuple(O),Py),!. -py_tuple(O,Py):- py_mbi(py_tuple(O),Py),!. + +py_tuple(O,Py):- py_ocall(tuple(O),Py),!. +%py_tuple(O,Py):- py_mbi(py_tuple(O),Py),!. + +%py_dict(O,Py):- catch(py_is_dict(O),_,fail),!,O=Py. py_dict(O,Py):- py_mcall(dict(O),Py),!. -py_dict(O,Py):- catch(py_is_dict(O),_,fail),!,O=Py. % ?- py_list([1, 2.0, "string"], X),py_type(X,Y). % ?- py_list_index([1, 2.0, "string"], X),py_type(X,Y). @@ -821,7 +824,7 @@ py_load_modfile(Use):- py_mcall(mettalog:load_functions(Use),R),!,pybug(R). py_load_modfile(Use):- exists_directory(Use),!,directory_file_path(Use,'_init_.py',File),py_load_modfile(File). -py_load_modfile(Use):- file_to_modname(Use,Mod),read_file_to_string(Use,Src),!,py_module(Mod,Src). +py_load_modfile(Use):- file_to_modname(Use,Mod),read_file_to_string(Use,Src,[]),!,py_module(Mod,Src). file_to_modname(Filename,ModName):- symbol_concat('../',Name,Filename),!,file_to_modname(Name,ModName). file_to_modname(Filename,ModName):- symbol_concat('./',Name,Filename),!,file_to_modname(Name,ModName). From 68c4768a845ce42add74f7bc7940e7180f56a789 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Mon, 26 Aug 2024 12:46:10 -0700 Subject: [PATCH 41/77] nightly ./scripts/ensure_venv --- scripts/run_nightly_tests.sh | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/scripts/run_nightly_tests.sh b/scripts/run_nightly_tests.sh index 7e8999e8c3c..0744fcdd23f 100755 --- a/scripts/run_nightly_tests.sh +++ b/scripts/run_nightly_tests.sh @@ -35,6 +35,14 @@ touch $SHARED_UNITS echo "Running nightly tests to $output ($METTALOG_OUTPUT) with SHARED_UNITS=$SHARED_UNITS" +source ./scripts/ensure_venv + +# Check if 'ansi2html' is already installed +if ! python3 -m pip list | grep -q 'ansi2html'; then + # Install 'ansi2html' if it is not installed + python3 -m pip install ansi2html +fi + # This function runs MettaLog tests with configurable output suppression run_mettalog_tests() { local max_time_per_test="$1" @@ -68,7 +76,7 @@ run_mettalog_tests() { if [ $status -eq 4 ]; then echo "Something purposely interupted testing... results will not be written!" - exit $status # exit this script + # exit $status # exit this script fi return $status @@ -107,11 +115,15 @@ if [ "$SKIP_LONG" != "1" ]; then run_mettalog_tests 40 tests/nars_interp/ run_mettalog_tests 40 tests/more-anti-regression/ + + run_mettalog_tests 40 tests/extended_compat/metta-examples/ run_mettalog_tests 40 tests/extended_compat/ - run_mettalog_tests 40 tests/douglas_pro_team_august_2024/ + run_mettalog_tests 40 tests/direct_comp/ run_mettalog_tests 40 tests/features/ run_mettalog_tests 40 tests/performance/ + + # compiler based tests #run_mettalog_tests 40 tests/compiler_baseline/ #run_mettalog_tests 40 tests/nars_w_comp/ # run_mettalog_tests 40 tests/python_compat/ From ff33e1a4cd7ad21a6e3ad71f916f1ad7eef69694 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Mon, 26 Aug 2024 12:47:20 -0700 Subject: [PATCH 42/77] throw error if cant write units file --- .Attic/metta_lang/metta_testing.pl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.Attic/metta_lang/metta_testing.pl b/.Attic/metta_lang/metta_testing.pl index 010a2eb7658..ea78063dda2 100755 --- a/.Attic/metta_lang/metta_testing.pl +++ b/.Attic/metta_lang/metta_testing.pl @@ -126,9 +126,9 @@ symbolic_list_concat([_,R],'tests/',FilePath), file_name_extension(Base, _, R))), nop(format('

;; ~w

',[TestName,TestName])), - - if_t( (tee_file(TEE_FILE)->true;'TEE.ansi'=TEE_FILE), - (%atom_concat(TEE_FILE,'.UNITS',UNITS), + must_det_ll(( + (tee_file(TEE_FILE)->true;'TEE.ansi'=TEE_FILE), + (( %atom_concat(TEE_FILE,'.UNITS',UNITS), shared_units(UNITS), open(UNITS, append, Stream,[encoding(utf8)]), once(getenv('HTML_FILE',HTML_OUT);sformat(HTML_OUT,'~w.metta.html',[Base])), @@ -141,7 +141,7 @@ trim_gstring_bar_I(write_src_woi(G2),200), Duration, HTML_OUT_PerTest]),!, - close(Stream))). + close(Stream))))). % Needs not to be absolute and not relative to CWD (since tests like all .metta files change their local CWD at least while "loading") output_directory(OUTPUT_DIR):- getenv('METTALOG_OUTPUT',OUTPUT_DIR),!. From d1369bfe9baf311ca4094c271189127b964b0fe5 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Mon, 26 Aug 2024 12:48:17 -0700 Subject: [PATCH 43/77] remove seconds string for SHARED.UNITS --- scripts/cmd_as_test.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scripts/cmd_as_test.sh b/scripts/cmd_as_test.sh index 080882b59ea..88906481b25 100644 --- a/scripts/cmd_as_test.sh +++ b/scripts/cmd_as_test.sh @@ -63,7 +63,7 @@ fi echo "$DEBUG_MESSAGE" | tee -a "$LOGFILE" # Write the line to /tmp/SHARED.UNITS -echo "| $TEST_NAME | $PASS_OR_FAIL | [$TEST_NAME]($HTML_LINK) | $TEST_CMD | $TEST_EXIT_CODE | 7 | $ELAPSED_TIME seconds | $LOGFILE |" >> /tmp/SHARED.UNITS +echo "| $TEST_NAME | $PASS_OR_FAIL | [$TEST_NAME]($HTML_LINK) | $TEST_CMD | $TEST_EXIT_CODE | 7 | $ELAPSED_TIME | $LOGFILE |" >> /tmp/SHARED.UNITS # Delete the HTML file if it was planned for deletion if [ $SHOULD_DELETE_HTML -eq 1 ]; then From 64d9251c3bc6892616e5bf99215fc93879588edf Mon Sep 17 00:00:00 2001 From: logicmoo Date: Mon, 26 Aug 2024 12:49:09 -0700 Subject: [PATCH 44/77] less printing of 'Script is running inside a virtual environment' --- scripts/ensure_venv | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scripts/ensure_venv b/scripts/ensure_venv index e820e82ffeb..df21d28ec1f 100755 --- a/scripts/ensure_venv +++ b/scripts/ensure_venv @@ -56,7 +56,7 @@ create_venv() { # Main logic of the script if is_inside_venv; then - echo "Script is running inside a virtual environment: $VIRTUAL_ENV" + : #echo "Script is running inside a virtual environment: $VIRTUAL_ENV" else echo "Script is not running inside a virtual environment." create_venv From c9c6701c97f76fedfa768d05233a9d3eeb90b353 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Mon, 26 Aug 2024 12:50:08 -0700 Subject: [PATCH 45/77] runnning two tests and catting the locally ran tests --- scripts/run_commit_tests.sh | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/scripts/run_commit_tests.sh b/scripts/run_commit_tests.sh index 705b663bce4..c1e2570c8bf 100755 --- a/scripts/run_commit_tests.sh +++ b/scripts/run_commit_tests.sh @@ -19,13 +19,20 @@ if [ -z $timestamp ]; then timestamp=$(date +"%Y-%m-%dT%H:%M:%S") fi output=./reports/tests_output/baseline-compat-$timestamp/ +export METTALOG_OUTPUT=$(realpath $output) +export SHARED_UNITS=$METTALOG_OUTPUT/SHARED.UNITS # run the tests mkdir -p $output +touch $SHARED_UNITS echo Running baseline_compat tests to $output #cat ./reports/SHARED.UNITS.PREV.md > /tmp/SHARED.UNITS cat /dev/null > /tmp/SHARED.UNITS #mettalog --output=$output --test --clean tests/baseline_compat/anti-regression/comma_is_not_special.metta -mettalog --test --clean --output=$output tests/baseline_compat/module-system/ - +( mettalog --test --clean --output=$output tests/baseline_compat/module-system/ ) +# Stuff just generated +cat $SHARED_UNITS >> /tmp/SHARED.UNITS +# Tests ran locally by developer (temporary to see what a nightly with 1000+ tests looks like) +cat ./reports/SHARED.UNITS.PREV.md >> /tmp/SHARED.UNITS +# together cat /tmp/SHARED.UNITS From f5a9f6a5dd33a4823a5be2ba779e36877781a4dc Mon Sep 17 00:00:00 2001 From: logicmoo Date: Mon, 26 Aug 2024 13:16:18 -0700 Subject: [PATCH 46/77] filter dotdirs from library --- hyperon-wam.vpj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hyperon-wam.vpj b/hyperon-wam.vpj index 03c0cd5b917..178ab3533d8 100755 --- a/hyperon-wam.vpj +++ b/hyperon-wam.vpj @@ -122,7 +122,7 @@ From b3019120cad320d9575a13819dda208da08b0826 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Mon, 26 Aug 2024 13:34:11 -0700 Subject: [PATCH 47/77] fixed many py_mcall -> py_ocall --- .Attic/metta_lang/metta_eval.pl | 4 +++- .Attic/metta_lang/metta_python.pl | 24 ++++++++++++------------ 2 files changed, 15 insertions(+), 13 deletions(-) diff --git a/.Attic/metta_lang/metta_eval.pl b/.Attic/metta_lang/metta_eval.pl index 74b0026cb4c..1659dde37cd 100755 --- a/.Attic/metta_lang/metta_eval.pl +++ b/.Attic/metta_lang/metta_eval.pl @@ -1826,7 +1826,9 @@ eval_40(_Eq,_RetType,_Depth,_Self,['py-dict',Arg],Res):- !, must_det_ll((py_dict(Arg,Res))). eval_40(_Eq,_RetType,_Depth,_Self,['py-tuple',Arg],Res):- !, - must_det_ll((py_tuple(Arg,Res))). + must_det_ll((py_tuple(Arg,Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-eval',Arg],Res):- !, + must_det_ll((py_eval(Arg,Res))). eval_40(Eq,RetType,Depth,Self,['length',L],Res):- !, eval_args(Depth,Self,L,LL), (is_list(LL)->length(LL,Res);Res=1), diff --git a/.Attic/metta_lang/metta_python.pl b/.Attic/metta_lang/metta_python.pl index b0cb5d9ee6d..145bdd819ef 100755 --- a/.Attic/metta_lang/metta_python.pl +++ b/.Attic/metta_lang/metta_python.pl @@ -387,19 +387,19 @@ py_atom(I,O):- var(I),!,O=I. py_atom([I|Is],O):-!, py_dot(I,II),py_dot_from(II,Is,O),!. py_atom(I,O):- atomic(I),!,py_atomic(I,O). -py_atom(I,O):- py_mcall(I,O),!. +py_atom(I,O):- py_ocall(I,O),!. py_atom(I,O):- I=O. py_atom_type(I,_Type,O):- var(I),!,O=I. py_atom_type([I|Is],_Type,O):-!, py_dot(I,II),py_dot_from(II,Is,O). py_atom_type(I,_Type,O):- atomic(I),!,py_atomic(I,O). -py_atom_type(I,_Type,O):- py_mcall(I,O),!. +py_atom_type(I,_Type,O):- py_ocall(I,O),!. py_atom_type(I,_Type,O):- I=O. -py_atomic([],O):-py_mcall("[]",O),!. +py_atomic([],O):-py_ocall("[]",O),!. py_atomic(I,O):- py_is_object(I),!,O=I. -py_atomic(I,O):- py_mcall(I,O),!. py_atomic(I,O):- string(I),py_eval(I,O),!. +py_atomic(I,O):- py_ocall(I,O),!. py_atomic(I,O):- py_eval(I,O),!. py_atomic(I,O):- \+ symbol_contains(I,'('),atomic_list_concat([A,B|C],'.',I),py_dot([A,B|C],O),!. py_atomic(I,O):- string(I), py_dot(I,O),!. @@ -408,7 +408,7 @@ get_globals(O):- py_mbi(get_globals(),O). get_locals(O):- py_mbi(get_locals(),O). merge_modules_and_globals(O):- py_mbi(merge_modules_and_globals(),O). -py_eval(I,O):- py_mbi(eval_string(I),O). +py_eval(I,O):- py_obi(eval_string(I),O). py_eval(I):- py_eval(I,O),pybug(O). py_exec(I,O):- py_mbi(exec_string(I),O). py_exec(I):- py_exec(I,O),pybug(O). @@ -430,7 +430,7 @@ py_eval_from(From,I,O):- atomic_list_concat([A,B|C],'.',I),!,py_eval_from(From,[A,B|C],O). py_eval_from(From,I,O):- py_fcall(From,I,O). -py_fcall(From,I,O):- py_mcall(From:I,O). +py_fcall(From,I,O):- py_ocall(From:I,O). ensure_space_py(Space,GSpace):- py_is_object(Space),!,GSpace=Space. ensure_space_py(Space,GSpace):- var(Space),ensure_primary_metta_space(GSpace), Space=GSpace. @@ -669,14 +669,14 @@ py_list(MeTTa,PyList):- pl_to_py(MeTTa,PyList). py_tuple(O,Py):- py_ocall(tuple(O),Py),!. -%py_tuple(O,Py):- py_mbi(py_tuple(O),Py),!. +py_tuple(O,Py):- py_obi(py_tuple(O),Py),!. -%py_dict(O,Py):- catch(py_is_dict(O),_,fail),!,O=Py. -py_dict(O,Py):- py_mcall(dict(O),Py),!. +py_dict(O,Py):- catch(py_is_py_dict(O),_,fail),!,O=Py. +py_dict(O,Py):- py_ocall(dict(O),Py),!. % ?- py_list([1, 2.0, "string"], X),py_type(X,Y). % ?- py_list_index([1, 2.0, "string"], X),py_type(X,Y). -py_nth(L,Nth,E):- py_mbi(py_nth(L,Nth),E). +py_nth(L,Nth,E):- py_obi(py_nth(L,Nth),E). py_len(L,E):- py_mbi(py_len(L),E). py_o(O,Py):- py_obi(identity(O),Py),!. py_m(O,Py):- py_mbi(identity(O),Py),!. @@ -822,7 +822,7 @@ %py_call(MeTTa:load_py_module(ToPython),Result), true)),!. -py_load_modfile(Use):- py_mcall(mettalog:load_functions(Use),R),!,pybug(R). +py_load_modfile(Use):- py_ocall(mettalog:load_functions(Use),R),!,pybug(R). py_load_modfile(Use):- exists_directory(Use),!,directory_file_path(Use,'_init_.py',File),py_load_modfile(File). py_load_modfile(Use):- file_to_modname(Use,Mod),read_file_to_string(Use,Src,[]),!,py_module(Mod,Src). @@ -836,7 +836,7 @@ rust_metta_run(S,Run):- var(S),!,freeze(S,rust_metta_run(S,Run)). rust_metta_run(exec(S),Run):- \+ callable(S), string_concat('!',S,SS),!,rust_metta_run(SS,Run). rust_metta_run(S,Run):- \+ string(S),coerce_string(S,R),!,rust_metta_run(R,Run). -rust_metta_run(I,O):- !, py_mcall(hyperon_module:rust_metta_run(I),O),!. +rust_metta_run(I,O):- !, py_ocall(hyperon_module:rust_metta_run(I),O),!. rust_metta_run(R,Run):- % run with_safe_argv(((( %ensure_rust_metta(MeTTa), From 010f07594f589b2fe7b0fcb609ba91393294eb4b Mon Sep 17 00:00:00 2001 From: logicmoo Date: Mon, 26 Aug 2024 13:46:35 -0700 Subject: [PATCH 48/77] needs to set METTALOG_OUTPUT --- scripts/run_commit_tests.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scripts/run_commit_tests.sh b/scripts/run_commit_tests.sh index c1e2570c8bf..fecd53a9da0 100755 --- a/scripts/run_commit_tests.sh +++ b/scripts/run_commit_tests.sh @@ -29,7 +29,7 @@ echo Running baseline_compat tests to $output #cat ./reports/SHARED.UNITS.PREV.md > /tmp/SHARED.UNITS cat /dev/null > /tmp/SHARED.UNITS #mettalog --output=$output --test --clean tests/baseline_compat/anti-regression/comma_is_not_special.metta -( mettalog --test --clean --output=$output tests/baseline_compat/module-system/ ) +mettalog --test --clean --output=$output tests/baseline_compat/module-system/ # Stuff just generated cat $SHARED_UNITS >> /tmp/SHARED.UNITS # Tests ran locally by developer (temporary to see what a nightly with 1000+ tests looks like) From 66f2fb2f7ab7a1f086fa529a24446415ba097cfd Mon Sep 17 00:00:00 2001 From: logicmoo Date: Mon, 26 Aug 2024 13:51:04 -0700 Subject: [PATCH 49/77] needs to set METTALOG_OUTPUT really --- scripts/run_commit_tests.sh | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/scripts/run_commit_tests.sh b/scripts/run_commit_tests.sh index fecd53a9da0..6453719945d 100755 --- a/scripts/run_commit_tests.sh +++ b/scripts/run_commit_tests.sh @@ -19,13 +19,13 @@ if [ -z $timestamp ]; then timestamp=$(date +"%Y-%m-%dT%H:%M:%S") fi output=./reports/tests_output/baseline-compat-$timestamp/ -export METTALOG_OUTPUT=$(realpath $output) -export SHARED_UNITS=$METTALOG_OUTPUT/SHARED.UNITS # run the tests mkdir -p $output +export METTALOG_OUTPUT=$(realpath $output) +export SHARED_UNITS=$METTALOG_OUTPUT/SHARED.UNITS touch $SHARED_UNITS -echo Running baseline_compat tests to $output +echo Running baseline_compat tests to $output with METTALOG_OUTPUT=$METTALOG_OUTPUT and SHARED_UNITS=$SHARED_UNITS #cat ./reports/SHARED.UNITS.PREV.md > /tmp/SHARED.UNITS cat /dev/null > /tmp/SHARED.UNITS #mettalog --output=$output --test --clean tests/baseline_compat/anti-regression/comma_is_not_special.metta From 98364eb2ffbcbc9f50870c58f1e62cddda59f1d4 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Mon, 26 Aug 2024 14:09:34 -0700 Subject: [PATCH 50/77] volatile(did_load_hyperon_module/0) --- .Attic/metta_lang/metta_python.pl | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/.Attic/metta_lang/metta_python.pl b/.Attic/metta_lang/metta_python.pl index 145bdd819ef..a8b771bc517 100755 --- a/.Attic/metta_lang/metta_python.pl +++ b/.Attic/metta_lang/metta_python.pl @@ -346,8 +346,12 @@ %py_ppp(V):-metta_py_pp(V). % Evaluations and Iterations -load_hyperon_module:- py_module(hyperon_module, -' +:- volatile(did_load_hyperon_module/0). +:- dynamic(did_load_hyperon_module/0). +load_hyperon_module:- did_load_hyperon_module,!. +load_hyperon_module:- assert(did_load_hyperon_module), + py_module(hyperon_module,' + from hyperon.base import Atom from hyperon.atoms import OperationAtom, E from hyperon.ext import register_tokens @@ -370,6 +374,7 @@ def rust_metta_run(obj): return runner.run(obj) + '). @@ -836,7 +841,7 @@ rust_metta_run(S,Run):- var(S),!,freeze(S,rust_metta_run(S,Run)). rust_metta_run(exec(S),Run):- \+ callable(S), string_concat('!',S,SS),!,rust_metta_run(SS,Run). rust_metta_run(S,Run):- \+ string(S),coerce_string(S,R),!,rust_metta_run(R,Run). -rust_metta_run(I,O):- !, py_ocall(hyperon_module:rust_metta_run(I),O),!. +rust_metta_run(I,O):- load_hyperon_module, !, py_ocall(hyperon_module:rust_metta_run(I),O),!. rust_metta_run(R,Run):- % run with_safe_argv(((( %ensure_rust_metta(MeTTa), From d3010eb1053bf1c238d325510aaec51030a65d22 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Tue, 27 Aug 2024 00:42:46 -0700 Subject: [PATCH 51/77] make scripts/ensure_venv less verbose and ensure its ran in the correct directory --- mettalog | 11 +++++++---- scripts/ensure_venv | 6 +++--- 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/mettalog b/mettalog index 9943e7439ec..620b97927a0 100755 --- a/mettalog +++ b/mettalog @@ -1,6 +1,5 @@ #!/bin/bash -source ./scripts/ensure_venv generate_junit_report=0 junit_report_file="" start_time=0 @@ -21,6 +20,10 @@ TIMEOUT=0 verbose="${VERBOSE:-0}" # Use the VERBOSE environment variable or default to '0' (not verbose) OUTPUT_DIR="${METTALOG_OUTPUT}" +cd $METTALOG_DIR +source ./scripts/ensure_venv +cd $RPWD + use_docker=auto repl_flag=auto use_rc_file=~/.mettalogrc @@ -49,9 +52,9 @@ set_io_flags() { input_filename=$(readlink /proc/self/fd/0) add_to_list "--stdin=file" STDIO_OPTIONS add_to_list "--input-filename=${input_filename}" STDIO_OPTIONS - else - add_to_list "--stdin=tty" STDIO_OPTIONS - fi + else + add_to_list "--stdin=tty" STDIO_OPTIONS + fi # Handle stdout flags if [ ! -t 1 ]; then diff --git a/scripts/ensure_venv b/scripts/ensure_venv index df21d28ec1f..abc5773d1ab 100755 --- a/scripts/ensure_venv +++ b/scripts/ensure_venv @@ -15,7 +15,7 @@ fi # Function to activate the virtual environment activate_venv() { - echo "Activating the virtual environment: $VENV_DIR" + echo "Activating the virtual environment: $(realpath $VENV_DIR)" source "$VENV_DIR/bin/activate" } @@ -50,7 +50,7 @@ create_venv() { #pip install -r requirements.txt fi else - echo "Virtual environment already exists: $VENV_DIR" + : # echo "Virtual environment already exists: $VENV_DIR" fi } @@ -58,7 +58,7 @@ create_venv() { if is_inside_venv; then : #echo "Script is running inside a virtual environment: $VIRTUAL_ENV" else - echo "Script is not running inside a virtual environment." + # echo "Script is not running inside a virtual environment." create_venv activate_venv From 07f534d8d6c9e7c1e86d5ddf21a74582eb1411d4 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Tue, 27 Aug 2024 00:44:10 -0700 Subject: [PATCH 52/77] hopefully less warnings toward #89 --- .Attic/metta_lang/metta_interp.pl | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.Attic/metta_lang/metta_interp.pl b/.Attic/metta_lang/metta_interp.pl index 5d5a29f6c59..eab268d7615 100755 --- a/.Attic/metta_lang/metta_interp.pl +++ b/.Attic/metta_lang/metta_interp.pl @@ -54,7 +54,7 @@ :- encoding(utf8). :- set_prolog_flag(encoding, utf8). :- nb_setval(cmt_override,lse('; ',' !(" ',' ") ')). -:- ensure_loaded(swi_support). +:- set_prolog_flag(source_search_working_directory,true). :- set_prolog_flag(backtrace,true). :- set_prolog_flag(backtrace_depth,100). :- set_prolog_flag(backtrace_goal_dept,100). @@ -62,6 +62,7 @@ :- set_prolog_flag(write_attributes,portray). :- set_prolog_flag(debug_on_interrupt,true). :- set_prolog_flag(debug_on_error,true). +:- ensure_loaded(swi_support). %:- set_prolog_flag(compile_meta_arguments,control). :- (prolog_load_context(directory, Value);Value='.'), absolute_file_name('../packs/',Dir,[relative_to(Value)]), atom_concat(Dir,'predicate_streams',PS), From 1d81c1dcd59d0fd4aaece24c034314b83de8d5a0 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Tue, 27 Aug 2024 00:45:14 -0700 Subject: [PATCH 53/77] workspace project files --- hyperon-experimental.vpj | 63 ++++++++++++++++++++++++++++++++++++++++ hyperon-wam.vpw | 1 + 2 files changed, 64 insertions(+) create mode 100644 hyperon-experimental.vpj diff --git a/hyperon-experimental.vpj b/hyperon-experimental.vpj new file mode 100644 index 00000000000..37d67fa9214 --- /dev/null +++ b/hyperon-experimental.vpj @@ -0,0 +1,63 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/hyperon-wam.vpw b/hyperon-wam.vpw index 3bc76fb2bf6..e527228365c 100755 --- a/hyperon-wam.vpw +++ b/hyperon-wam.vpw @@ -2,6 +2,7 @@ + From 0efcd5022e153274a0addac6b83263bcdec17712 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Tue, 27 Aug 2024 00:48:58 -0700 Subject: [PATCH 54/77] !(rust! (superpose (1 (+ 1 1) 3))) works --- .Attic/metta_lang/metta_python.pl | 55 ++++++++++++++++++++++++++----- 1 file changed, 46 insertions(+), 9 deletions(-) diff --git a/.Attic/metta_lang/metta_python.pl b/.Attic/metta_lang/metta_python.pl index a8b771bc517..41623288c63 100755 --- a/.Attic/metta_lang/metta_python.pl +++ b/.Attic/metta_lang/metta_python.pl @@ -353,12 +353,12 @@ py_module(hyperon_module,' from hyperon.base import Atom -from hyperon.atoms import OperationAtom, E +from hyperon.atoms import OperationAtom, E, GroundedAtom, GroundedObject from hyperon.ext import register_tokens from hyperon.ext import register_atoms from hyperon.atoms import G, AtomType from hyperon.runner import MeTTa - +from hyperon.atoms import * import hyperonpy as hp import sys @@ -375,6 +375,22 @@ def rust_metta_run(obj): return runner.run(obj) +def rust_unwrap(obj): + if isinstance(obj,GroundedAtom): + return obj.get_object() + if isinstance(obj,GroundedObject): + return obj.content + if isinstance(obj,ExpressionAtom): + return obj.get_children() + return obj + +def rust_deref(obj): + while True: + undone = rust_unwrap(obj) + if undone is obj: return obj + if undone is None: return obj + obj = undone + '). @@ -426,8 +442,14 @@ py_dot_from(From,I,O):- atomic_list_concat([A,B|C],'.',I),!,py_dot_from(From,[A,B|C],O). py_dot_from(From,I,O):- py_dot(From,I,O). -py_eval_object([V|VI],VO):- - py_eval_from(V,VI,VO). +py_eval_object(Var,VO):- var(Var),!,VO=Var. +py_eval_object([V|VI],VO):- py_is_function(V),!,py_eval_from(V,VI,VO). +py_eval_object([V|VI],VO):- maplist(py_eval_object,[V|VI],VO). +py_eval_object(VO,VO). + +py_is_function(O):- \+ py_is_object(O),!,fail. +py_is_function(O):- py_type(O, function),!. +%py_is_function(O):- py_type(O, method),!. py_eval_from(From,I,O):- I==[],!,py_dot(From,O). py_eval_from(From,[I],O):- !, py_fcall(From,I,O). @@ -839,14 +861,29 @@ %import_module_to_rust(ToPython):- sformat(S,'!(import! &self ~w)',[ToPython]),rust_metta_run(S). rust_metta_run(S,Run):- var(S),!,freeze(S,rust_metta_run(S,Run)). -rust_metta_run(exec(S),Run):- \+ callable(S), string_concat('!',S,SS),!,rust_metta_run(SS,Run). -rust_metta_run(S,Run):- \+ string(S),coerce_string(S,R),!,rust_metta_run(R,Run). -rust_metta_run(I,O):- load_hyperon_module, !, py_ocall(hyperon_module:rust_metta_run(I),O),!. -rust_metta_run(R,Run):- % run +%rust_metta_run(exec(S),Run):- \+ callable(S), string_concat('!',S,SS),!,rust_metta_run(SS,Run). +rust_metta_run(S,Run):- coerce_string(S,R),!,rust_metta_run1(R,Run). +%rust_metta_run(I,O):- +rust_metta_run1(I,O):- load_hyperon_module, !, py_ocall(hyperon_module:rust_metta_run(I),M),!,py_iter(M,R),delist1(R,R1),rust_to_pl(R1,O). +rust_metta_run1(R,Run):- % run with_safe_argv(((( %ensure_rust_metta(MeTTa), py_call(mettalog:rust_metta_run(R),Run))))). +delist1([R],R):-!. +delist1(R,R). % Maybe warn here? + +rust_to_pl(L,P):- var(L),!,L=P. +rust_to_pl(L,P):- is_list(L),!,maplist(rust_to_pl,L,P). +rust_to_pl(R,P):- py_type(R,'ExpressionAtom'),py_mcall(R:get_children(),L),!,maplist(rust_to_pl,L,P). +rust_to_pl(R,P):- py_type(R,'GroundedAtom'),py_ocall(R:get_object(),L),!,rust_to_pl(L,P). +rust_to_pl(R,P):- py_type(R,'SymbolAtom'),py_acall(R:get_name(),P),!. +rust_to_pl(R,P):- py_type(R,'SpaceRef'),P=R. %py_acall(R:get_payload(),P),!. +rust_to_pl(R,P):- py_is_list(R),py_m(R,L),R\==L,!,rust_to_pl(L,P). +rust_to_pl(R,P):- + load_hyperon_module, !, py_ocall(hyperon_module:rust_deref(R),M),!, + (R\==M -> rust_to_pl(M,P) ; M=P). + rust_metta_run(S):- rust_metta_run(S,Py), print_py(Py). @@ -854,7 +891,7 @@ print_py(Py):- py_to_pl(Py,R), print(R),nl. -coerce_string(S,R):- atom(S), sformat(R,'~w',[S]),!. +%coerce_string(S,R):- atom(S), sformat(R,'~w',[S]),!. coerce_string(S,R):- string(S),!,S=R. coerce_string(S,R):- with_output_to(string(R),write_src(S)),!. From 9b29350769c980ed392160d5ca76f0b8afd2ee32 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Tue, 27 Aug 2024 01:27:16 -0700 Subject: [PATCH 55/77] workarround for the warning: Found file *.metta relative to the current working directory --- mettalog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mettalog b/mettalog index 620b97927a0..f1b146cec66 100755 --- a/mettalog +++ b/mettalog @@ -960,7 +960,7 @@ STDIO_OPTIONS=() set_io_flags STDIO_OPTIONS # Generate the final command -METTA_CMD="$MLOG --python=$python_flag ${PRE_METTALOG_OPTIONS[*]} ${METTALOG_OPTIONS[*]} ${METTALOG_OPTIONS_LAST[*]} ${STDIO_OPTIONS[*]}" +METTA_CMD="$MLOG -- --python=$python_flag ${PRE_METTALOG_OPTIONS[*]} ${METTALOG_OPTIONS[*]} ${METTALOG_OPTIONS_LAST[*]} ${STDIO_OPTIONS[*]}" OS=$(uname) From 645087f3e4b4a0f9dbfdb9b2a57aea5e44ec08c5 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Tue, 27 Aug 2024 12:30:35 -0700 Subject: [PATCH 56/77] get rid of copied venv that is probably using a whole different python anyways --- Dockerfile | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Dockerfile b/Dockerfile index d14e158f39c..41be6bd8867 100644 --- a/Dockerfile +++ b/Dockerfile @@ -6,6 +6,7 @@ ARG DEBIAN_FRONTEND=noninteractive RUN apt update RUN apt install -y python3 python3-pip libpython3-dev git RUN apt install -y sudo git curl gcc cmake +RUN apt install -y python3-venv time wget vim bc # Create user ENV USER=user @@ -29,6 +30,8 @@ WORKDIR ${METTALOG_DIR} # This COPY is in case we have made local changes # so we dont have to commit to Github to test them out COPY ./ ./ +# get rid of copied venv that is probably using a whole different python anyways +RUN rm -rf ./venv/ COPY ./INSTALL.sh ./INSTALL.sh RUN ./INSTALL.sh --easy From eae1c317eab7edb4a3ca7d12acd8efa0ccfe678e Mon Sep 17 00:00:00 2001 From: logicmoo Date: Tue, 27 Aug 2024 12:46:33 -0700 Subject: [PATCH 57/77] === to be documented as well as ==== --- .Attic/metta_lang/metta_eval.pl | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/.Attic/metta_lang/metta_eval.pl b/.Attic/metta_lang/metta_eval.pl index 1659dde37cd..098ff5d4686 100755 --- a/.Attic/metta_lang/metta_eval.pl +++ b/.Attic/metta_lang/metta_eval.pl @@ -1849,6 +1849,15 @@ suggest_type(RetType,'Bool'), eq_unify(Eq,_SharedType, X, Y, Res). +eval_20(_Eq,RetType,_Dpth,_Slf,[EQ,X,Y],TF):- EQ=='===', !, + suggest_type(RetType,'Bool'), + as_tf(X==Y,TF). + +eval_20(_Eq,RetType,_Dpth,_Slf,[EQ,X,Y],TF):- EQ=='====', !, + suggest_type(RetType,'Bool'), + as_tf(same_terms(X,Y),TF). + + eq_unify(_Eq,_SharedType, X, Y, TF):- as_tf(X=:=Y,TF),!. eq_unify(_Eq,_SharedType, X, Y, TF):- as_tf( '#='(X,Y),TF),!. eq_unify( Eq, SharedType, X, Y, TF):- as_tf(eval_until_unify(Eq,SharedType, X, Y), TF). From 50b9c1f6c09018c3bcbc42c32caeff33924527e0 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Wed, 28 Aug 2024 04:49:33 -0700 Subject: [PATCH 58/77] remove startup warning Found file *.metta relative to the current working directory. --- mettalog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mettalog b/mettalog index f1b146cec66..abf9631b2f3 100755 --- a/mettalog +++ b/mettalog @@ -960,7 +960,7 @@ STDIO_OPTIONS=() set_io_flags STDIO_OPTIONS # Generate the final command -METTA_CMD="$MLOG -- --python=$python_flag ${PRE_METTALOG_OPTIONS[*]} ${METTALOG_OPTIONS[*]} ${METTALOG_OPTIONS_LAST[*]} ${STDIO_OPTIONS[*]}" +METTA_CMD="$MLOG -- --python=$python_flag -- ${PRE_METTALOG_OPTIONS[*]} ${METTALOG_OPTIONS[*]} ${METTALOG_OPTIONS_LAST[*]} ${STDIO_OPTIONS[*]}" OS=$(uname) From 60b9528e95d624bf5171d5f55fef9d0f9bf312c2 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Wed, 28 Aug 2024 04:51:05 -0700 Subject: [PATCH 59/77] only gives output when needing to create venv --- scripts/ensure_venv | 87 +++++++++++++++++++++++++++++++-------------- 1 file changed, 60 insertions(+), 27 deletions(-) diff --git a/scripts/ensure_venv b/scripts/ensure_venv index abc5773d1ab..d33fd279305 100755 --- a/scripts/ensure_venv +++ b/scripts/ensure_venv @@ -1,28 +1,56 @@ #!/bin/bash -# Name of the virtual environment directory -# Check if VENV_DIR is not set or is empty -if [ -z "$VENV_DIR" ]; then - # Then check if VIRTUAL_ENV is set and points to a valid directory - if [ -n "$VIRTUAL_ENV" ] && [ -d "$VIRTUAL_ENV" ]; then - # If VIRTUAL_ENV is valid, use it for VENV_DIR - VENV_DIR="$VIRTUAL_ENV" - else - # Otherwise, default to 'venv' -VENV_DIR="venv" - fi +# Ensure the script is being sourced +if [[ "${BASH_SOURCE[0]}" == "${0}" ]]; then + echo "Warning: This script should be sourced, not executed directly." >&2 + exit 1 # Exit the script if it's not being sourced fi +# Get the directory of the script +SCRIPT_DIR=$(dirname "$(realpath "${BASH_SOURCE[0]}")") +# Set VENV_DIR to one directory above the script's directory +PARENT_DIR=$(dirname "$SCRIPT_DIR") +VENV_DIR="$PARENT_DIR/venv" + +# Default verbosity level (0: quiet, 1: normal, 2: verbose) +VERBOSITY=1 + +# Parse command-line options +for arg in "$@"; do + case $arg in + -v|--verbose) + VERBOSITY=2 + ;; + -q|--quiet) + VERBOSITY=0 + ;; + *) + #echo "Usage: source $0 [-v|--verbose] [-q|--quiet]" >&2 + #exit 1 + ;; + esac +done + +# echo "VERBOSITY=$VERBOSITY" + +# Function to print messages based on verbosity level +log() { + local level="$1" + shift + if [ "$level" -le "$VERBOSITY" ]; then + echo "$@" >&2 + fi +} + # Function to activate the virtual environment activate_venv() { - echo "Activating the virtual environment: $(realpath $VENV_DIR)" + log 2 "Activating the virtual environment: $(realpath $VENV_DIR)" source "$VENV_DIR/bin/activate" } # Function to check if we are inside a virtual environment is_inside_venv() { - if [[ "$VIRTUAL_ENV" != "" ]] - then + if [[ "$VIRTUAL_ENV" != "" ]]; then return 0 # True, script is running inside a virtual environment else return 1 # False, script is not running inside a virtual environment @@ -32,11 +60,11 @@ is_inside_venv() { # Function to create a virtual environment create_venv() { if [ ! -d "$VENV_DIR" ]; then - echo "Creating a virtual environment: $VENV_DIR" + log 1 "Creating a virtual environment: $VENV_DIR" python3 -m venv "$VENV_DIR" # Assuming the script is run from a virtual environment with useful packages if [ -n "$VIRTUAL_ENV" ] && [ -d "$VIRTUAL_ENV" ]; then - echo "Inheriting packages from existing environment: $VIRTUAL_ENV" + log 2 "Inheriting packages from existing environment: $VIRTUAL_ENV" source "$VIRTUAL_ENV/bin/activate" pip freeze > /tmp/requirements.txt deactivate @@ -44,29 +72,34 @@ create_venv() { pip install -r /tmp/requirements.txt rm /tmp/requirements.txt fi - if [ -f "requirements.txt" ]; then - : - #echo "Found local requirements.txt, installing packages..." - #pip install -r requirements.txt - fi + if [ -f "requirements.txt" ]; then + : + #log 2 "Found local requirements.txt, installing packages..." + #pip install -r requirements.txt + fi else - : # echo "Virtual environment already exists: $VENV_DIR" + log 2 "Virtual environment already exists: $VENV_DIR" fi } # Main logic of the script if is_inside_venv; then - : #echo "Script is running inside a virtual environment: $VIRTUAL_ENV" + if [ "$VIRTUAL_ENV" != "$(realpath $VENV_DIR)" ]; then + log 1 "Reusing virtual environment: $VIRTUAL_ENV" + #log 1 "Expected virtual environment: $(realpath $VENV_DIR)" + else + log 2 "Script is running inside the expected virtual environment: $VENV_DIR" + fi else - # echo "Script is not running inside a virtual environment." + log 2 "Script is not running inside a virtual environment." create_venv activate_venv # Relaunch the script inside the virtual environment - # echo "Relaunching the script inside the virtual environment..." - # exec "$0" "$@" + #log 2 "Relaunching the script inside the virtual environment..." + #exec "$0" "$@" fi # Place your script's main execution logic here -# echo "Executing the main script logic..." +#log 2 "Executing the main script logic..." From 0d005730daa0450577a32b556f72bfd0d09a03bc Mon Sep 17 00:00:00 2001 From: logicmoo Date: Wed, 28 Aug 2024 04:56:46 -0700 Subject: [PATCH 60/77] debuggable calls to rust --- .Attic/metta_lang/metta_eval.pl | 8 +- .Attic/metta_lang/metta_printer.pl | 5 +- .Attic/metta_lang/metta_python.pl | 35 +- compiler-project.vpj | 801 ++++++++++++++++++++++++++++- 4 files changed, 832 insertions(+), 17 deletions(-) diff --git a/.Attic/metta_lang/metta_eval.pl b/.Attic/metta_lang/metta_eval.pl index 098ff5d4686..9e296d96270 100755 --- a/.Attic/metta_lang/metta_eval.pl +++ b/.Attic/metta_lang/metta_eval.pl @@ -1808,12 +1808,12 @@ eval_40(Eq,RetType,Depth,Self,['*',N1,N2],N):- number(N1), eval_args(Eq,RetType,Depth,Self,N2,N2Res), fake_notrace(catch_err(N is N1*N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). +eval_20(_Eq,_RetType,_Depth,_Self,['rust',Bang,PredDecl],Res):- Bang == '!', !, + rust_metta_run(exec(PredDecl),Res), nop(write_src(res(Res))). eval_20(_Eq,_RetType,_Depth,_Self,['rust',PredDecl],Res):- !, - must_det_ll((rust_metta_run(PredDecl,Res), - nop(write_src(res(Res))))). + rust_metta_run((PredDecl),Res), nop(write_src(res(Res))). eval_20(_Eq,_RetType,_Depth,_Self,['rust!',PredDecl],Res):- !, - must_det_ll((rust_metta_run(exec(PredDecl),Res), - nop(write_src(res(Res))))). + rust_metta_run(exec(PredDecl),Res), nop(write_src(res(Res))). eval_70(_Eq,_RetType,_Depth,_Self,['py-atom',Arg],Res):- !, must_det_ll((py_atom(Arg,Res))). diff --git a/.Attic/metta_lang/metta_printer.pl b/.Attic/metta_lang/metta_printer.pl index 59a1daaa2fb..db7ef40bcbf 100755 --- a/.Attic/metta_lang/metta_printer.pl +++ b/.Attic/metta_lang/metta_printer.pl @@ -107,6 +107,8 @@ is_final_write(V):- var(V), !, write_dvar(V),!. is_final_write('$VAR'(S)):- !, write_dvar(S),!. is_final_write('#\\'(S)):- !, format("'~w'",[S]). +is_final_write(V):- py_is_enabled,py_is_py(V),!,py_ppp(V),!. + is_final_write([VAR,V|T]):- '$VAR'==VAR, T==[], !, write_dvar(V). is_final_write('[|]'):- write('Cons'),!. is_final_write([]):- !, write('()'). @@ -140,7 +142,7 @@ once(Mesg),nb_setval(W,false)),nb_setval(W,false). :- dynamic(py_is_enabled/0). -py_is_enabled:- predicate_property(py_ppp(_),foreign), asserta((py_is_enabled:-!)). +py_is_enabled:- predicate_property(py_ppp(_),defined), asserta((py_is_enabled:-!)). %write_src(V):- !, \+ \+ quietly(pp_sex(V)),!. write_src(V):- \+ \+ notrace(pp_sex(V)),!. @@ -149,7 +151,6 @@ % Various 'write_src' and 'pp_sex' rules are handling the writing of the source, % dealing with different types of values, whether they are lists, atoms, numbers, strings, compounds, or symbols. pp_sexi(V):- is_final_write(V),!. -pp_sexi(V):- py_is_enabled,py_is_py(V),!,py_ppp(V),!. pp_sexi(V):- is_dict(V),!,print(V). pp_sexi((USER:Body)) :- USER==user,!, pp_sex(Body). pp_sexi(V):- allow_concepts,!,with_concepts('False',pp_sex(V)),flush_output. diff --git a/.Attic/metta_lang/metta_python.pl b/.Attic/metta_lang/metta_python.pl index 41623288c63..9f6182e3f39 100755 --- a/.Attic/metta_lang/metta_python.pl +++ b/.Attic/metta_lang/metta_python.pl @@ -107,11 +107,12 @@ py_is_module_unsafe(M):- py_is_object(M),!,py_type(M,module). py_is_module_unsafe(M):- catch((py_call(M,X),py_type(X,module)),_,fail). -py_is_py(_):- \+ py_is_enabled, !, fail. +%py_is_py(_):- \+ py_is_enabled, !, fail. py_is_py(V):- var(V),!, get_attr(V,pyobj,_),!. -py_is_py(V):- atomic(V), !, py_is_object(V),!. -py_is_py(V):- \+ callable(V),!,fail. +py_is_py(V):- compound(V),!,fail. py_is_py(V):- is_list(V),!,fail. +py_is_py(V):- atomic(V), !, \+ atom(V), py_is_object(V),!. +py_is_py(V):- \+ callable(V),!,fail. py_is_py(V):- py_is_tuple(V),!. py_is_py(V):- py_is_py_dict(V),!. py_is_py(V):- py_is_list(V),!. @@ -376,12 +377,14 @@ return runner.run(obj) def rust_unwrap(obj): + if isinstance(obj,SymbolAtom): + return obj.get_name() + if isinstance(obj,ExpressionAtom): + return obj.get_children() if isinstance(obj,GroundedAtom): - return obj.get_object() + return __repr__(obj.get_object()) if isinstance(obj,GroundedObject): return obj.content - if isinstance(obj,ExpressionAtom): - return obj.get_children() return obj def rust_deref(obj): @@ -864,22 +867,34 @@ %rust_metta_run(exec(S),Run):- \+ callable(S), string_concat('!',S,SS),!,rust_metta_run(SS,Run). rust_metta_run(S,Run):- coerce_string(S,R),!,rust_metta_run1(R,Run). %rust_metta_run(I,O):- -rust_metta_run1(I,O):- load_hyperon_module, !, py_ocall(hyperon_module:rust_metta_run(I),M),!,py_iter(M,R),delist1(R,R1),rust_to_pl(R1,O). +rust_metta_run1(I,O):- load_hyperon_module, !, py_ocall(hyperon_module:rust_metta_run(I),M),!,rust_return(M,O). rust_metta_run1(R,Run):- % run with_safe_argv(((( %ensure_rust_metta(MeTTa), py_call(mettalog:rust_metta_run(R),Run))))). +rust_return(M,O):- (py_iter(M,R,[py_object(true)]),py_iter(R,R1,[py_object(true)]))*->rust_to_pl(R1,O);(fail,rust_to_pl(M,O)). +%rust_return(M,O):- rust_to_pl(M,O). +%rust_return(M,O):- py_iter(M,R,[py_object(true)]),rust_to_pl(R,O). +%rust_return(M,O):- py_iter(M,O). %,delist1(R,O). delist1([R],R):-!. delist1(R,R). % Maybe warn here? rust_to_pl(L,P):- var(L),!,L=P. +%rust_to_pl([],P):- !, P=[]. rust_to_pl(L,P):- is_list(L),!,maplist(rust_to_pl,L,P). +rust_to_pl(R,P):- compound(R),!,compound_name_arguments(R,F,RR),maplist(rust_to_pl,RR,PP),compound_name_arguments(P,F,PP). +rust_to_pl(R,P):- \+ py_is_object(R),!,P=R. rust_to_pl(R,P):- py_type(R,'ExpressionAtom'),py_mcall(R:get_children(),L),!,maplist(rust_to_pl,L,P). -rust_to_pl(R,P):- py_type(R,'GroundedAtom'),py_ocall(R:get_object(),L),!,rust_to_pl(L,P). rust_to_pl(R,P):- py_type(R,'SymbolAtom'),py_acall(R:get_name(),P),!. -rust_to_pl(R,P):- py_type(R,'SpaceRef'),P=R. %py_acall(R:get_payload(),P),!. +rust_to_pl(R,P):- py_type(R,'VariableAtom'),py_acall(R:'__repr__'(),P),!. +rust_to_pl(R,P):- py_type(R,'VariableAtom'),py_acall(R:get_name(),N),!,atom_concat('$',N,P). +rust_to_pl(R,P):- py_type(R,'SpaceRef'),!,py_scall(R:'__str__'(),P),!. +%rust_to_pl(R,P):- py_type(R,'ValueObject'),py_acall(R:'__repr__'(),P),!. +rust_to_pl(R,PT):- py_type(R,'GroundedAtom'),py_ocall(R:get_grounded_type(),T),rust_to_pl(T,TT),py_ocall(R:get_object(),L),!,rust_to_pl(L,P),comnbine_term_l(TT,P,PT). rust_to_pl(R,P):- py_is_list(R),py_m(R,L),R\==L,!,rust_to_pl(L,P). +rust_to_pl(R,PT):- py_acall(R:'__repr__'(),P),py_type(R,T),!,PT=..[T,P]. +rust_to_pl(R,P):- py_acall(R:'__repr__'(),P),!. rust_to_pl(R,P):- load_hyperon_module, !, py_ocall(hyperon_module:rust_deref(R),M),!, (R\==M -> rust_to_pl(M,P) ; M=P). @@ -891,6 +906,8 @@ print_py(Py):- py_to_pl(Py,R), print(R),nl. +comnbine_term_l(T,P,ga(P,T)). + %coerce_string(S,R):- atom(S), sformat(R,'~w',[S]),!. coerce_string(S,R):- string(S),!,S=R. coerce_string(S,R):- with_output_to(string(R),write_src(S)),!. diff --git a/compiler-project.vpj b/compiler-project.vpj index 9ebf6ea11c6..24ca99d6c18 100755 --- a/compiler-project.vpj +++ b/compiler-project.vpj @@ -72,9 +72,804 @@ Filters="" GUID="{5BB17C1C-B7AC-4E20-A88A-FB0E514087FF}"> - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -122,4 +917,6 @@ + + From 10b977fead7c0c5db241782b6f52e0edb8309071 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Wed, 28 Aug 2024 10:18:38 -0700 Subject: [PATCH 61/77] combine_term_l --- .Attic/metta_lang/metta_compiler.pl | 1 - .Attic/metta_lang/metta_eval.pl | 12 ++++- .Attic/metta_lang/metta_interp.pl | 1 + .Attic/metta_lang/metta_python.pl | 50 +++++++++++++------- .Attic/metta_lang/metta_repl.pl | 3 +- compiler-project.vpj => Compiler-project.vpj | 0 6 files changed, 48 insertions(+), 19 deletions(-) rename compiler-project.vpj => Compiler-project.vpj (100%) mode change 100755 => 100644 diff --git a/.Attic/metta_lang/metta_compiler.pl b/.Attic/metta_lang/metta_compiler.pl index 6abf1abb17a..7dbc7fbe31d 100755 --- a/.Attic/metta_lang/metta_compiler.pl +++ b/.Attic/metta_lang/metta_compiler.pl @@ -794,7 +794,6 @@ % % Example: % funct_with_result_is_nth_of_pred(HeadIs,+(1, 2), Result, 3, +(1, 2, Result)). - into_callable(Pred,AsPred):- is_ftVar(Pred),!,AsPred=holds(Pred). into_callable(Pred,AsPred):- Pred=AsPred,!. into_callable(Pred,AsPred):- iz_conz(Pred), !,AsPred=holds(Pred). diff --git a/.Attic/metta_lang/metta_eval.pl b/.Attic/metta_lang/metta_eval.pl index 9e296d96270..0db2b7b07a7 100755 --- a/.Attic/metta_lang/metta_eval.pl +++ b/.Attic/metta_lang/metta_eval.pl @@ -78,6 +78,7 @@ self_eval0('%Undefined%'). self_eval0(X):- atom(X),!, \+ nb_bound(X,_),!. + nb_bound(Name,X):- atom(Name), atom_concat('&', _, Name), nb_current(Name, X). @@ -127,7 +128,11 @@ % is_metta_declaration([F|T]):- is_list(T), is_user_defined_head([F]),!. +% Sets the current self space to '&self'. This is likely used to track the current context or scope during the evaluation of Metta code. :- nb_setval(self_space, '&self'). + +%! eval_to(+X,+Y) is semidet. +% checks if X evals to Y evals_to(XX,Y):- Y=@=XX,!. evals_to(XX,Y):- Y=='True',!, is_True(XX),!. @@ -139,6 +144,10 @@ get_type(Arg,Type):- eval_H(['get-type',Arg],Type). +%! eval_true(+X) is semidet. +% Evaluates the given term X and succeeds if X is not a constraint (i.e. \+ iz_conz(X)) and is callable, and calling X succeeds. +% +% If X is not callable, this predicate will attempt to evaluate the arguments of X (using eval_args/2) and succeed if the result is not False. eval_true(X):- \+ iz_conz(X), callable(X), call(X). eval_true(X):- eval_args(X,Y), once(var(Y) ; \+ is_False(Y)). @@ -154,6 +163,8 @@ eval(Eq,RetType,Depth,Self,X,Y))). */ + +%! eval_args(+X,-Y) is semidet. eval_args(X,Y):- current_self(Self), eval_args(500,Self,X,Y). %eval_args(Eq,RetType,Depth,_Self,X,_Y):- forall(between(6,Depth,_),write(' ')),writeqln(eval_args(Eq,RetType,X)),fail. eval_args(Depth,Self,X,Y):- eval_args('=',_RetType,Depth,Self,X,Y). @@ -169,7 +180,6 @@ eval_args(Eq,RetType,Depth,Self,X,Y):- notrace(nonvar(Y)),!, eval_args(Eq,RetType,Depth,Self,X,XX),evals_to(XX,Y). - eval_args(Eq,RetType,_Dpth,_Slf,[X|T],Y):- T==[], number(X),!, do_expander(Eq,RetType,X,YY),Y=[YY]. /* diff --git a/.Attic/metta_lang/metta_interp.pl b/.Attic/metta_lang/metta_interp.pl index eab268d7615..c9de92fe74b 100755 --- a/.Attic/metta_lang/metta_interp.pl +++ b/.Attic/metta_lang/metta_interp.pl @@ -227,6 +227,7 @@ null_output(MFS):- dont_change_streams,!, original_user_output(MFS),!. null_output(MFS):- use_module(library(memfile)), new_memory_file(MF),open_memory_file(MF,append,MFS). +:- volatile(null_user_output/1). :- dynamic(null_user_output/1). :- null_user_output(_)->true;(null_output(MFS), asserta(null_user_output(MFS))). diff --git a/.Attic/metta_lang/metta_python.pl b/.Attic/metta_lang/metta_python.pl index 9f6182e3f39..e2854b914b0 100755 --- a/.Attic/metta_lang/metta_python.pl +++ b/.Attic/metta_lang/metta_python.pl @@ -129,7 +129,12 @@ %py_is_list(V):- py_is_tuple(V). % Evaluations and Iterations -load_builtin_module:- py_module(builtin_module, +:- thread_local(did_load_builtin_module/0). +:- volatile(did_load_builtin_module/0). +:- dynamic(did_load_builtin_module/0). +load_builtin_module:- did_load_builtin_module,!. +load_builtin_module:- assert(did_load_builtin_module), +py_module(builtin_module, ' import sys #import numpy @@ -347,6 +352,7 @@ %py_ppp(V):-metta_py_pp(V). % Evaluations and Iterations +:- thread_local(did_load_hyperon_module/0). :- volatile(did_load_hyperon_module/0). :- dynamic(did_load_hyperon_module/0). load_hyperon_module:- did_load_hyperon_module,!. @@ -382,7 +388,7 @@ if isinstance(obj,ExpressionAtom): return obj.get_children() if isinstance(obj,GroundedAtom): - return __repr__(obj.get_object()) + return obj.get_object() if isinstance(obj,GroundedObject): return obj.content return obj @@ -402,9 +408,10 @@ py_acall(I,O):- catch(py_call(I,M,[py_string_as(atom)]),error(_,_),fail),!,O=M. py_ocall(I,O):- catch(py_call(I,M,[py_object(true),py_string_as(string)]),error(_,_),fail),!,O=M. -py_bi(I,O,Opts):- catch(py_call(builtin_module:I,M,Opts),error(_,_),fail),!,O=M. -py_obi(I,O):- py_ocall(builtin_module:I,O). -py_mbi(I,O):- py_mcall(builtin_module:I,O). + +py_bi(I,O,Opts):- load_builtin_module,catch(py_call(builtin_module:I,M,Opts),error(_,_),fail),!,O=M. +py_obi(I,O):- load_builtin_module,py_ocall(builtin_module:I,O). +py_mbi(I,O):- load_builtin_module,py_mcall(builtin_module:I,O). %?- py_call(type(hi-there), P),py_pp(P). get_str_rep(I,O):- py_mbi(get_str_rep(I),O),!. @@ -493,8 +500,8 @@ asserta(is_mettalog(MettaLearner)))). ensure_mettalog_py:- - load_builtin_module, - load_hyperon_module, + %load_builtin_module, + %load_hyperon_module, setenv('VSPACE_VERBOSE',0), with_safe_argv(ensure_mettalog_py(_)),!. @@ -888,13 +895,14 @@ rust_to_pl(R,P):- py_type(R,'ExpressionAtom'),py_mcall(R:get_children(),L),!,maplist(rust_to_pl,L,P). rust_to_pl(R,P):- py_type(R,'SymbolAtom'),py_acall(R:get_name(),P),!. rust_to_pl(R,P):- py_type(R,'VariableAtom'),py_acall(R:'__repr__'(),P),!. -rust_to_pl(R,P):- py_type(R,'VariableAtom'),py_acall(R:get_name(),N),!,atom_concat('$',N,P). -rust_to_pl(R,P):- py_type(R,'SpaceRef'),!,py_scall(R:'__str__'(),P),!. -%rust_to_pl(R,P):- py_type(R,'ValueObject'),py_acall(R:'__repr__'(),P),!. -rust_to_pl(R,PT):- py_type(R,'GroundedAtom'),py_ocall(R:get_grounded_type(),T),rust_to_pl(T,TT),py_ocall(R:get_object(),L),!,rust_to_pl(L,P),comnbine_term_l(TT,P,PT). +%rust_to_pl(R,P):- py_type(R,'VariableAtom'),py_acall(R:get_name(),N),!,atom_concat('$',N,P). +rust_to_pl(R,N):- py_type(R,'OperationObject'),py_acall(R:name(),N),!,cache_op(N,R). +rust_to_pl(R,P):- py_type(R,'SpaceRef'),!,P=R. % py_scall(R:'__str__'(),P),!. +rust_to_pl(R,P):- py_type(R,'ValueObject'),py_ocall(R:'value'(),L),!,rust_to_pl(L,P). +rust_to_pl(R,PT):- py_type(R,'GroundedAtom'),py_ocall(R:get_grounded_type(),T),rust_to_pl(T,TT),py_ocall(R:get_object(),L),!,rust_to_pl(L,P),combine_term_l(TT,P,PT). rust_to_pl(R,P):- py_is_list(R),py_m(R,L),R\==L,!,rust_to_pl(L,P). -rust_to_pl(R,PT):- py_acall(R:'__repr__'(),P),py_type(R,T),!,PT=..[T,P]. -rust_to_pl(R,P):- py_acall(R:'__repr__'(),P),!. +rust_to_pl(R,PT):- py_type(R,T),combine_term_l(T,R,PT),!. +%rust_to_pl(R,P):- py_acall(R:'__repr__'(),P),!. rust_to_pl(R,P):- load_hyperon_module, !, py_ocall(hyperon_module:rust_deref(R),M),!, (R\==M -> rust_to_pl(M,P) ; M=P). @@ -903,10 +911,19 @@ rust_metta_run(S,Py), print_py(Py). +:- volatile(cached_py_op/2). +cache_op(N,R):- asserta_if_new(cached_py_op(N,R)). + print_py(Py):- py_to_pl(Py,R), print(R),nl. -comnbine_term_l(T,P,ga(P,T)). +combine_term_l('OperationObject',P,P):-!. +combine_term_l('Number',P,P):-!. +combine_term_l('Bool',P,P):-!. +combine_term_l('ValueObject',R,P):-R=P,!. %rust_to_pl(R,P),!. +combine_term_l('%Undefined%',R,P):-rust_to_pl(R,P),!. +combine_term_l('hyperon::space::DynSpace',P,P):-!. +combine_term_l(T,P,ga(P,T)). %coerce_string(S,R):- atom(S), sformat(R,'~w',[S]),!. coerce_string(S,R):- string(S),!,S=R. @@ -952,7 +969,6 @@ */ %:- ensure_loaded(metta_interp). -on_restore1:- ensure_mettalog_py. :- dynamic(want_py_lib_dir/1). :- prolog_load_context(directory, ChildDir), @@ -996,5 +1012,7 @@ % py_initialize(, +Argv, +Options) -:- load_builtin_module. +on_restore1:- ensure_mettalog_py. +on_restore2:- !. +%on_restore2:- load_builtin_module. %:- load_hyperon_module. diff --git a/.Attic/metta_lang/metta_repl.pl b/.Attic/metta_lang/metta_repl.pl index 0f90f1a9d5c..20a48794b39 100755 --- a/.Attic/metta_lang/metta_repl.pl +++ b/.Attic/metta_lang/metta_repl.pl @@ -551,7 +551,8 @@ %add_history_string("!(load-flybase-full)"), %add_history_string("!(pfb3)"), %add_history_string("!(obo-alt-id $X BS:00063)"), - %add_history_string("!(and (total-rows $T TR$) (unique-values $T2 $Col $TR))"),!. + %add_history_string("!(and (total-rows $T TR$) (unique-values $T2 $Col $TR))"), + !. install_readline(_NoTTY). % For non-tty(true) clients over SWISH/Http/Rest server :- dynamic setup_done/0. diff --git a/compiler-project.vpj b/Compiler-project.vpj old mode 100755 new mode 100644 similarity index 100% rename from compiler-project.vpj rename to Compiler-project.vpj From bae69659b6a8a3fe197a2e676cf43d5d8a5fb246 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Wed, 28 Aug 2024 18:10:57 -0700 Subject: [PATCH 62/77] cached_py_op --- .Attic/metta_lang/metta_python.pl | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/.Attic/metta_lang/metta_python.pl b/.Attic/metta_lang/metta_python.pl index e2854b914b0..455584e57ca 100755 --- a/.Attic/metta_lang/metta_python.pl +++ b/.Attic/metta_lang/metta_python.pl @@ -912,7 +912,9 @@ print_py(Py). :- volatile(cached_py_op/2). -cache_op(N,R):- asserta_if_new(cached_py_op(N,R)). +cache_op(N,R):- asserta_if_new(cached_py_op(N,R)),fbug(cached_py_op(N,R)). +:- volatile(cached_py_type/2). +cache_type(N,R):- asserta_if_new(cached_py_type(N,R)),fbug(cached_py_type(N,R)). print_py(Py):- py_to_pl(Py,R), print(R),nl. @@ -923,6 +925,7 @@ combine_term_l('ValueObject',R,P):-R=P,!. %rust_to_pl(R,P),!. combine_term_l('%Undefined%',R,P):-rust_to_pl(R,P),!. combine_term_l('hyperon::space::DynSpace',P,P):-!. +combine_term_l([Ar|Stuff],Op,Op):- Ar == (->), !, cache_type(Op,[Ar|Stuff]). combine_term_l(T,P,ga(P,T)). %coerce_string(S,R):- atom(S), sformat(R,'~w',[S]),!. @@ -1016,3 +1019,18 @@ on_restore2:- !. %on_restore2:- load_builtin_module. %:- load_hyperon_module. + + + +% grab the 1st variable Var +subst_each_var([Var|RestOfVars],Term,Output):- !, + % replace all occurences of Var with _ (Which is a new anonymous variable) + subst(Term, Var, _ ,Mid), + % Do the RestOfVars + subst_each_var(RestOfVars,Mid,Output). +% no more vars left to replace +subst_each_var(_, TermIO, TermIO). + + + + From 20b1459def7b2cb9dd122ff566d04f68345eafd2 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Thu, 29 Aug 2024 03:39:36 -0700 Subject: [PATCH 63/77] as_var --- .Attic/metta_lang/metta_python.pl | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/.Attic/metta_lang/metta_python.pl b/.Attic/metta_lang/metta_python.pl index 455584e57ca..fb3d70563f7 100755 --- a/.Attic/metta_lang/metta_python.pl +++ b/.Attic/metta_lang/metta_python.pl @@ -894,7 +894,7 @@ rust_to_pl(R,P):- \+ py_is_object(R),!,P=R. rust_to_pl(R,P):- py_type(R,'ExpressionAtom'),py_mcall(R:get_children(),L),!,maplist(rust_to_pl,L,P). rust_to_pl(R,P):- py_type(R,'SymbolAtom'),py_acall(R:get_name(),P),!. -rust_to_pl(R,P):- py_type(R,'VariableAtom'),py_acall(R:'__repr__'(),P),!. +rust_to_pl(R,P):- py_type(R,'VariableAtom'),py_scall(R:get_name(),N),!,as_var(N,P),!. %rust_to_pl(R,P):- py_type(R,'VariableAtom'),py_acall(R:get_name(),N),!,atom_concat('$',N,P). rust_to_pl(R,N):- py_type(R,'OperationObject'),py_acall(R:name(),N),!,cache_op(N,R). rust_to_pl(R,P):- py_type(R,'SpaceRef'),!,P=R. % py_scall(R:'__str__'(),P),!. @@ -907,6 +907,9 @@ load_hyperon_module, !, py_ocall(hyperon_module:rust_deref(R),M),!, (R\==M -> rust_to_pl(M,P) ; M=P). +as_var('_',_):-!. +as_var(N,'$VAR'(S)):-sformat(S,'_~w',[N]),!. + rust_metta_run(S):- rust_metta_run(S,Py), print_py(Py). From 38734622571f6521732e1511f4e6fdf42051fee7 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Thu, 29 Aug 2024 03:40:34 -0700 Subject: [PATCH 64/77] Higher Order pred-* set operations --- .Attic/metta_lang/metta_eval.pl | 56 +++++++++++++++++++++++++++++---- 1 file changed, 50 insertions(+), 6 deletions(-) diff --git a/.Attic/metta_lang/metta_eval.pl b/.Attic/metta_lang/metta_eval.pl index 0db2b7b07a7..e73be13f868 100755 --- a/.Attic/metta_lang/metta_eval.pl +++ b/.Attic/metta_lang/metta_eval.pl @@ -1689,15 +1689,54 @@ fromNumber(N,RetVal), check_returnval(Eq,RetType,RetVal). */ +%% lazy_union(+E1_Call1, +E2_Call2, -E) is nondet. +% - Performs a union operation using lazy evaluation +% Arguments: +% - E1^Call1: The first goal (Call1) generating elements (E1) +% - E2^Call2: The second goal (Call2) generating elements (E2) +% - E: The resulting element that is part of the union of the two sets +lazy_union(P2, E1^Call1, E2^Call2, E) :- + % Step 1: Use lazy_findall/3 to declare that all elements satisfying Call1 are supposedly in List1 + lazy_findall(E1, Call1, List1), + % Step 2: Use lazy_findall/3 to declare that all elements satisfying Call2 are supposedly in List2 + lazy_findall(E2, Call2, List2), + % Step 3: Perform the union logic + ( % Case 1: If E is a member of List1, include it in the result + member(E, List1) + % Case 2: Otherwise, check if E is a member of List2 + % Additionally, ensure that E does not already exist in List1 + ; (member(E, List2), \+ (member(E1, List1), call(P2, E1, E))) + ). + eval_20(Eq,RetType,Depth,Self,['unique',Eval],RetVal):- !, term_variables(Eval+RetVal,Vars), no_repeats_var(YY), eval_20(Eq,RetType,Depth,Self,Eval,RetVal),YY=Vars. +eval_20(Eq,RetType,Depth,Self,['pred-unique',P2,Eval],RetVal):- !, + term_variables(Eval+RetVal,Vars), + no_repeats_var(P2,YY), + eval_20(Eq,RetType,Depth,Self,Eval,RetVal),YY=Vars. + eval_20(Eq,RetType,Depth,Self,['subtraction',Eval1,Eval2],RetVal):- !, - lazy_subtraction(RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + lazy_subtraction(=@=,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), + RetVal). + +eval_20(Eq,RetType,Depth,Self,['pred-subtraction',P2,Eval1,Eval2],RetVal):- !, + lazy_subtraction(P2,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), + RetVal). + +eval_20(Eq,RetType,Depth,Self,['union',Eval1,Eval2],RetVal):- !, + lazy_union(=@=,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), + RetVal). + +eval_20(Eq,RetType,Depth,Self,['pred-union',P2,Eval1,Eval2],RetVal):- !, + lazy_union(P2,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), RetVal). @@ -1705,18 +1744,23 @@ % !, Atom=[_|CDR],!,do_expander(Eq,RetType,Atom_list, CDR_Y ). eval_20(Eq,RetType,Depth,Self,['intersection',Eval1,Eval2],RetVal):- !, - lazy_intersection(RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + lazy_intersection(=@=,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), + RetVal). + +eval_20(Eq,RetType,Depth,Self,['pred-intersection',P2,Eval1,Eval2],RetVal):- !, + lazy_intersection(P2,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), RetVal). -lazy_intersection(E1^Call1, E2^Call2, E1) :- +lazy_intersection(P2, E1^Call1, E2^Call2, E1) :- % Step 1: Evaluate Call1 to generate E1 call(Call1), % Step 2: Use lazy_findall/3 to declare that all elements satisfying Call2 are supposedly in List2 lazy_findall(E2, Call2, List2), % Step 3: Perform the subtraction logic % Only return E1 if it is not a member of List2 - member(E2, List2), E1 == E2. + member(E2, List2), call(P2,E1,E2). %% lazy_subtraction(+E1_Call1, +E2_Call2, -E) is nondet. @@ -1726,14 +1770,14 @@ % - E1^Call1: The first goal (Call1) generating elements (E1). % - E2^Call2: The second goal (Call2) generating elements (E2). % - E: The resulting element after subtracting elements of the second set from the first set. -lazy_subtraction(E1^Call1, E2^Call2, E1) :- +lazy_subtraction(P2,E1^Call1, E2^Call2, E1) :- % Step 1: Evaluate Call1 to generate E1 call(Call1), % Step 2: Use lazy_findall/3 to declare that all elements satisfying Call2 are supposedly in List2 lazy_findall(E2, Call2, List2), % Step 3: Perform the subtraction logic % Only return E1 if it is not a member of List2 - \+ (member(E2, List2), E1 =@= E2). + \+ (member(E2, List2), call(P2, E1, E2)). eval_20(Eq,RetType,Depth,Self,PredDecl,Res):- From 8e9d14823fd5bd61fc2b4452ec1a76c81f236159 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Thu, 29 Aug 2024 04:03:57 -0700 Subject: [PATCH 65/77] variant_by_type --- .Attic/metta_lang/metta_eval.pl | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/.Attic/metta_lang/metta_eval.pl b/.Attic/metta_lang/metta_eval.pl index e73be13f868..da5789a84d4 100755 --- a/.Attic/metta_lang/metta_eval.pl +++ b/.Attic/metta_lang/metta_eval.pl @@ -1689,9 +1689,10 @@ fromNumber(N,RetVal), check_returnval(Eq,RetType,RetVal). */ -%% lazy_union(+E1_Call1, +E2_Call2, -E) is nondet. +%% lazy_union(:P2, +E1_Call1, +E2_Call2, -E) is nondet. % - Performs a union operation using lazy evaluation % Arguments: +% - P2: Any arity 2 predicate % - E1^Call1: The first goal (Call1) generating elements (E1) % - E2^Call2: The second goal (Call2) generating elements (E2) % - E: The resulting element that is part of the union of the two sets @@ -1709,19 +1710,21 @@ ). +variant_by_type(X,Y):- var(X),!,X==Y. +variant_by_type(X,Y):- X=@=Y. + eval_20(Eq,RetType,Depth,Self,['unique',Eval],RetVal):- !, term_variables(Eval+RetVal,Vars), no_repeats_var(YY), eval_20(Eq,RetType,Depth,Self,Eval,RetVal),YY=Vars. eval_20(Eq,RetType,Depth,Self,['pred-unique',P2,Eval],RetVal):- !, - term_variables(Eval+RetVal,Vars), no_repeats_var(P2,YY), - eval_20(Eq,RetType,Depth,Self,Eval,RetVal),YY=Vars. + eval_20(Eq,RetType,Depth,Self,Eval,RetVal),YY=RetVal. eval_20(Eq,RetType,Depth,Self,['subtraction',Eval1,Eval2],RetVal):- !, - lazy_subtraction(=@=,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + lazy_subtraction(variant_by_type,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), RetVal). @@ -1731,7 +1734,7 @@ RetVal). eval_20(Eq,RetType,Depth,Self,['union',Eval1,Eval2],RetVal):- !, - lazy_union(=@=,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + lazy_union(variant_by_type,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), RetVal). @@ -1744,7 +1747,7 @@ % !, Atom=[_|CDR],!,do_expander(Eq,RetType,Atom_list, CDR_Y ). eval_20(Eq,RetType,Depth,Self,['intersection',Eval1,Eval2],RetVal):- !, - lazy_intersection(=@=,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + lazy_intersection(variant_by_type,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), RetVal). @@ -1753,20 +1756,29 @@ RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), RetVal). +%% lazy_intersection(:P2, +E1_Call1, +E2_Call2, -E) is nondet. +% - Performs a intersection operation using lazy evaluation. +% - It intersects elements generated by Call2 from those generated by Call1. +% Arguments: +% - P2: Any arity 2 predicate +% - E1^Call1: The first goal (Call1) generating elements (E1). +% - E2^Call2: The second goal (Call2) generating elements (E2). +% - E: The resulting element after subtracting elements of the second set from the first set. lazy_intersection(P2, E1^Call1, E2^Call2, E1) :- % Step 1: Evaluate Call1 to generate E1 call(Call1), % Step 2: Use lazy_findall/3 to declare that all elements satisfying Call2 are supposedly in List2 lazy_findall(E2, Call2, List2), - % Step 3: Perform the subtraction logic + % Step 3: Perform the intersection logic % Only return E1 if it is not a member of List2 member(E2, List2), call(P2,E1,E2). -%% lazy_subtraction(+E1_Call1, +E2_Call2, -E) is nondet. +%% lazy_subtraction(:P2, +E1_Call1, +E2_Call2, -E) is nondet. % - Performs a subtraction operation using lazy evaluation. % - It subtracts elements generated by Call2 from those generated by Call1. % Arguments: +% - P2: Any arity 2 predicate % - E1^Call1: The first goal (Call1) generating elements (E1). % - E2^Call2: The second goal (Call2) generating elements (E2). % - E: The resulting element after subtracting elements of the second set from the first set. From 82a6ad7dbbf56bc56ae8321d1fa0582a21e5570b Mon Sep 17 00:00:00 2001 From: logicmoo Date: Thu, 29 Aug 2024 22:17:14 -0700 Subject: [PATCH 66/77] remove unused files --- .Attic/metta_lang/metta_eval.new | 854 ------- .Attic/metta_lang/metta_eval.old | 1633 ------------- .Attic/metta_lang/metta_eval.prev | 1549 ------------ .Attic/metta_lang/metta_interp.new | 1921 --------------- .Attic/metta_lang/metta_ontology.pl.pfc | 35 - .Attic/metta_lang/metta_ontology.pl.pfc2 | 684 ------ .Attic/metta_lang/metta_ontology.pl.pfc3 | 117 - .../metta_lang/metta_ontology_level_1.pfc.pl | 388 --- .../metta_lang/metta_ontology_level_2.pfc.pl | 251 -- .Attic/metta_lang/metta_reader.new | 1618 ------------- .Attic/metta_lang/metta_rust.pl | 5 - .Attic/metta_lang/metta_subst.bk | 833 ------- .Attic/metta_lang/metta_test_nars_1.pl | 1752 -------------- .Attic/metta_lang/metta_toplevel.pl.Unused | 2155 ----------------- .Attic/metta_lang/metta_types.pl.broken | 744 ------ .Attic/metta_lang/stdlib.metta | 694 ------ .Attic/metta_lang/stdlib_minimal.metta | 1001 -------- .Attic/metta_lang/swi_flybase.pl | 2 - .Attic/rust-wam/metta_prelude.pl | 242 -- 19 files changed, 16478 deletions(-) delete mode 100755 .Attic/metta_lang/metta_eval.new delete mode 100755 .Attic/metta_lang/metta_eval.old delete mode 100755 .Attic/metta_lang/metta_eval.prev delete mode 100755 .Attic/metta_lang/metta_interp.new delete mode 100755 .Attic/metta_lang/metta_ontology.pl.pfc delete mode 100755 .Attic/metta_lang/metta_ontology.pl.pfc2 delete mode 100755 .Attic/metta_lang/metta_ontology.pl.pfc3 delete mode 100755 .Attic/metta_lang/metta_ontology_level_1.pfc.pl delete mode 100755 .Attic/metta_lang/metta_ontology_level_2.pfc.pl delete mode 100755 .Attic/metta_lang/metta_reader.new delete mode 100755 .Attic/metta_lang/metta_rust.pl delete mode 100755 .Attic/metta_lang/metta_subst.bk delete mode 100755 .Attic/metta_lang/metta_test_nars_1.pl delete mode 100755 .Attic/metta_lang/metta_toplevel.pl.Unused delete mode 100755 .Attic/metta_lang/metta_types.pl.broken delete mode 100755 .Attic/metta_lang/stdlib.metta delete mode 100755 .Attic/metta_lang/stdlib_minimal.metta delete mode 100755 .Attic/metta_lang/swi_flybase.pl delete mode 100755 .Attic/rust-wam/metta_prelude.pl diff --git a/.Attic/metta_lang/metta_eval.new b/.Attic/metta_lang/metta_eval.new deleted file mode 100755 index 0f26e199d66..00000000000 --- a/.Attic/metta_lang/metta_eval.new +++ /dev/null @@ -1,854 +0,0 @@ - - - -%self_eval(X):- var(X),!. -%self_eval(X):- string(X),!. -%self_eval(X):- number(X),!. -%self_eval([]). -self_eval(X):- \+ callable(X),!. -self_eval(X):- is_valid_nb_state(X),!. -self_eval(X):- is_list(X),!,fail. -%self_eval(X):- compound(X),!. -%self_eval(X):- is_ref(X),!,fail. -self_eval(X):- atom(X),!, \+ nb_current(X,_),!. -self_eval('True'). self_eval('False'). self_eval('F'). - - -:- nb_setval(self_space, '&self'). -evals_to(XX,Y):- Y==XX,!. -evals_to(XX,Y):- Y=='True',!, is_True(XX),!. - -current_self(Space):- nb_current(self_space,Space). -eval_args(A,AA):- - current_self(Space), - eval_args(11,Space,A,AA). - -%eval_args(Depth,_Self,X,_Y):- forall(between(6,Depth,_),write(' ')),writeqln(eval_args(X)),fail. - -eval_args(_Dpth,_Slf,X,Y):- nonvar(Y),X=Y,!. -eval_args(Depth,Self,X,Y):- nonvar(Y),!,eval_args(Depth,Self,X,XX),evals_to(XX,Y). -eval_args(_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. -eval_args(_Dpth,_Slf,[X|T],Y):- T==[], \+ callable(X),!,Y=[X]. -%eval_args(_Dpth,_Slf,[X|T],Y):- T==[], \+ atom(X), self_eval(X), !,Y=[X]. - -%eval_args(Depth,Self,X,Y):- !, eval_args00(Depth,Self,X,Y). -eval_args(Depth,Self,X,Y):- - call_nth(eval_args00(Depth,Self,X,Y),Nth), - % if `True` is not commented, we fail two tests in examples/compat/test_scripts/b4_nondeterm.metta - ((X=@=Y;/*Y=='True';*/Y=='False') -> (!, (Nth=1->true;fail) ) ; true). - - -eval_args00(Depth,Self,[F|X],Y):- - (F=='superpose' ; ( option_value(no_repeats,false))), - mnotrace((D1 is Depth-1)),!, - eval_args0(D1,Self,[F|X],Y). - -eval_args00(Depth,Self,X,Y):- - mnotrace((no_repeats_var(YY), - D1 is Depth-1)), - eval_args0(D1,Self,X,Y), - mnotrace(( \+ (Y\=YY))). - - -%debugging_metta(G):-debugging(metta(eval))->ignore(G);true. - - -:- nodebug(metta(eval)). - - -w_indent(Depth,Goal):- - \+ \+ mnotrace(ignore((( - format('~N'), - setup_call_cleanup(forall(between(Depth,101,_),write(' ')),Goal, format('~N')))))). -indentq(Depth,Term):- - \+ \+ mnotrace(ignore((( - format('~N'), - setup_call_cleanup(forall(between(Depth,101,_),write(' ')),format('~q',[Term]), - format('~N')))))). - - -with_debug(Flag,Goal):- is_debugging(Flag),!, call(Goal). -with_debug(Flag,Goal):- flag(eval_num,_,0), - setup_call_cleanup(set_debug(Flag,true),call(Goal),set_debug(Flag,flase)). - -flag_to_var(Flag,Var):- atom(Flag), \+ atom_concat('trace-on-',_,Flag),!,atom_concat('trace-on-',Flag,Var). -flag_to_var(metta(Flag),Var):- !, nonvar(Flag), flag_to_var(Flag,Var). -flag_to_var(Flag,Var):- Flag=Var. - -set_debug(Flag,Val):- \+ atom(Flag), flag_to_var(Flag,Var), atom(Var),!,set_debug(Var,Val). -set_debug(Flag,true):- !, debug(metta(Flag)),flag_to_var(Flag,Var),set_option_value(Var,true). -set_debug(Flag,false):- nodebug(metta(Flag)),flag_to_var(Flag,Var),set_option_value(Var,false). -if_trace(Flag,Goal):- catch(ignore((is_debugging(Flag),Goal)),_,true). - -is_debugging(Flag):- var(Flag),!,fail. -is_debugging(Flag):- \+ atom(Flag), flag_to_var(Flag,Var), atom(Var),!,is_debugging(Var). -is_debugging(Flag):- debugging(Flag),!. -is_debugging(Flag):- debugging(metta(Flag)),!. -is_debugging(Flag):- flag_to_var(Flag,Var),!,option_value(Var,true). - - -eval_args0(Depth,_Slf,X,Y):- Depth<1,!,X=Y, (\+ is_debugging(overflow)-> true; flag(eval_num,_,0),set_debug((eval),true)). -eval_args0(_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. -eval_args0(Depth,Self,X,Y):- - Depth2 is Depth-1, - eval_args301(Depth,Self,X,M), - (M\=@=X ->eval_args0(Depth2,Self,M,Y);Y=X). - - - -eval_args301(Depth,Self,X,Y):- \+ debugging(metta(eval)),!, eval_args3011(Depth,Self,X,Y). -eval_args301(Depth,Self,X,Y):- flag(eval_num,EX,EX+1), - option_else(traclen,Max,100), - (EX>Max->(nodebug(metta(eval)),write('Switched off tracing. For a longer trace !(pragma! tracelen 101))'));true), - mnotrace((no_repeats_var(YY), D1 is Depth-1)), - DR is 99-D1, - if_trace((eval),indentq(Depth,'-->'(EX,Self,X,depth(DR)))), - Ret=retval(fail), - call_cleanup(( - eval_args3011(D1,Self,X,Y), - mnotrace(( \+ (Y\=YY), nb_setarg(1,Ret,Y)))), - mnotrace(ignore(((if_trace((eval),indentq(Depth,'<--'(EX,Ret)))))))), - (Ret\=@=retval(fail)->true;(rtrace(eval_args0(D1,Self,X,Y)),fail)). - -eval_args3011(Depth,Self,X,Y):- - call_nth(eval_args30(Depth,Self,X,Y),Nth), - % if `True` is not commented, we fail two tests in examples/compat/test_scripts/b4_nondeterm.metta - ((X=@=Y;/*Y=='True';*/Y=='False') -> (!, (Nth=1->true;fail) ) ; true). - -:- discontiguous eval_args30/4. -:- discontiguous eval_args2/4. - -eval_args30(_Dpth,_Slf,Name,Value):- atom(Name), nb_current(Name,Value),!. -eval_args30(_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. - -eval_args30(Depth,Self,[V|VI],VVO):- \+ is_list(VI),!, - eval_args(Depth,Self,VI,VM), - ( VM\==VI -> eval_args(Depth,Self,[V|VM],VVO) ; - (eval_args(Depth,Self,V,VV), (V\==VV -> eval_args(Depth,Self,[VV|VI],VVO) ; VVO = [V|VI]))). - -eval_args30(_Dpth,_Slf,X,Y):- \+ is_list(X),!,Y=X. - -eval_args30(Depth,Self,[V|VI],[V|VO]):- var(V),is_list(VI),!,maplist(eval_args(Depth,Self),VI,VO). - -eval_args30(_Dpth,_Slf,['repl!'],'True'):- !, repl. -eval_args30(Depth,Self,['!',Cond],Res):- !, call(eval_args(Depth,Self,Cond,Res)). -eval_args30(Depth,Self,['rtrace',Cond],Res):- !, rtrace(eval_args(Depth,Self,Cond,Res)). -eval_args30(Depth,Self,['time',Cond],Res):- !, time(eval_args(Depth,Self,Cond,Res)). -eval_args30(Depth,Self,['print',Cond],Res):- !, eval_args(Depth,Self,Cond,Res),format('~N'),print(Res),format('~N'). -% !(println! $1) -eval_args30(Depth,Self,['println!'|Cond],Res):- !, maplist(eval_args(Depth,Self),Cond,[Res|Out]), - format('~N'),maplist(write_src,[Res|Out]),format('~N'). -eval_args30(Depth,Self,['trace!',A|Cond],Res):- !, maplist(eval_args(Depth,Self),[A|Cond],[AA|Result]), - last(Result,Res), format('~N'),maplist(write_src,[AA]),format('~N'). - -%eval_args30(Depth,Self,['trace!',A,B],C):- !,eval_args(Depth,Self,B,C),format('~N'),wdmsg(['trace!',A,B]=C),format('~N'). -%eval_args30(_Dpth,_Slf,['trace!',A],A):- !, format('~N'),wdmsg(A),format('~N'). - -eval_args30(_Dpth,_Slf,List,Y):- is_list(List),maplist(self_eval,List),List=[H|_], \+ atom(H), !,Y=List. - -eval_args30(Depth,Self,['assertTrue', X],TF):- !, eval_args(Depth,Self,['assertEqual',X,'True'],TF). -eval_args30(Depth,Self,['assertFalse',X],TF):- !, eval_args(Depth,Self,['assertEqual',X,'False'],TF). - -eval_args30(Depth,Self,['assertEqual',X0,Y0],RetVal):- !, - subst_vars(X0,X),subst_vars(Y0,Y), - loonit_assert_source_tf( - ['assertEqual',X0,Y0], - (bagof_eval(Depth,Self,X,XX), bagof_eval(Depth,Self,Y,YY)), - equal_enough_for_test(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got,XX,expected,YY]). - -eval_args30(Depth,Self,['assertNotEqual',X0,Y0],RetVal):- !, - subst_vars(X0,X),subst_vars(Y0,Y), - loonit_assert_source_tf( - ['assertNotEqual',X0,Y0], - (setof_eval(Depth,Self,X,XX), setof_eval(Depth,Self,Y,YY)), - \+ equal_enough(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got,XX,expected,YY]). - -eval_args30(Depth,Self,['assertEqualToResult',X0,Y0],RetVal):- !, - subst_vars(X0,X),subst_vars(Y0,Y), - loonit_assert_source_tf( - ['assertEqualToResult',X0,Y0], - (bagof_eval(Depth,Self,X,XX), =(Y,YY)), - equal_enough_for_test(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got,XX,expected,YY]),!. - - -loonit_assert_source_tf(Src,Goal,Check,TF):- - copy_term(Goal,OrigGoal), - loonit_asserts(Src, time_eval('\n; EVAL TEST\n;',Goal), Check), - as_tf(Check,TF),!, - ignore(( - once((TF='True', is_debugging(pass));(TF='False', is_debugging(fail))), - with_debug((eval),time_eval('Trace',OrigGoal)))). - -sort_result(Res,Res):- \+ compound(Res),!. -sort_result([And|Res1],Res):- is_and(And),!,sort_result(Res1,Res). -sort_result([T,And|Res1],Res):- is_and(And),!,sort_result([T|Res1],Res). -sort_result([H|T],[HH|TT]):- !, sort_result(H,HH),sort_result(T,TT). -sort_result(Res,Res). - -unify_enough(L,L):-!. -unify_enough(L,C):- is_list(L),into_list_args(C,CC),!,unify_lists(CC,L). -unify_enough(C,L):- is_list(L),into_list_args(C,CC),!,unify_lists(CC,L). -unify_enough(C,L):- \+ compound(C),!,L=C. -unify_enough(L,C):- \+ compound(C),!,L=C. -unify_enough(L,C):- into_list_args(L,LL),into_list_args(C,CC),!,unify_lists(CC,LL). - -unify_lists(C,L):- \+ compound(C),!,L=C. -unify_lists(L,C):- \+ compound(C),!,L=C. -unify_lists([C|CC],[L|LL]):- unify_enough(L,C),!,unify_lists(CC,LL). - -equal_enough(R,V):- is_list(R),is_list(V),sort(R,RR),sort(V,VV),!,equal_enouf(RR,VV),!. -equal_enough(R,V):- copy_term(R,RR),copy_term(V,VV),equal_enouf(R,V),!,R=@=RR,V=@=VV. - -equal_enough_for_answer(XX,YY):- equal_enough(XX,YY),!. -equal_enough_for_answer(XX,Y):- sub_sterm1(YY,Y), equal_enough(YY,XX),!. - -equal_enough_for_test(X,Y):- must_det_ll((subst_vars(X,XX),subst_vars(Y,YY))),!,equal_enough_for_answer(XX,YY),!. - -equal_enouf(R,V):- R=@=V, !. -equal_enouf(_,V):- V=@='...',!. -equal_enouf(L,C):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). -equal_enouf(C,L):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). -%equal_enouf(R,V):- (var(R),var(V)),!, R=V. -equal_enouf(R,V):- (var(R);var(V)),!, R==V. -equal_enouf(R,V):- number(R),number(V),!, RV is abs(R-V), RV < 0.03 . -equal_enouf(R,V):- atom(R),!,atom(V), has_unicode(R),has_unicode(V). -equal_enouf(R,V):- (\+ compound(R) ; \+ compound(V)),!, R==V. -equal_enouf(L,C):- into_list_args(L,LL),into_list_args(C,CC),!,equal_enouf_l(CC,LL). - -equal_enouf_l(C,L):- \+ compound(C),!,L=@=C. -equal_enouf_l(L,C):- \+ compound(C),!,L=@=C. -equal_enouf_l([C|CC],[L|LL]):- !, equal_enouf(L,C),!,equal_enouf_l(CC,LL). - - -has_unicode(A):- atom_codes(A,Cs),member(N,Cs),N>127,!. -set_last_error(_). - - -eval_args30(Depth,Self,['match',Other,Goal,Template],Template):- into_space(Self,Other,Space),!, metta_atom_iter(Depth,Space,Goal). -eval_args30(Depth,Self,['match',Other,Goal,Template,Else],Template):- - (eval_args30(Depth,Self,['match',Other,Goal,Template],Template)*->true;Template=Else). - -% Macro: case -eval_args30(Depth,Self,X,Res):- - X= [CaseSym,A,CL],CaseSym == 'case', !, - into_case_list(CL,CASES), - findall(Key-Value, - (nth0(Nth,CASES,Case0), - (is_case(Key,Case0,Value), - if_trace((case),(format('~N'), - writeqln(c(Nth,Key)=Value))))),KVs),!, - ((eval_args(Depth,Self,A,AA), if_trace((case),writeqln(switch=AA)), - (select_case(Depth,Self,AA,KVs,Value)->true;(member(Void -Value,KVs),Void=='%void%'))) - *->true;(member(Void -Value,KVs),Void=='%void%')), - eval_args(Depth,Self,Value,Res). - - select_case(Depth,Self,AA,Cases,Value):- - (best_key(AA,Cases,Value) -> true ; - (maybe_special_keys(Depth,Self,Cases,CasES), - (best_key(AA,CasES,Value) -> true ; - (member(Void -Value,CasES),Void=='%void%')))). - - best_key(AA,Cases,Value):- - ((member(Match-Value,Cases),unify_enough(AA,Match))->true; - ((member(Match-Value,Cases),AA ==Match)->true; - ((member(Match-Value,Cases),AA=@=Match)->true; - (member(Match-Value,Cases),AA = Match)))). - - %into_case_list([[C|ASES0]],CASES):- is_list(C),!, into_case_list([C|ASES0],CASES),!. - into_case_list(CASES,CASES):- is_list(CASES),!. - is_case(AA,[AA,Value],Value):-!. - is_case(AA,[AA|Value],Value). - - maybe_special_keys(Depth,Self,[K-V|KVI],[AK-V|KVO]):- - eval_args(Depth,Self,K,AK), K\=@=AK,!, - maybe_special_keys(Depth,Self,KVI,KVO). - maybe_special_keys(Depth,Self,[_|KVI],KVO):- - maybe_special_keys(Depth,Self,KVI,KVO). - maybe_special_keys(_Depth,_Self,[],[]). - - -%[collapse,[1,2,3]] -eval_args30(Depth,Self,['collapse',List],Res):-!, bagof_eval(Depth,Self,List,Res). -%[superpose,[1,2,3]] -eval_args30(Depth,Self,['superpose',List],Res):- !, member(E,List),eval_args(Depth,Self,E,Res). - -get_set_sterm_p1(E,Cmpd,SA):- is_list(Cmpd), !, get_sa_p3(E,Cmpd,SA). -get_set_sterm_p1(E,Cmpd,SA):- compound(Cmpd), get_sa_p2(E,Cmpd,SA). - -get_sa_p2(E,Cmpd,setarg(N1,Cmpd)):- arg(N1,Cmpd,E). -get_sa_p2(E,Cmpd,SA):- arg(_,Cmpd,Arg),get_set_sterm_p1(E,Arg,SA). - -get_sa_p3(E,Cmpd, b_set_nth1(N1,Cmpd)):- nth1(N1,Cmpd,E). -get_sa_p3(E,Cmpd,SA):- member(Arg,Cmpd),get_set_sterm_p1(E,Arg,SA). - - -nb_set_nth1(N, [_|List], Ele) :- N > 1, !, Nm1 is N - 1, nb_set_nth1(Nm1, List, Ele). -nb_set_nth1(N, List, Ele) :- nb_setarg(N, List, Ele). - -b_set_nth1(N, [_|List], Ele) :- N > 1, !, Nm1 is N - 1, b_set_nth1(Nm1, List, Ele). -b_set_nth1(N, List, Ele) :- setarg(N, List, Ele). - -sub_sterm(Sub,Sub). -sub_sterm(Sub,Term):- sub_sterm1(Sub,Term). -sub_sterm1(_ ,List):- \+ compound(List),!,fail. -sub_sterm1(Sub,List):- is_list(List),!,member(SL,List),sub_sterm(Sub,SL). -sub_sterm1(_ ,[_|_]):-!,fail. -sub_sterm1(Sub,Term):- arg(_,Term,SL),sub_sterm(Sub,SL). - - -eval_args30(_Dpth,_Slf, ['new-space'], Res):- !, 'new-space'(Res). - -eval_args30(Depth,Self, Term, Res):- fail, - mnotrace(( get_set_sterm_p1(ST,Term,P1), % ST\==Term, - is_list(ST), ST = [F|List], atom(F), - handle_inner(F),maplist(nonvar,List), %maplist(atomic,List), - call(P1,Var))), !, - eval_args(Depth,Self,ST,Var), eval_args(Depth,Self, Term, Res). -/* -eval_args30(Depth,Self, Term, Res):- - mnotrace(( get_set_sterm_p1(ST,Term,P1), - compound(ST), ST = [F,List],F=='collapse',nonvar(List), %maplist(atomic,List), - call(P1,Var))), !, - bagof_eval(Depth,Self,List,Var), eval_args(Depth,Self, Term, Res). - -*/ -%handle_inner('superpose'). -%handle_inner('collapse'). -handle_inner('+'). - -max_counting(F,Max):- flag(F,X,X+1), X true; (flag(F,_,10),!,fail). - - -eval_args30(Depth,Self,['if',Cond,Then],Res):- !, - eval_args(Depth,Self,Cond,TF), - (is_True(TF) -> eval_args(Depth,Self,Then,Res) ; (fail, Res = [])). - -eval_args30(Depth,Self,['If',Cond,Then],Res):- !, - eval_args(Depth,Self,Cond,TF), - (is_True(TF) -> eval_args(Depth,Self,Then,Res) ; (fail, Res = [])). - -eval_args30(Depth,Self,['if',Cond,Then,Else],Res):- !, - eval_args(Depth,Self,Cond,TF), - (is_True(TF) -> eval_args(Depth,Self,Then,Res);eval_args(Depth,Self,Else,Res)). - -eval_args30(Depth,Self,['If',Cond,Then,Else],Res):- !, - eval_args(Depth,Self,Cond,TF), - (is_True(TF) -> eval_args(Depth,Self,Then,Res);eval_args(Depth,Self,Else,Res)). - -eval_args30(_Dpth,_Slf,[_,Nothing],Nothing):- 'Nothing'==Nothing,!. - -eval_args30(Depth,Self,['let',A,A5,AA],OO):- !, - %(var(A)->true;trace), - ((eval_args(Depth,Self,A5,AE), AE=A)), - eval_args(Depth,Self,AA,OO). -%eval_args30(Depth,Self,['let',A,A5,AA],AAO):- !,eval_args(Depth,Self,A5,A),eval_args(Depth,Self,AA,AAO). -eval_args30(Depth,Self,['let*',[],Body],RetVal):- !, eval_args(Depth,Self,Body,RetVal). -eval_args30(Depth,Self,['let*',[[Var,Val]|LetRest],Body],RetVal):- !, - eval_args30(Depth,Self,['let',Var,Val,['let*',LetRest,Body]],RetVal). - -eval_args30(Depth,Self,['colapse'|List], Flat):- !, maplist(eval_args(Depth,Self),List,Res),flatten(Res,Flat). -eval_args30(Depth,Self,['get-atoms',Other],PredDecl):- !,into_space(Self,Other,Space), metta_atom_iter(Depth,Space,PredDecl). -eval_args30(_Dpth,_Slf,['car-atom',Atom],CAR):- !, Atom=[CAR|_],!. -eval_args30(_Dpth,_Slf,['cdr-atom',Atom],CDR):- !, Atom=[_|CDR],!. - -eval_args30(Depth,Self,['Cons', A, B ],['Cons', AA, BB]):- no_cons_reduce, !, - eval_args(Depth,Self,A,AA), eval_args(Depth,Self,B,BB). - -eval_args30(Depth,Self,['Cons', A, B ],[AA|BB]):- \+ no_cons_reduce, !, - eval_args(Depth,Self,A,AA), eval_args(Depth,Self,B,BB). - - -eval_args30(Depth,Self,['change-state!',StateExpr, UpdatedValue], Ret):- !, eval_args(Depth,Self,StateExpr,StateMonad), - eval_args(Depth,Self,UpdatedValue,Value), 'change-state!'(Depth,Self,StateMonad, Value, Ret). -eval_args30(Depth,Self,['new-state',UpdatedValue],StateMonad):- !, - eval_args(Depth,Self,UpdatedValue,Value), 'new-state'(Depth,Self,Value,StateMonad). -eval_args30(Depth,Self,['get-state',StateExpr],Value):- !, - eval_args(Depth,Self,StateExpr,StateMonad), 'get-state'(StateMonad,Value). - - - -% eval_args30(Depth,Self,['get-state',Expr],Value):- !, eval_args(Depth,Self,Expr,State), arg(1,State,Value). - - - -check_type:- option_else(typecheck,TF,'False'), TF=='True'. - -:- dynamic is_registered_state/1. -:- flush_output. -:- setenv('RUST_BACKTRACE',full). - -% Function to check if an value is registered as a state name -:- dynamic(is_registered_state/1). -is_nb_state(G):- is_valid_nb_state(G) -> true ; - is_registered_state(G),nb_current(G,S),is_valid_nb_state(S). - - -:- multifile(state_type_method/3). -:- dynamic(state_type_method/3). -space_type_method(is_nb_state,new_space,init_state). -space_type_method(is_nb_state,clear_space,clear_nb_values). -space_type_method(is_nb_state,add_atom,add_nb_value). -space_type_method(is_nb_state,remove_atom,'change-state!'). -space_type_method(is_nb_state,replace_atom,replace_nb_value). -space_type_method(is_nb_state,atom_count,value_nb_count). -space_type_method(is_nb_state,get_atoms,'get-state'). -space_type_method(is_nb_state,atom_iter,value_nb_iter). - -state_type_method(is_nb_state,new_state,init_state). -state_type_method(is_nb_state,clear_state,clear_nb_values). -state_type_method(is_nb_state,add_value,add_nb_value). -state_type_method(is_nb_state,remove_value,'change-state!'). -state_type_method(is_nb_state,replace_value,replace_nb_value). -state_type_method(is_nb_state,value_count,value_nb_count). -state_type_method(is_nb_state,'get-state','get-state'). -state_type_method(is_nb_state,value_iter,value_nb_iter). -%state_type_method(is_nb_state,query,state_nb_query). - -% Clear all values from a state -clear_nb_values(StateNameOrInstance) :- - fetch_or_create_state(StateNameOrInstance, State), - nb_setarg(1, State, []). - - - -% Function to confirm if a term represents a state -is_valid_nb_state(State):- compound(State),functor(State,'State',_). - -% Find the original name of a given state -state_original_name(State, Name) :- - is_registered_state(Name), - nb_current(Name, State). - -% Register and initialize a new state -init_state(Name) :- - State = 'State'(_,_), - asserta(is_registered_state(Name)), - nb_setval(Name, State). - -% Change a value in a state -'change-state!'(Depth,Self,StateNameOrInstance, UpdatedValue, Out) :- - fetch_or_create_state(StateNameOrInstance, State), - arg(2, State, Type), - ( (check_type,\+ get_type(Depth,Self,UpdatedValue,Type)) - -> (Out = ['Error', UpdatedValue, 'BadType']) - ; (nb_setarg(1, State, UpdatedValue), Out = State) ). - -% Fetch all values from a state -'get-state'(StateNameOrInstance, Values) :- - fetch_or_create_state(StateNameOrInstance, State), - arg(1, State, Values). - -'new-state'(Depth,Self,Init,'State'(Init, Type)):- check_type->get_type(Depth,Self,Init,Type);true. - -'new-state'(Init,'State'(Init, Type)):- check_type->get_type(10,'&self',Init,Type);true. - -fetch_or_create_state(Name):- fetch_or_create_state(Name,_). -% Fetch an existing state or create a new one - -fetch_or_create_state(State, State) :- is_valid_nb_state(State),!. -fetch_or_create_state(NameOrInstance, State) :- - ( atom(NameOrInstance) - -> (is_registered_state(NameOrInstance) - -> nb_current(NameOrInstance, State) - ; init_state(NameOrInstance), - nb_current(NameOrInstance, State)) - ; is_valid_nb_state(NameOrInstance) - -> State = NameOrInstance - ; writeln('Error: Invalid input.') - ), - is_valid_nb_state(State). - - -eval_args30(Depth,Self,['get-type',Val],Type):- %if_repl(trace), - !, get_type(Depth,Self,Val,Type),Type\==[],!. %, ground(Type), Type\==Val,!. - - -mnotrace(G):- once(G). - - - -is_decl_type(ST):- metta_type(_,_,Type),sub_term(T,Type),T=@=ST, \+ nontype(ST). -is_type(Type):- nontype(Type),!,fail. -is_type(Type):- is_decl_type(Type). -is_type(Type):- atom(Type). - -nontype(Type):- var(Type),!. -nontype('->'). -nontype(N):- number(N). - -needs_eval(EvalMe):- is_list(EvalMe),!. - -get_type(_Dpth,_Slf,Var,'%Undefined%'):- var(Var),!. -get_type(_Dpth,_Slf,Val,'Number'):- number(Val),!. -get_type(Depth,Self,Expr,['StateMonad',Type]):- is_valid_nb_state(Expr),'get-state'(Expr,Val),!, - get_type(Depth,Self,Val,Type). - - -get_type(Depth,_Slf,Type,Type):- Depth<1,!. -get_type(Depth,Self,EvalMe,Type):- needs_eval(EvalMe),eval_args(Depth,Self,EvalMe,Val), \+ needs_eval(Val),!, - get_type(Depth,Self,Val,Type). - -get_type(_Dpth,Self,Fn,Type):- metta_type(Self,FnM,Type),FnM=@=Fn, nonvar(Type). -%get_type(_Dpth,Self,Fn,Type):- symbol(Fn),metta_type(Self,Fn,Type),!. -%reverse -%get_type(_Dpth,Self,List,Type):- is_list(List),metta_type(Self,Type,['->'|List]). -get_type(_Dpth,Self,[Fn|_],Type):- symbol(Fn),metta_type(Self,Fn,List),last_element(List,Type), nonvar(Type), - is_type(Type). -get_type(_Dpth,Self,List,Type):- is_list(List),metta_type(Self,List,LType),last_element(LType,Type), nonvar(Type), - is_type(Type). - -get_type(Depth,Self,List,Types):- List\==[], is_list(List),Depth2 is Depth-1,maplist(get_type(Depth2,Self),List,Types). -%get_type(Depth,Self,Fn,Type):- nonvar(Fn),metta_type(Self,Fn,Type2),Depth2 is Depth-1,get_type(Depth2,Self,Type2,Type). -%get_type(Depth,Self,Fn,Type):- Depth>0,nonvar(Fn),metta_type(Self,Type,Fn),!. %,!,last_element(List,Type). - -get_type(Depth,Self,Expr,Type):-Depth2 is Depth-1, eval_args30(Depth2,Self,Expr,Val),Expr\=@=Val,get_type(Depth2,Self,Val,Type). - -get_type(_Dpth,_Slf,Val,'String'):- string(Val),!. -get_type(_Dpth,_Slf,Val,Type):- is_decl_type(Val),Type=Val. -get_type(_Dpth,_Slf,Val,'Bool'):- (Val=='False';Val=='True'),!. -get_type(_Dpth,_Slf,Val,'Symbol'):- symbol(Val). -%get_type(Depth,Self,[T|List],['List',Type]):- Depth2 is Depth-1, is_list(List),get_type(Depth2,Self,T,Type),!, -% forall((member(Ele,List),nonvar(Ele)),get_type(Depth2,Self,Ele,Type)),!. -%get_type(Depth,_Slf,Cmpd,Type):- compound(Cmpd), functor(Cmpd,Type,1),!. -get_type(_Dpth,_Slf,Cmpd,Type):- \+ ground(Cmpd),!,Type=[]. -get_type(_Dpth,_Slf,_,'%Undefined%'):- fail. -eval_args30(Depth,Self,['length',L],Res):- !, eval_args(Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). -eval_args30(Depth,Self,['CountElement',L],Res):- !, eval_args(Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). - - -is_feo_f('Cons'). - -is_seo_f('{}'). -is_seo_f('[]'). -is_seo_f('StateMonad'). -is_seo_f('State'). -is_seo_f('Event'). -is_seo_f(N):- number(N),!. - - - -/* -eval_args30(Depth,Self,[F,A|Args],Res):- - \+ self_eval(A), - eval_args(Depth,Self,A,AA),AA\==A, - eval_args(Depth,Self,[F,AA|Args],Res). - - -eval_args30(Depth,Self,[F,A1|AArgs],Res):- fail, member(F,['+']), - cwdl(40,(( - append(L,[A|R],AArgs), - \+ self_eval(A), - eval_args(Depth,Self,A,AA),AA\==A,!, - append(L,[AA|R],NewArgs), eval_args(Depth,Self,[F,A1|NewArgs],Res)))). -*/ - -/* %% - -% !(assertEqualToResult ((inc) 2) (3)) -eval_args30(Depth,Self,[F|Args],Res):- is_list(F), - metta_atom_iter(Depth,Self,['=',F,R]), eval_args(Depth,Self,[R|Args],Res). - -eval_args30(Depth,Self,[F|Args],Res):- is_list(F), Args\==[], - append(F,Args,FArgs),!,eval_args(Depth,Self,FArgs,Res). -*/ -eval_args30(_Dpth,Self,['import!',Other,File],RetVal):- into_space(Self,Other,Space),!, include_metta(Space,File),!,return_empty(Space,RetVal). %RetVal=[]. -eval_args30(Depth,Self,['bind!',Other,Expr],RetVal):- - into_name(Self,Other,Name),!,eval_args(Depth,Self,Expr,Value),nb_setval(Name,Value), return_empty(Value,RetVal). -eval_args30(Depth,Self,['pragma!',Other,Expr],RetVal):- - into_name(Self,Other,Name),!,nd_ignore((eval_args(Depth,Self,Expr,Value),set_option_value(Name,Value))), return_empty(Value,RetVal). -eval_args30(_Dpth,Self,['transfer!',File],RetVal):- !, include_metta(Self,File), return_empty(Self,RetVal). - -nd_ignore(Goal):- call(Goal)*->true;true. - -eval_args30(Depth,Self,['nop',Expr],Empty):- !, eval_args(Depth,Self,Expr,_), return_empty([],Empty). -eval_args30(Depth,Self,['do',Expr],Empty):- !, eval_args(Depth,Self,Expr,_), return_empty([],Empty). - -is_True(T):- T\=='False',T\=='F',T\==[]. - -is_and(S):- \+ atom(S),!,fail. -is_and('#COMMA'). is_and(','). is_and('and'). is_and('And'). - -eval_args30(_Dpth,_Slf,[And],'True'):- is_and(And),!. -eval_args30(Depth,Self,['and',X,Y],TF):- !, as_tf((eval_args(Depth,Self,X,'True'),eval_args(Depth,Self,Y,'True')),TF). -eval_args30(Depth,Self,[And,X|Y],TF):- is_and(And),!,eval_args(Depth,Self,X,TF1), - is_True(TF1),eval_args30(Depth,Self,[And|Y],TF). -%eval_args2(Depth,Self,[H|T],_):- \+ is_list(T),!,fail. -eval_args30(Depth,Self,['or',X,Y],TF):- !, as_tf((eval_args(Depth,Self,X,'True');eval_args(Depth,Self,Y,'True')),TF). - - - -eval_args30(_Dpth,Self,['add-atom',Other,PredDecl],TF):- !, into_space(Self,Other,Space), as_tf('add-atom'(Space,PredDecl),TF). -eval_args30(_Dpth,Self,['remove-atom',Other,PredDecl],TF):- !, into_space(Self,Other,Space), as_tf(do_metta(Space,unload,PredDecl),TF). -eval_args30(_Dpth,Self,['atom-count',Other],Count):- !, into_space(Self,Other,Space), findall(_,metta_defn(Other,_,_),L1),length(L1,C1),findall(_,metta_atom(Space,_),L2),length(L2,C2),Count is C1+C2. -eval_args30(_Dpth,Self,['atom-replace',Other,Rem,Add],TF):- !, into_space(Self,Other,Space), copy_term(Rem,RCopy), - as_tf((metta_atom_iter_ref(Space,RCopy,Ref), RCopy=@=Rem,erase(Ref), do_metta(Other,load,Add)),TF). - - -eval_args30(Depth,Self,['+',N1,N2],N):- number(N1),!, - eval_args(Depth,Self,N2,N2Res), catch(N is N1+N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail)). -eval_args30(Depth,Self,['-',N1,N2],N):- number(N1),!, - eval_args(Depth,Self,N2,N2Res), catch(N is N1-N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail)). - -eval_args30(Depth,Self,[V|VI],[V|VO]):- nonvar(V),is_metta_data_functor(V),is_list(VI),!,maplist(eval_args(Depth,Self),VI,VO). - -eval_args30(Depth,Self,X,Y):- - (eval_args2(Depth,Self,X,Y)*->true; - (eval_args2_failed(Depth,Self,X,Y)*->true;X=Y)). - - -eval_args2_failed(_Dpth,_Slf,T,TT):- T==[],!,TT=[]. -eval_args2_failed(_Dpth,_Slf,T,TT):- var(T),!,TT=T. -eval_args2_failed(_Dpth,_Slf,[F|LESS],Res):- once(eval_selfless([F|LESS],Res)),mnotrace([F|LESS]\==Res),!. -%eval_args2_failed(Depth,Self,[V|Nil],[O]):- Nil==[], once(eval_args(Depth,Self,V,O)),V\=@=O,!. -eval_args2_failed(Depth,Self,[H|T],[HH|TT]):- !, - eval_args(Depth,Self,H,HH), - eval_args2_failed(Depth,Self,T,TT). - -eval_args2_failed(Depth,Self,T,TT):- eval_args(Depth,Self,T,TT). - - %eval_args(Depth,Self,X,Y):- eval_args30(Depth,Self,X,Y)*->true;Y=[]. - -%eval_args30(Depth,_,_,_):- Depth<1,!,fail. -%eval_args30(Depth,_,X,Y):- Depth<3, !, ground(X), (Y=X). -%eval_args30(_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. - -% Kills zero arity functions eval_args30(Depth,Self,[X|Nil],[Y]):- Nil ==[],!,eval_args(Depth,Self,X,Y). - - -/* -into_values(List,Many):- List==[],!,Many=[]. -into_values([X|List],Many):- List==[],is_list(X),!,Many=X. -into_values(Many,Many). -eval_args2(_Dpth,_Slf,Name,Value):- atom(Name), nb_current(Name,Value),!. -*/ -% Macro Functions -%eval_args30(Depth,_,_,_):- Depth<1,!,fail. -eval_args2(Depth,_,X,Y):- Depth<3, !, fail, ground(X), (Y=X). -eval_args2(Depth,Self,[F|PredDecl],Res):- - Depth>6, fail, - mnotrace((sub_sterm1(SSub,PredDecl), ground(SSub),SSub=[_|Sub], is_list(Sub), maplist(atomic,SSub))), - eval_args(Depth,Self,SSub,Repl), - mnotrace((SSub\=Repl, subst(PredDecl,SSub,Repl,Temp))), - eval_args(Depth,Self,[F|Temp],Res). - - - -% user defined function -eval_args2(Depth,Self,[H|PredDecl],Res):- mnotrace(is_user_defined_head(Self,H)),!, - eval_args60(Depth,Self,[H|PredDecl],Res). - -% function inherited by system -eval_args2(Depth,Self,PredDecl,Res):- eval_args80(Depth,Self,PredDecl,Res). - - -last_element(T,E):- \+ compound(T),!,E=T. -last_element(T,E):- is_list(T),last(T,L),last_element(L,E),!. -last_element(T,E):- compound_name_arguments(T,_,List),last_element(List,E),!. - - - - -catch_warn(G):- notrace(catch(G,E,(wdmsg(catch_warn(G)-->E),fail))). -catch_nowarn(G):- notrace(catch(G,error(_,_),fail)). - -as_tf(G,TF):- catch_nowarn((call(G)*->TF='True';TF='False')). -eval_selfless(['==',X,Y],TF):- as_tf(X=:=Y,TF),!. -eval_selfless(['==',X,Y],TF):- as_tf(X=@=Y,TF),!. -eval_selfless(['=',X,Y],TF):-!,as_tf(X=Y,TF). -eval_selfless(['>',X,Y],TF):-!,as_tf(X>Y,TF). -eval_selfless(['<',X,Y],TF):-!,as_tf(X',X,Y],TF):-!,as_tf(X>=Y,TF). -eval_selfless(['<=',X,Y],TF):-!,as_tf(X= Bool Atom Atom)) -(= (ift True $then) $then) - -; For anything that is green, assert it is Green in &kb22 -!(ift (green $x) - (add-atom &kb22 (Green $x))) - -; Retrieve the inferred Green things: Fritz and Sam. -!(assertEqualToResult - (match &kb22 (Green $x) $x) - (Fritz Sam)) -*/ -:- discontiguous eval_args6/4. -%eval_args2(Depth,Self,PredDecl,Res):- eval_args6(Depth,Self,PredDecl,Res). - -%eval_args2(_Dpth,_Slf,L1,Res):- is_list(L1),maplist(self_eval,L1),!,Res=L1. -%eval_args2(_Depth,_Self,X,X). - - -is_user_defined_head(Other,H):- mnotrace(is_user_defined_head0(Other,H)). -is_user_defined_head0(Other,[H|_]):- !, nonvar(H),!, is_user_defined_head_f(Other,H). -is_user_defined_head0(Other,H):- callable(H),!,functor(H,F,_), is_user_defined_head_f(Other,F). -is_user_defined_head0(Other,H):- is_user_defined_head_f(Other,H). - -is_user_defined_head_f(Other,H):- is_user_defined_head_f1(Other,H). -is_user_defined_head_f(Other,H):- is_user_defined_head_f1(Other,[H|_]). - -%is_user_defined_head_f1(Other,H):- metta_type(Other,H,_). -is_user_defined_head_f1(Other,H):- metta_atom(Other,[H|_]). -is_user_defined_head_f1(Other,H):- metta_defn(Other,[H|_],_). -%is_user_defined_head_f(_,H):- is_metta_builtin(H). - - -is_special_op(F):- \+ atom(F), \+ var(F), !, fail. -is_special_op('case'). -is_special_op(':'). -is_special_op('='). -is_special_op('->'). -is_special_op('let'). -is_special_op('let*'). -is_special_op('if'). -is_special_op('rtrace'). -is_special_op('or'). -is_special_op('and'). -is_special_op('not'). -is_special_op('match'). -is_special_op('call'). -is_special_op('let'). -is_special_op('let*'). -is_special_op('nop'). -is_special_op('assertEqual'). -is_special_op('assertEqualToResult'). - -is_metta_builtin(Special):- is_special_op(Special). -is_metta_builtin('=='). -is_metta_builtin(F):- once(atom(F);var(F)), current_op(_,yfx,F). -is_metta_builtin('println!'). -is_metta_builtin('transfer!'). -is_metta_builtin('collapse'). -is_metta_builtin('superpose'). -is_metta_builtin('+'). -is_metta_builtin('-'). -is_metta_builtin('*'). -is_metta_builtin('/'). -is_metta_builtin('%'). -is_metta_builtin('=='). -is_metta_builtin('<'). -is_metta_builtin('>'). -is_metta_builtin('all'). -is_metta_builtin('import!'). -is_metta_builtin('pragma!'). - - - -eval_args60(Depth,Self,H,B):- (eval_args64(Depth,Self,H,B)*->true;eval_args67(Depth,Self,H,B)). - -eval_args64(_Dpth,Self,H,B):- (metta_defn(Self,H,B);(metta_atom(Self,H),B='True')). - -% Has argument that is headed by the same function -eval_args67(Depth,Self,[H1|Args],Res):- - mnotrace((append(Left,[[H2|H2Args]|Rest],Args), H2==H1)),!, - eval_args(Depth,Self,[H2|H2Args],ArgRes), - mnotrace((ArgRes\==[H2|H2Args], append(Left,[ArgRes|Rest],NewArgs))), - eval_args60(Depth,Self,[H1|NewArgs],Res). - -eval_args67(Depth,Self,[[H|Start]|T1],Y):- - mnotrace((is_user_defined_head_f(Self,H),is_list(Start))), - metta_defn(Self,[H|Start],Left), - eval_args(Depth,Self,[Left|T1],Y). - -% Has subterm to eval -eval_args67(Depth,Self,[F|PredDecl],Res):- - Depth>1, - quietly(sub_sterm1(SSub,PredDecl)), - mnotrace((ground(SSub),SSub=[_|Sub], is_list(Sub),maplist(atomic,SSub))), - eval_args(Depth,Self,SSub,Repl), - mnotrace((SSub\=Repl,subst(PredDecl,SSub,Repl,Temp))), - eval_args60(Depth,Self,[F|Temp],Res). - -%eval_args67(Depth,Self,X,Y):- (eval_args68(Depth,Self,X,Y)*->true;metta_atom_iter(Depth,Self,[=,X,Y])). - -eval_args67(Depth,Self,PredDecl,Res):- fail, - ((term_variables(PredDecl,Vars), - (metta_atom(Self,PredDecl) *-> (Vars ==[]->Res='True';Vars=Res); - (eval_args(Depth,Self,PredDecl,Res),ignore(Vars ==[]->Res='True';Vars=Res))))), - PredDecl\=@=Res. - -eval_args68(_Dpth,Self,[H|_],_):- mnotrace( \+ is_user_defined_head_f(Self,H) ), !,fail. -eval_args68(_Dpth,Self,[H|T1],Y):- metta_defn(Self,[H|T1],Y). -eval_args68(_Dpth,Self,[H|T1],'True'):- metta_atom(Self,[H|T1]). -eval_args68(_Dpth,Self,CALL,Y):- fail,append(Left,[Y],CALL),metta_defn(Self,Left,Y). - - -%eval_args6(Depth,Self,['ift',CR,Then],RO):- fail, !, %fail, % trace, -% metta_defn(Self,['ift',R,Then],Become),eval_args(Depth,Self,CR,R),eval_args(Depth,Self,Then,_True),eval_args(Depth,Self,Become,RO). - -%metta_atom_iter(_Dpth,Other,[Equal,H,B]):- '=' == Equal,!, -% (metta_defn(Other,H,B)*->true;(metta_atom(Other,H),B='True')). -metta_atom_iter(_Dpth,Other,[Equal,H,B]):- '=' == Equal,!, - (metta_defn(Other,H,B);((B='True';B=H),metta_atom(Other,H))). - -metta_atom_iter(Depth,_,_):- Depth<3,!,fail. -metta_atom_iter(_Dpth,_Slf,[]):-!. -metta_atom_iter(_Dpth,Other,H):- metta_atom(Other,H). -metta_atom_iter(Depth,Other,H):- D2 is Depth -1, metta_defn(Other,H,B),metta_atom_iter(D2,Other,B). -metta_atom_iter(Depth,Other,H):- nonvar(H),D2 is Depth -1, eval_args(D2,Other,H,B),B\==[],!. -/* -metta_atom_iter(Depth,Other,H):- D2 is Depth -1, metta_defn(Other,H,B),metta_atom_iter(D2,Other,B). -metta_atom_iter(_Dpth,_Slf,[And]):- is_and(And),!. -metta_atom_iter(Depth,Self,[And,X|Y]):- is_and(And),!,D2 is Depth -1, -metta_atom_iter(D2,Self,X),metta_atom_iter(D2,Self,[And|Y]).*/ -/* -metta_atom_iter2(_,Self,[=,X,Y]):- metta_defn(Self,X,Y). -metta_atom_iter2(_Dpth,Other,[Equal,H,B]):- '=' == Equal,!, metta_defn(Other,H,B). -metta_atom_iter2(_Dpth,Self,X,Y):- metta_defn(Self,X,Y). %, Y\=='True'. -metta_atom_iter2(_Dpth,Self,X,Y):- metta_atom(Self,[=,X,Y]). %, Y\=='True'. - -*/ -metta_atom_iter_ref(Other,['=',H,B],Ref):-clause(metta_defn(Other,H,B),true,Ref). -metta_atom_iter_ref(Other,H,Ref):-clause(metta_atom(Other,H),true,Ref). - -%not_compound(Term):- \+ is_list(Term),!. -%eval_args2(Depth,Self,Term,Res):- maplist(not_compound,Term),!,eval_args645(Depth,Self,Term,Res). - - -% function inherited by system -eval_args80(Depth,Self,[F|X],FY):- is_function(F), \+ is_special_op(F), is_list(X), - maplist(eval_args(Depth,Self),X,Y),!,eval_args5(Depth,Self,[F|Y],FY). -eval_args80(Depth,Self,FX,FY):- eval_args5(Depth,Self,FX,FY). - -eval_args5(_Dpth,_Slf,[F|LESS],Res):- once(eval_selfless([F|LESS],Res)),mnotrace(([F|LESS]\==Res)),!. -eval_args5(Depth,Self,[AE|More],TF):- length(More,Len), - (is_syspred(AE,Len,Pred),catch_warn(as_tf(apply(Pred,More),TF)))*->true;eval_args6(Depth,Self,[AE|More],TF). -eval_args6(_Dpth,_Slf,[AE|More],TF):- length([AE|More],Len), is_syspred(AE,Len,Pred),append(More,[TF],Args),!,catch_warn(apply(Pred,Args)). - -%eval_args80(Depth,Self,[X1|[F2|X2]],[Y1|Y2]):- is_function(F2),!,eval_args(Depth,Self,[F2|X2],Y2),eval_args(Depth,Self,X1,Y1). - - -cwdl(DL,Goal):- call_with_depth_limit(Goal,DL,R), (R==depth_limit_exceeded->(!,fail);true). -bagof_eval(Depth,Self,X,L):- !,bagof_or_nil(E,eval_args(Depth,Self,X,E),L). -setof_eval(Depth,Self,X,S):- !,bagof_or_nil(E,eval_args(Depth,Self,X,E),L),sort(L,S). -%setof_eval(Depth,Self,X,S):- setof(E,eval_args(Depth,Self,X,E),S)*->true;S=[]. -bagof_or_nil(T,G,L):- bagof(T,G,L)*->true;L=[]. diff --git a/.Attic/metta_lang/metta_eval.old b/.Attic/metta_lang/metta_eval.old deleted file mode 100755 index c5ee60ad183..00000000000 --- a/.Attic/metta_lang/metta_eval.old +++ /dev/null @@ -1,1633 +0,0 @@ -% -% post match modew -%:- style_check(-singleton). -:- multifile(nop/1). -:- meta_predicate(nop(0)). -:- multifile(fake_notrace/1). -:- meta_predicate(fake_notrace(0)). -:- meta_predicate(color_g_mesg(+,0)). -:- multifile(color_g_mesg/2). - -self_eval0(X):- \+ callable(X),!. -self_eval0(X):- is_valid_nb_state(X),!. -%self_eval0(X):- string(X),!. -%self_eval0(X):- number(X),!. -%self_eval0([]). -self_eval0(X):- is_metta_declaration(X),!. -self_eval0([F|X]):- !, is_list(X),length(X,Len),!,nonvar(F), is_self_eval_l_fa(F,Len),!. -self_eval0(X):- typed_list(X,_,_),!. -%self_eval0(X):- compound(X),!. -%self_eval0(X):- is_ref(X),!,fail. -self_eval0('True'). self_eval0('False'). % self_eval0('F'). -self_eval0('Empty'). -self_eval0(X):- atom(X),!, \+ nb_current(X,_),!. - -coerce(Type,Value,Result):- nonvar(Value),Value=[Echo|EValue], Echo == echo, EValue = [RValue],!,coerce(Type,RValue,Result). -coerce(Type,Value,Result):- var(Type), !, Value=Result, freeze(Type,coerce(Type,Value,Result)). -coerce('Atom',Value,Result):- !, Value=Result. -coerce('Bool',Value,Result):- var(Value), !, Value=Result, freeze(Value,coerce('Bool',Value,Result)). -coerce('Bool',Value,Result):- is_list(Value),!,as_tf(call_true(Value),Result), -set_list_value(Value,Result). - -set_list_value(Value,Result):- nb_setarg(1,Value,echo),nb_setarg(1,Value,[Result]). - -is_self_eval_l_fa('S',1). -% eval_20(Eq,RetType,Depth,Self,['quote',Eval],RetVal):- !, Eval = RetVal, check_returnval(Eq,RetType,RetVal). -is_self_eval_l_fa('quote',_). -is_self_eval_l_fa('{...}',_). -is_self_eval_l_fa('[...]',_). - -self_eval(X):- notrace(self_eval0(X)). - -:- set_prolog_flag(access_level,system). -hyde(F/A):- functor(P,F,A), redefine_system_predicate(P),'$hide'(F/A), '$iso'(F/A). -:- 'hyde'(option_else/2). -:- 'hyde'(atom/1). -:- 'hyde'(quietly/1). -%:- 'hyde'(fake_notrace/1). -:- 'hyde'(var/1). -:- 'hyde'(is_list/1). -:- 'hyde'(copy_term/2). -:- 'hyde'(nonvar/1). -:- 'hyde'(quietly/1). -%:- 'hyde'(option_value/2). - - -is_metta_declaration([F|_]):- F == '->',!. -is_metta_declaration([F,H,_|T]):- T ==[], is_metta_declaration_f(F,H). - -is_metta_declaration_f(F,H):- F == ':<', !, nonvar(H). -is_metta_declaration_f(F,H):- F == ':>', !, nonvar(H). -is_metta_declaration_f(F,H):- F == '=', !, is_list(H), \+ (current_self(Space), is_user_defined_head_f(Space,F)). - -% is_metta_declaration([F|T]):- is_list(T), is_user_defined_head([F]),!. - -:- nb_setval(self_space, '&self'). -evals_to(XX,Y):- Y=@=XX,!. -evals_to(XX,Y):- Y=='True',!, is_True(XX),!. - -%current_self(Space):- nb_current(self_space,Space). - -do_expander('=',_,X,X):-!. -do_expander(':',_,X,Y):- !, get_type(X,Y)*->X=Y. - -'get_type'(Arg,Type):- 'get-type'(Arg,Type). - - -eval_true(X):- \+ iz_conz(X), callable(X), call(X). -eval_true(X):- eval_args(X,Y), once(var(Y) ; \+ is_False(Y)). - -eval_args(X,Y):- current_self(Self), eval_args(100,Self,X,Y). -eval_args(Depth,Self,X,Y):- eval_args('=',_,Depth,Self,X,Y). -eval_args(Eq,RetType,Depth,Self,X,Y):- eval(Eq,RetType,Depth,Self,X,Y). - -/* -eval_args(Eq,RetTyp e,Depth,Self,X,Y):- - locally(set_prolog_flag(gc,true), - rtrace_on_existence_error( - eval(Eq,RetType,Depth,Self,X,Y))). -*/ - - -%eval(Eq,RetType,Depth,_Self,X,_Y):- forall(between(6,Depth,_),write(' ')),writeqln(eval(Eq,RetType,X)),fail. -eval(Depth,Self,X,Y):- eval('=',_RetType,Depth,Self,X,Y). - -eval(_Eq,_RetType,_Dpth,_Slf,X,Y):- var(X),nonvar(Y),!,X=Y. -eval(_Eq,_RetType,_Dpth,_Slf,X,Y):- notrace(self_eval(X)),!,Y=X. -eval(Eq,RetType,Depth,Self,X,Y):- notrace(nonvar(Y)), var(RetType), - get_type(Depth,Self,Y,RetType), !, - eval(Eq,RetType,Depth,Self,X,Y). -eval(Eq,RetType,Depth,Self,X,Y):- notrace(nonvar(Y)),!, - eval(Eq,RetType,Depth,Self,X,XX),evals_to(XX,Y). - - -eval(Eq,RetType,_Dpth,_Slf,[X|T],Y):- T==[], number(X),!, do_expander(Eq,RetType,X,YY),Y=[YY]. - -/* -eval(Eq,RetType,Depth,Self,[F|X],Y):- - (F=='superpose' ; ( option_value(no_repeats,false))), - fake_notrace((D1 is Depth-1)),!, - eval(Eq,RetType,D1,Self,[F|X],Y). -*/ - -eval(Eq,RetType,Depth,Self,X,Y):- atom(Eq), ( Eq \== ('='), Eq \== ('match')) ,!, - call(call,Eq,'=',RetType,Depth,Self,X,Y). - -eval(_Eq,_RetType,_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. -eval(Eq,RetType,Depth,Self,X,Y):- eval_00(Eq,RetType,Depth,Self,X,Y). - -eval_00(_Eq,_RetType,Depth,_Slf,X,Y):- Depth<1,!,X=Y, (\+ trace_on_overflow-> true; flag(eval_num,_,0), - debug(metta(eval))). -eval_00(Eq,RetType,Depth,Self,X,YO):- - notrace((Depth2 is Depth-1, - copy_term(X, XX))), - trace_eval(eval_20(Eq,RetType),eval_20,Depth2,Self,X,M), - ((M=@=XX ; self_eval(M))-> Y=M - ;eval_00(Eq,RetType,Depth2,Self,M,Y)), - once(if_or_else((subst_args(Eq,RetType,Depth2,Self,Y,YO)), - if_or_else(finish_eval(Depth2,Self,Y,YO), - Y=YO))). - - -allow_repeats_eval_(_):- !. -allow_repeats_eval_(_):- option_value(no_repeats,false),!. -allow_repeats_eval_(X):- \+ is_list(X),!,fail. -allow_repeats_eval_([F|_]):- atom(F),allow_repeats_eval_f(F). -allow_repeats_eval_f('superpose'). -allow_repeats_eval_f('collapse'). - -debugging_metta(G):- fake_notrace((is_debugging((eval))->ignore(G);true)). - - -:- nodebug(metta(eval)). - -w_indent(Depth,Goal):- - \+ \+ fake_notrace(ignore((( - 'format'('~N'), - setup_call_cleanup(forall(between(Depth,101,_),write(' ')),Goal, 'format'('~N')))))). -indentq(Depth,Term):- - \+ \+ fake_notrace(ignore((( - 'format'('~N'), - setup_call_cleanup(forall(between(Depth,101,_),write(' ')),'format'('~q',[Term]), - 'format'('~N')))))). - - -indentq_d(Depth,Prefix4, Message):- - fake_notrace((flag(eval_num,EX0,EX0), - EX is EX0 mod 500, - DR is 99 - (Depth mod 100), - indentq(DR,EX,Prefix4,Message))). - -indentq(DR,EX,AR,retval(Term)):-nonvar(Term),!,indentq(DR,EX,AR,Term). -indentq(DR,EX,AR,Term):- - \+ \+ - color_g_mesg('#2f2f2f', - fake_notrace(ignore((( 'format'('~N;'), - 'format'('~` t~d~5|:', [EX]), - 'format'('~` t~d~8|', [DR]), - forall(between(1,DR,_),write(' |')),write('-'),write(AR),with_indents(false,write_src(Term)), - 'format'('~N')))))). - - -with_debug(Flag,Goal):- is_debugging(Flag),!, call(Goal). -with_debug(Flag,Goal):- flag(eval_num,_,0), - setup_call_cleanup(set_debug(Flag,true),call(Goal),set_debug(Flag,false)). - -flag_to_var(Flag,Var):- atom(Flag), \+ atom_concat('trace-on-',_,Flag),!,atom_concat('trace-on-',Flag,Var). -flag_to_var(metta(Flag),Var):- !, nonvar(Flag), flag_to_var(Flag,Var). -flag_to_var(Flag,Var):- Flag=Var. - -set_debug(Flag,Val):- \+ atom(Flag), flag_to_var(Flag,Var), atom(Var),!,set_debug(Var,Val). -set_debug(Flag,true):- !, debug(metta(Flag)),flag_to_var(Flag,Var),set_option_value(Var,true). -set_debug(Flag,false):- nodebug(metta(Flag)),flag_to_var(Flag,Var),set_option_value(Var,false). -if_trace((Flag;true),Goal):- !, real_notrace(( catch_err(ignore((Goal)),E,fbug(E-->if_trace((Flag;true),Goal))))). -if_trace(Flag,Goal):- real_notrace((catch_err(ignore((is_debugging(Flag),Goal)),E,fbug(E-->if_trace(Flag,Goal))))). - - -%maybe_efbug(SS,G):- efbug(SS,G)*-> if_trace(eval,fbug(SS=G)) ; fail. -maybe_efbug(_,G):- call(G). -%efbug(P1,G):- call(P1,G). -efbug(_,G):- call(G). - - - -is_debugging(Flag):- var(Flag),!,fail. -is_debugging((A;B)):- !, (is_debugging(A) ; is_debugging(B) ). -is_debugging((A,B)):- !, (is_debugging(A) , is_debugging(B) ). -is_debugging(not(Flag)):- !, \+ is_debugging(Flag). -is_debugging(Flag):- Flag== false,!,fail. -is_debugging(Flag):- Flag== true,!. -is_debugging(Flag):- debugging(metta(Flag),TF),!,TF==true. -is_debugging(Flag):- debugging(Flag,TF),!,TF==true. -is_debugging(Flag):- flag_to_var(Flag,Var), - (option_value(Var,true)->true;(Flag\==Var -> is_debugging(Var))). - -:- nodebug(metta(overflow)). - - -trace_eval(P4,TN,D1,Self,X,Y):- \+ is_debugging(TN), \+ is_debugging(eval),!, call(P4,D1,Self,X,Y). -trace_eval(P4,TN,D1,Self,X,Y):- - must_det_ll(( - notrace(( - flag(eval_num,EX0,EX0+1), - EX is EX0 mod 500, - DR is 99 - (D1 mod 100), - PrintRet = _, - option_else('trace-length',Max,500), - option_else('trace-depth',DMax,30))), - quietly((if_t((nop(stop_rtrace),EX>Max), (set_debug(eval,false),MaxP1 is Max+1, - %set_debug(overflow,false), - nop('format'('; Switched off tracing. For a longer trace: !(pragma! trace-length ~w)',[MaxP1])), - nop((start_rtrace,rtrace)))))), - nop(notrace(no_repeats_var(YY))))), - - if_t(DR',[TN,X])))), - - Ret=retval(fail),!, - - (Display= ((Ret\=@=retval(fail),nonvar(Y)) -> indentq(DR,EX,'<--',[TN,Y]); indentq(DR,EX,'<--',[TN,Ret]))), - - call_cleanup(( - (call(P4,D1,Self,X,Y)*->true; - (fail,trace,(call(P4,D1,Self,X,Y)))), - ignore((fake_notrace(( \+ (Y\=YY), nb_setarg(1,Ret,Y)))))), - % cleanup - (PrintRet==1 -> call(Display) ; - (fake_notrace(ignore((( % Y\=@=X, - if_t(DRtrue;(fail,trace,(call(P4,D1,Self,X,Y)),fail)). - - - -% eval_15(Eq,RetType,Depth,Self,X,Y):- !, eval_20(Eq,RetType,Depth,Self,X,Y). - -eval_15(Eq,RetType,Depth,Self,X,Y):- ((eval_20(Eq,RetType,Depth,Self,X,Y), - if_t(var(Y),fbug((eval_20(Eq,RetType,Depth,Self,X,Y),var(Y)))), - nonvar(Y))*->true;(eval_failed(Depth,Self,X,Y),fail)). - - - - - - - - -:- discontiguous eval_20/6. -:- discontiguous eval_40/6. -%:- discontiguous eval_30fz/5. -%:- discontiguous eval_31/5. -%:- discontiguous eval_defn/5. - -eval_20(Eq,RetType,_Dpth,_Slf,Name,Y):- - atom(Name), !, - (nb_current(Name,X)->do_expander(Eq,RetType,X,Y); - Y = Name). - - -eval_20(Eq,RetType,_Dpth,_Slf,X,Y):- self_eval(X),!,do_expander(Eq,RetType,X,Y). - -% ================================================================= -% ================================================================= -% ================================================================= -% VAR HEADS/ NON-LISTS -% ================================================================= -% ================================================================= -% ================================================================= - -eval_20(Eq,RetType,_Dpth,_Slf,[X|T],Y):- T==[], \+ callable(X),!, do_expander(Eq,RetType,X,YY),Y=[YY]. -%eval_20(Eq,RetType,_Dpth,Self,[X|T],Y):- T==[], atom(X), -% \+ is_user_defined_head_f(Self,X), -% do_expander(Eq,RetType,X,YY),!,Y=[YY]. - -eval_20(Eq,RetType,Depth,Self,X,Y):- atom(Eq), ( Eq \== ('=')) ,!, - call(Eq,'=',RetType,Depth,Self,X,Y). - - -eval_20(Eq,RetType,Depth,Self,[V|VI],VVO):- \+ is_list(VI),!, - eval(Eq,RetType,Depth,Self,VI,VM), - ( VM\==VI -> eval(Eq,RetType,Depth,Self,[V|VM],VVO) ; - (eval(Eq,RetType,Depth,Self,V,VV), (V\==VV -> eval(Eq,RetType,Depth,Self,[VV|VI],VVO) ; VVO = [V|VI]))). - -eval_20(Eq,RetType,_Dpth,_Slf,X,Y):- \+ is_list(X),!,do_expander(Eq,RetType,X,Y). - -eval_20(Eq,_RetType,Depth,Self,[V|VI],[V|VO]):- var(V),is_list(VI),!,maplist(eval(Eq,_ArgRetType,Depth,Self),VI,VO). - -eval_20(_,_,_,_,['echo',Value],Value):- !. -eval_20(=,Type,_,_,['coerce',Type,Value],Result):- !, coerce(Type,Value,Result). - -% ================================================================= -% ================================================================= -% ================================================================= -% TRACE/PRINT -% ================================================================= -% ================================================================= -% ================================================================= - -eval_20(Eq,RetType,_Dpth,_Slf,['repl!'],Y):- !, repl,check_returnval(Eq,RetType,Y). -%eval_20(Eq,RetType,Depth,Self,['enforce',Cond],Res):- !, enforce_true(Eq,RetType,Depth,Self,Cond,Res). -eval_20(Eq,RetType,Depth,Self,['!',Cond],Res):- !, call(eval(Eq,RetType,Depth,Self,Cond,Res)). -eval_20(Eq,RetType,Depth,Self,['rtrace!',Cond],Res):- !, rtrace(eval(Eq,RetType,Depth,Self,Cond,Res)). -eval_20(Eq,RetType,Depth,Self,['trace',Cond],Res):- !, with_debug(eval,eval(Eq,RetType,Depth,Self,Cond,Res)). -eval_20(Eq,RetType,Depth,Self,['time',Cond],Res):- !, time_eval(eval(Cond),eval(Eq,RetType,Depth,Self,Cond,Res)). -eval_20(Eq,RetType,Depth,Self,['print',Cond],Res):- !, eval(Eq,RetType,Depth,Self,Cond,Res),'format'('~N'),print(Res),'format'('~N'). -% !(println! $1) -eval_20(Eq,RetType,Depth,Self,['println!'|Cond],Res):- !, - maplist(eval(Eq,RetType,Depth,Self),Cond,[Res|Out]), - 'format'('~N'),maplist(write_src,[Res|Out]),'format'('~N'). -eval_20(Eq,RetType,Depth,Self,['trace!',A|Cond],Res):- !, maplist(eval(Eq,RetType,Depth,Self),[A|Cond],[AA|Result]), - last(Result,Res), 'format'('~N'),maplist(write_src,[AA]),'format'('~N'). - -%eval_20(Eq,RetType,Depth,Self,['trace!',A,B],C):- !,eval(Eq,RetType,Depth,Self,B,C),'format'('~N'),fbug(['trace!',A,B]=C),'format'('~N'). -%eval_20(Eq,RetType,_Dpth,_Slf,['trace!',A],A):- !, 'format'('~N'),fbug(A),'format'('~N'). - -eval_20(Eq,RetType,_Dpth,_Slf,List,YY):- is_list(List),maplist(self_eval,List),List=[H|_], \+ atom(H), !,Y=List,do_expander(Eq,RetType,Y,YY). - -eval_20(Eq,_ListOfRetType,Depth,Self,['TupleConcat',A,B],OO):- fail, !, - eval(Eq,RetType,Depth,Self,A,AA), - eval(Eq,RetType,Depth,Self,B,BB), - append(AA,BB,OO). -eval_20(Eq,OuterRetType,Depth,Self,['range',A,B],OO):- (is_list(A);is_list(B)), - ((eval(Eq,RetType,Depth,Self,A,AA), - eval(Eq,RetType,Depth,Self,B,BB))), - ((AA+BB)\=@=(A+B)), - eval_20(Eq,OuterRetType,Depth,Self,['range',AA,BB],OO),!. - - -%eval_20(Eq,RetType,Depth,Self,['colapse'|List], Flat):- !, maplist(eval(Eq,RetType,Depth,Self),List,Res),flatten(Res,Flat). - -eval_20(_Eq,_OuterRetType,_Depth,_Self,[P,_,B],_):-P=='/',B==0,!,fail. - - -% ================================================================= -% ================================================================= -% ================================================================= -% UNIT TESTING/assert -% ================================================================= -% ================================================================= -% ================================================================= - - -eval_20(Eq,RetType,Depth,Self,['assertTrue', X],TF):- !, eval(Eq,RetType,Depth,Self,['assertEqual',X,'True'],TF). -eval_20(Eq,RetType,Depth,Self,['assertFalse',X],TF):- !, eval(Eq,RetType,Depth,Self,['assertEqual',X,'False'],TF). - -eval_20(Eq,RetType,Depth,Self,['assertEqual',X,Y],RetVal):- !, - loonit_assert_source_tf( - ['assertEqual',X,Y], - (bagof_eval(Eq,RetType,Depth,Self,X,XX), bagof_eval(Eq,RetType,Depth,Self,Y,YY)), - equal_enough_for_test(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got(XX,[expected,YY])]). - -eval_20(Eq,RetType,Depth,Self,['assertNotEqual',X,Y],RetVal):- !, - loonit_assert_source_tf( - ['assertEqual',X,Y], - (bagof_eval(Eq,RetType,Depth,Self,X,XX), bagof_eval(Eq,RetType,Depth,Self,Y,YY)), - \+ equal_enough(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got(XX,[expected,YY])]). - -eval_20(Eq,RetType,Depth,Self,['assertEqualToResult',X,Y],RetVal):- !, - loonit_assert_source_tf( - ['assertEqualToResult',X,Y], - (bagof_eval(Eq,RetType,Depth,Self,X,XX), sort(Y,YY)), - equal_enough_for_test(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got(XX,[expected,YY])]). - - -loonit_assert_source_tf(Src,Goal,Check,TF):- - copy_term(Goal,OrigGoal), - flag(eval_num,_,0), - loonit_asserts(Src, time_eval('\n; EVAL TEST\n;',Goal), Check), - as_tf(Check,TF),!, - ignore(( - once((TF='True', trace_on_pass);(TF='False', trace_on_fail)), - with_debug(metta(eval),time_eval('Trace',OrigGoal)))). - -sort_result(Res,Res):- \+ compound(Res),!. -sort_result([And|Res1],Res):- is_and(And),!,sort_result(Res1,Res). -sort_result([T,And|Res1],Res):- is_and(And),!,sort_result([T|Res1],Res). -sort_result([H|T],[HH|TT]):- !, sort_result(H,HH),sort_result(T,TT). -sort_result(Res,Res). - -unify_enough(L,L). -unify_enough(L,C):- into_list_args(L,LL),into_list_args(C,CC),unify_lists(CC,LL). - -%unify_lists(C,L):- \+ compound(C),!,L=C. -%unify_lists(L,C):- \+ compound(C),!,L=C. -unify_lists(L,L):-!. -unify_lists([C|CC],[L|LL]):- unify_enough(L,C),!,unify_lists(CC,LL). - -equal_enough(R,V):- is_list(R),is_list(V),sort(R,RR),sort(V,VV),!,equal_enouf(RR,VV),!. -equal_enough(R,V):- copy_term(R,RR),copy_term(V,VV),equal_enouf(R,V),!,R=@=RR,V=@=VV. - -%s_empty(X):- var(X),!. -s_empty(X):- var(X),!,fail. -is_empty('Empty'). -is_empty([]). -is_empty([X]):-!,is_empty(X). -has_let_star(Y):- sub_var('let*',Y). - -equal_enough_for_test(X,Y):- is_empty(X),!,is_empty(Y). -equal_enough_for_test(X,Y):- has_let_star(Y),!,\+ is_empty(X). -equal_enough_for_test(X,Y):- must_det_ll((subst_vars(X,XX),subst_vars(Y,YY))),!,equal_enough_for_test2(XX,YY),!. -equal_enough_for_test2(X,Y):- equal_enough(X,Y). - -equal_enouf(R,V):- is_ftVar(R), is_ftVar(V), R=V,!. -equal_enouf(X,Y):- is_empty(X),!,is_empty(Y). -equal_enouf(X,Y):- symbol(X),symbol(Y),atom_concat('&',_,X),atom_concat('Grounding',_,Y). -equal_enouf(R,V):- R=@=V, R=V, !. -equal_enouf(_,V):- V=@='...',!. -equal_enouf(L,C):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). -equal_enouf(C,L):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). -%equal_enouf(R,V):- (var(R),var(V)),!, R=V. -equal_enouf(R,V):- (var(R);var(V)),!, R==V. -equal_enouf(R,V):- number(R),number(V),!, RV is abs(R-V), RV < 0.03 . -equal_enouf(R,V):- atom(R),!,atom(V), has_unicode(R),has_unicode(V). -equal_enouf(R,V):- (\+ compound(R) ; \+ compound(V)),!, R==V. -equal_enouf(L,C):- into_list_args(L,LL),into_list_args(C,CC),!,equal_enouf_l(CC,LL). - -equal_enouf_l([S1,V1|_],[S2,V2|_]):- S1 == 'State',S2 == 'State',!, equal_enouf(V1,V2). -equal_enouf_l(C,L):- \+ compound(C),!,L=@=C. -equal_enouf_l(L,C):- \+ compound(C),!,L=@=C. -equal_enouf_l([C|CC],[L|LL]):- !, equal_enouf(L,C),!,equal_enouf_l(CC,LL). - - -has_unicode(A):- atom_codes(A,Cs),member(N,Cs),N>127,!. - -set_last_error(_). - -% ================================================================= -% ================================================================= -% ================================================================= -% SPACE EDITING -% ================================================================= -% ================================================================= -% ================================================================= - -eval_20(Eq,RetType,_Dpth,_Slf,['new-space'],Space):- !, 'new-space'(Space),check_returnval(Eq,RetType,Space). - -eval_20(Eq,RetType,Depth,Self,[Op,Space|Args],Res):- is_space_op(Op),!, - eval_space_start(Eq,RetType,Depth,Self,[Op,Space|Args],Res). - - -eval_space_start(Eq,RetType,_Depth,_Self,[_Op,_Other,Atom],Res):- - (Atom == [] ; Atom =='Empty'; Atom =='Nil'),!,return_empty('False',Res),check_returnval(Eq,RetType,Res). - -eval_space_start(Eq,RetType,Depth,Self,[Op,Other|Args],Res):- - into_space(Depth,Self,Other,Space), - eval_space(Eq,RetType,Depth,Self,[Op,Space|Args],Res). - - -eval_space(Eq,RetType,_Dpth,_Slf,['add-atom',Space,PredDecl],Res):- !, - do_metta(python,load,Space,PredDecl,TF),return_empty(TF,Res),check_returnval(Eq,RetType,Res). - -eval_space(Eq,RetType,_Dpth,_Slf,['remove-atom',Space,PredDecl],Res):- !, - do_metta(python,unload,Space,PredDecl,TF),return_empty(TF,Res),check_returnval(Eq,RetType,Res). - -eval_space(Eq,RetType,_Dpth,_Slf,['atom-count',Space],Count):- !, - ignore(RetType='Number'),ignore(Eq='='), - findall(Atom, get_metta_atom_from(Space, Atom),Atoms), - length(Atoms,Count). - -eval_space(Eq,RetType,_Dpth,_Slf,['atom-replace',Space,Rem,Add],TF):- !, - copy_term(Rem,RCopy), as_tf((metta_atom_iter_ref(Space,RCopy,Ref), RCopy=@=Rem,erase(Ref), do_metta(Space,load,Add)),TF), - check_returnval(Eq,RetType,TF). - -eval_space(Eq,RetType,_Dpth,_Slf,['get-atoms',Space],Atom):- !, - ignore(RetType='Atom'), get_metta_atom_from(Space, Atom), check_returnval(Eq,RetType,Atom). - -% Match-ELSE -eval_space(Eq,RetType,Depth,Self,['match',Other,Goal,Template,Else],Template):- !, - ((eval_space(Eq,RetType,Depth,Self,['match',Other,Goal,Template],Template), - \+ return_empty([],Template))*->true;Template=Else). -% Match-TEMPLATE - -eval_space(Eq,_RetType,Depth,Self,['match',Other,Goal,Template],Res):- !, - metta_atom_iter(Eq,Depth,Self,Other,Goal), - Template=Res. - -metta_atom_iter(Eq,_Depth,_Slf,Other,[Equal,[F|H],B]):- Eq == Equal,!, % trace, - metta_defn(Eq,Other,[F|H],B). - -/* -metta_atom_iter(Eq,Depth,Self,Other,[Equal,[F|H],B]):- Eq == Equal,!, % trace, - metta_defn(Eq,Other,[F|H],BB), - eval_sometimes(Eq,_RetType,Depth,Self,B,BB). -*/ - -metta_atom_iter(_Eq,Depth,_,_,_):- Depth<3,!,fail. -metta_atom_iter(Eq,Depth,Self,Other,[And|Y]):- atom(And), is_and(And),!, - (Y==[] -> true ; - ( D2 is Depth -1, Y = [H|T], - metta_atom_iter(Eq,D2,Self,Other,H),metta_atom_iter(Eq,D2,Self,Other,[And|T]))). - -%metta_atom_iter(Eq,Depth,_Slf,Other,X):- dcall0000000000(eval_args_true(Eq,_RetType,Depth,Other,X)). -metta_atom_iter(Eq,Depth,_Slf,Other,X):- - %copy_term(X,XX), - dcall0000000000(eval_args_true(Eq,_RetType,Depth,Other,XX)), X=XX. - - -eval_args_true_r(Eq,RetType,Depth,Self,X,TF1):- - ((eval_ne(Eq,RetType,Depth,Self,X,TF1), \+ is_False(TF1)); - ( \+ is_False(TF1),metta_atom_true(Eq,Depth,Self,Self,X))). - -eval_args_true(Eq,RetType,Depth,Self,X):- - metta_atom_true(Eq,Depth,Self,Self,X); - (nonvar(X),eval_ne(Eq,RetType,Depth,Self,X,TF1), \+ is_False(TF1)). - -metta_atom_true(Eq,_Dpth,_Slf,Other,H):- get_metta_atom(Eq,Other,H). -% is this OK? -metta_atom_true(Eq,Depth,Self,Other,H):- nonvar(H), metta_defn(Eq,Other,H,B), D2 is Depth -1, eval_args_true(Eq,_,D2,Self,B). -% is this OK? -metta_atom_true(Eq,Depth,Self,Other,H):- Other\==Self, nonvar(H), metta_defn(Eq,Other,H,B), D2 is Depth -1, eval_args_true(Eq,_,D2,Other,B). - - - -metta_atom_iter_ref(Other,H,Ref):-clause(metta_atom_asserted(Other,H),true,Ref). - - -% ================================================================= -% ================================================================= -% ================================================================= -% CASE/SWITCH -% ================================================================= -% ================================================================= -% ================================================================= -% Macro: case -:- nodebug(metta(case)). - -eval_20(Eq,RetType,Depth,Self,[P,X|More],YY):- is_list(X),X=[_,_,_],simple_math(X), - eval_selfless_2(X,XX),X\=@=XX,!, eval_20(Eq,RetType,Depth,Self,[P,XX|More],YY). -% if there is only a void then always return nothing for each Case -eval_20(Eq,_RetType,Depth,Self,['case',A,[[Void,_]]],Res):- - '%void%' == Void, - eval(Eq,_UnkRetType,Depth,Self,A,_),!,Res =[]. - -% if there is nothing for case just treat like a collapse -eval_20(Eq,_RetType,Depth,Self,['case',A,[]],Empty):- !, - %forall(eval(Eq,_RetType2,Depth,Self,Expr,_),true), - once(eval(Eq,_RetType2,Depth,Self,A,_)), - return_empty([],Empty). - -% Macro: case -eval_20(Eq,RetType,Depth,Self,['case',A,CL|T],Res):- !, - must_det_ll(T==[]), - into_case_list(CL,CASES), - findall(Key-Value, - (nth0(Nth,CASES,Case0), - (is_case(Key,Case0,Value), - if_trace(metta(case),('format'('~N'),writeqln(c(Nth,Key)=Value))))),KVs),!, - eval_case(Eq,RetType,Depth,Self,A,KVs,Res). - -eval_case(Eq,CaseRetType,Depth,Self,A,KVs,Res):- - ((eval(Eq,_UnkRetType,Depth,Self,A,AA), - if_trace((case),(writeqln('case'=A))), - if_trace(metta(case),writeqln('switch'=AA)), - (select_case(Depth,Self,AA,KVs,Value)->true;(member(Void -Value,KVs),Void=='%void%'))) - *->true;(member(Void -Value,KVs),Void=='%void%')), - eval(Eq,CaseRetType,Depth,Self,Value,Res). - - select_case(Depth,Self,AA,Cases,Value):- - (best_key(AA,Cases,Value) -> true ; - (maybe_special_keys(Depth,Self,Cases,CasES), - (best_key(AA,CasES,Value) -> true ; - (member(Void -Value,CasES),Void=='%void%')))). - - best_key(AA,Cases,Value):- - ((member(Match-Value,Cases),AA ==Match)->true; - ((member(Match-Value,Cases),AA=@=Match)->true; - (member(Match-Value,Cases),AA = Match))). - - into_case_list(CASES,CASES):- is_list(CASES),!. - is_case(AA,[AA,Value],Value):-!. - is_case(AA,[AA|Value],Value). - - maybe_special_keys(Depth,Self,[K-V|KVI],[AK-V|KVO]):- - eval(Depth,Self,K,AK), K\=@=AK,!, - maybe_special_keys(Depth,Self,KVI,KVO). - maybe_special_keys(Depth,Self,[_|KVI],KVO):- - maybe_special_keys(Depth,Self,KVI,KVO). - maybe_special_keys(_Depth,_Self,[],[]). - - -% ================================================================= -% ================================================================= -% ================================================================= -% COLLAPSE/SUPERPOSE -% ================================================================= -% ================================================================= -% ================================================================= - - - -%[collapse,[1,2,3]] -eval_20(Eq,RetType,Depth,Self,['collapse',List],Res):-!, - bagof_eval(Eq,RetType,Depth,Self,List,Res). - -eval_20(Eq,RetType,Depth,Self,PredDecl,Res):- - Do_more_defs = do_more_defs(true), - clause(eval_21(Eq,RetType,Depth,Self,PredDecl,Res),Body), - Do_more_defs == do_more_defs(true), - call_ndet(Body,DET), - nb_setarg(1,Do_more_defs,false), - (DET==true -> ! ; true). - -eval_21(_Eq,_RetType,_Depth,_Self,['fb-member',Res,List],TF):-!, as_tf(fb_member(Res,List),TF). -eval_21(_Eq,_RetType,_Depth,_Self,['fb-member',List],Res):-!, fb_member(Res,List). - - -eval_21(Eq,RetType,Depth,Self,['CollapseCardinality',List],Len):-!, - bagof_eval(Eq,RetType,Depth,Self,List,Res), - length(Res,Len). -/* -eval_21(_Eq,_RetType,_Depth,_Self,['TupleCount', [N]],N):- number(N),!. - - -*/ -eval_21(Eq,RetType,Depth,Self,['TupleCount',List],Len):-!, - bagof_eval(Eq,RetType,Depth,Self,List,Res), - length(Res,Len). -eval_21(_Eq,_RetType,_Depth,_Self,['tuple-count',List],Len):-!, - length(List,Len). - -%[superpose,[1,2,3]] -eval_20(Eq,RetType,Depth,Self,['superpose',List],Res):- !, - (((is_user_defined_head(Eq,Self,List) ,eval(Eq,RetType,Depth,Self,List,UList), List\=@=UList) - *-> eval_20(Eq,RetType,Depth,Self,['superpose',UList],Res) - ; ((member(E,List),eval(Eq,RetType,Depth,Self,E,Res))*->true;return_empty([],Res)))), - \+ Res = 'Empty'. - -%[sequential,[1,2,3]] -eval_20(Eq,RetType,Depth,Self,['sequential',List],Res):- !, - (((fail,is_user_defined_head(Eq,Self,List) ,eval(Eq,RetType,Depth,Self,List,UList), List\=@=UList) - *-> eval_20(Eq,RetType,Depth,Self,['sequential',UList],Res) - ; ((member(E,List),eval_ne(Eq,RetType,Depth,Self,E,Res))*->true;return_empty([],Res)))). - - -get_sa_p1(P3,E,Cmpd,SA):- compound(Cmpd), get_sa_p2(P3,E,Cmpd,SA). -get_sa_p2(P3,E,Cmpd,call(P3,N1,Cmpd)):- arg(N1,Cmpd,E). -get_sa_p2(P3,E,Cmpd,SA):- arg(_,Cmpd,Arg),get_sa_p1(P3,E,Arg,SA). -eval20_failed(Eq,RetType,Depth,Self, Term, Res):- - fake_notrace(( get_sa_p1(setarg,ST,Term,P1), % ST\==Term, - compound(ST), ST = [F,List],F=='superpose',nonvar(List), %maplist(atomic,List), - call(P1,Var))), !, - %max_counting(F,20), - member(Var,List), - eval(Eq,RetType,Depth,Self, Term, Res). - - -sub_sterm(Sub,Sub). -sub_sterm(Sub,Term):- sub_sterm1(Sub,Term). -sub_sterm1(_ ,List):- \+ compound(List),!,fail. -sub_sterm1(Sub,List):- is_list(List),!,member(SL,List),sub_sterm(Sub,SL). -sub_sterm1(_ ,[_|_]):-!,fail. -sub_sterm1(Sub,Term):- arg(_,Term,SL),sub_sterm(Sub,SL). -eval20_failed_2(Eq,RetType,Depth,Self, Term, Res):- - fake_notrace(( get_sa_p1(setarg,ST,Term,P1), - compound(ST), ST = [F,List],F=='collapse',nonvar(List), %maplist(atomic,List), - call(P1,Var))), !, bagof_eval(Eq,RetType,Depth,Self,List,Var), - eval(Eq,RetType,Depth,Self, Term, Res). - - -% ================================================================= -% ================================================================= -% ================================================================= -% NOP/EQUALITU/DO -% ================================================================= -% ================================================================= -% ================================================================ -eval_20(_Eq,_RetType,_Depth,_Self,['nop'], _ ):- !, fail. -eval_20(_Eq,_RetType,_Depth,_Self,['empty'], _ ):- !, fail. -eval_20(_Eq,_RetType1,Depth,Self,['nop',Expr], Empty):- !, - ignore(eval('=',_RetType2,Depth,Self,Expr,_)), - return_empty([], Empty). - -eval_20(Eq,_RetType1,Depth,Self,['do',Expr], Empty):- !, - forall(eval(Eq,_RetType2,Depth,Self,Expr,_),true), - %eval_ne(Eq,_RetType2,Depth,Self,Expr,_),!, - return_empty([],Empty). - -eval_20(_Eq,_RetType1,_Depth,_Self,['call',S], TF):- !, eval_call(S,TF). - -max_counting(F,Max):- flag(F,X,X+1), X true; (flag(F,_,10),!,fail). -% ================================================================= -% ================================================================= -% ================================================================= -% if/If -% ================================================================= -% ================================================================= -% ================================================================= - - - -eval_20(Eq,RetType,Depth,Self,['if',Cond,Then,Else],Res):- !, - eval(Eq,'Bool',Depth,Self,Cond,TF), - (is_True(TF) - -> eval(Eq,RetType,Depth,Self,Then,Res) - ; eval(Eq,RetType,Depth,Self,Else,Res)). - -eval_20(Eq,RetType,Depth,Self,['If',Cond,Then,Else],Res):- !, - eval(Eq,'Bool',Depth,Self,Cond,TF), - (is_True(TF) - -> eval(Eq,RetType,Depth,Self,Then,Res) - ; eval(Eq,RetType,Depth,Self,Else,Res)). - -eval_20(Eq,RetType,Depth,Self,['If',Cond,Then],Res):- !, - eval(Eq,'Bool',Depth,Self,Cond,TF), - (is_True(TF) -> eval(Eq,RetType,Depth,Self,Then,Res) ; - (!, fail,Res = [],!)). - -eval_20(Eq,RetType,Depth,Self,['if',Cond,Then],Res):- !, - eval(Eq,'Bool',Depth,Self,Cond,TF), - (is_True(TF) -> eval(Eq,RetType,Depth,Self,Then,Res) ; - (!, fail,Res = [],!)). - - -eval_20(Eq,RetType,_Dpth,_Slf,[_,Nothing],NothingO):- - 'Nothing'==Nothing,!,do_expander(Eq,RetType,Nothing,NothingO). - -% ================================================================= -% ================================================================= -% ================================================================= -% LET/LET* -% ================================================================= -% ================================================================= -% ================================================================= - - - -eval_until_unify(_Eq,_RetType,_Dpth,_Slf,X,X):- !. -eval_until_unify(Eq,RetType,Depth,Self,X,Y):- eval_until_eq(Eq,RetType,Depth,Self,X,Y),!. - -eval_until_eq(Eq,RetType,_Dpth,_Slf,X,Y):- X=Y,check_returnval(Eq,RetType,Y). -%eval_until_eq(Eq,RetType,Depth,Self,X,Y):- var(Y),!,eval_in_steps_or_same(Eq,RetType,Depth,Self,X,XX),Y=XX. -%eval_until_eq(Eq,RetType,Depth,Self,Y,X):- var(Y),!,eval_in_steps_or_same(Eq,RetType,Depth,Self,X,XX),Y=XX. -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- \+is_list(Y),!,eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),Y=XX. -eval_until_eq(Eq,RetType,Depth,Self,Y,X):- \+is_list(Y),!,eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),Y=XX. -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),eval_until_eq(Eq,RetType,Depth,Self,Y,XX). -eval_until_eq(_Eq,_RetType,_Dpth,_Slf,X,Y):- length(X,Len), \+ length(Y,Len),!,fail. -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), - EX=EY,!, maplist(eval_until_eq(Eq,RetType,Depth,Self),RX,RY). -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), - ((var(EX);var(EY)),eval_until_eq(Eq,RetType,Depth,Self,EX,EY)), - maplist(eval_until_eq(Eq,RetType,Depth,Self),RX,RY). -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), - h((is_list(EX);is_list(EY)),eval_until_eq(Eq,RetType,Depth,Self,EX,EY)), - maplist(eval_until_eq(Eq,RetType,Depth,Self),RX,RY). - - eval_1change(Eq,RetType,Depth,Self,EX,EXX):- - eval_20(Eq,RetType,Depth,Self,EX,EXX), EX \=@= EXX. - -eval_complete_change(Eq,RetType,Depth,Self,EX,EXX):- - eval(Eq,RetType,Depth,Self,EX,EXX), EX \=@= EXX. - -eval_in_steps_some_change(_Eq,_RetType,_Dpth,_Slf,EX,_):- \+ is_list(EX),!,fail. -eval_in_steps_some_change(Eq,RetType,Depth,Self,EX,EXX):- eval_1change(Eq,RetType,Depth,Self,EX,EXX). -eval_in_steps_some_change(Eq,RetType,Depth,Self,X,Y):- append(L,[EX|R],X),is_list(EX), - eval_in_steps_some_change(Eq,RetType,Depth,Self,EX,EXX), EX\=@=EXX, - append(L,[EXX|R],XX),eval_in_steps_or_same(Eq,RetType,Depth,Self,XX,Y). - -eval_in_steps_or_same(Eq,RetType,Depth,Self,X,Y):-eval_in_steps_some_change(Eq,RetType,Depth,Self,X,Y). -eval_in_steps_or_same(Eq,RetType,_Dpth,_Slf,X,Y):- X=Y,check_returnval(Eq,RetType,Y). - - % (fail,return_empty([],Template))). -possible_type(_Self,_Var,_RetTypeV). - -eval_20(Eq,RetType,Depth,Self,['let',A,A5,AA],OO):- !, - %(var(A)->true;trace), - possible_type(Self,A,RetTypeV), - eval(Eq,RetTypeV,Depth,Self,A5,AR), A=AR, - eval(Eq,RetType,Depth,Self,AA,OO). - -%eval_20(Eq,RetType,Depth,Self,['let',A,A5,AA],AAO):- !,eval(Eq,RetType,Depth,Self,A5,A),eval(Eq,RetType,Depth,Self,AA,AAO). -eval_20(Eq,RetType,Depth,Self,['let*',[],Body],RetVal):- !, eval(Eq,RetType,Depth,Self,Body,RetVal). -%eval_20(Eq,RetType,Depth,Self,['let*',[[Var,Val]|LetRest],Body],RetVal):- !, -% eval_until_unify(Eq,_RetTypeV,Depth,Self,Val,Var), -% eval_20(Eq,RetType,Depth,Self,['let*',LetRest,Body],RetVal). -eval_20(Eq,RetType,Depth,Self,['let*',[[Var,Val]|LetRest],Body],RetVal):- !, - eval_20(Eq,RetType,Depth,Self,['let',Var,Val,['let*',LetRest,Body]],RetVal). - - -% ================================================================= -% ================================================================= -% ================================================================= -% CONS/CAR/CDR -% ================================================================= -% ================================================================= -% ================================================================= - - - -into_pl_list(Var,Var):- var(Var),!. -into_pl_list(Nil,[]):- Nil == 'Nil',!. -into_pl_list([Cons,H,T],[HH|TT]):- Cons == 'Cons', !, into_pl_list(H,HH),into_pl_list(T,TT),!. -into_pl_list(X,X). - -into_metta_cons(Var,Var):- var(Var),!. -into_metta_cons([],'Nil'):-!. -into_metta_cons([Cons, A, B ],['Cons', AA, BB]):- 'Cons'==Cons, no_cons_reduce, !, - into_metta_cons(A,AA), into_metta_cons(B,BB). -into_metta_cons([H|T],['Cons',HH,TT]):- into_metta_cons(H,HH),into_metta_cons(T,TT),!. -into_metta_cons(X,X). - -into_listoid(AtomC,Atom):- AtomC = [Cons,H,T],Cons=='Cons',!, Atom=[H,[T]]. -into_listoid(AtomC,Atom):- is_list(AtomC),!,Atom=AtomC. -into_listoid(AtomC,Atom):- typed_list(AtomC,_,Atom),!. - -:- if( \+ current_predicate( typed_list / 3 )). -typed_list(Cmpd,Type,List):- compound(Cmpd), Cmpd\=[_|_], compound_name_arguments(Cmpd,Type,[List|_]),is_list(List). -:- endif. - -%eval_20(Eq,RetType,Depth,Self,['colapse'|List], Flat):- !, maplist(eval(Eq,RetType,Depth,Self),List,Res),flatten(Res,Flat). - -%eval_20(Eq,RetType,Depth,Self,['flatten'|List], Flat):- !, maplist(eval(Eq,RetType,Depth,Self),List,Res),flatten(Res,Flat). - - -eval_20(Eq,RetType,_Dpth,_Slf,['car-atom',Atom],CAR_Y):- !, Atom=[CAR|_],!,do_expander(Eq,RetType,CAR,CAR_Y). -eval_20(Eq,RetType,_Dpth,_Slf,['cdr-atom',Atom],CDR_Y):- !, Atom=[_|CDR],!,do_expander(Eq,RetType,CDR,CDR_Y). - -eval_20(Eq,RetType,Depth,Self,['Cons', A, B ],['Cons', AA, BB]):- no_cons_reduce, !, - eval(Eq,RetType,Depth,Self,A,AA), eval(Eq,RetType,Depth,Self,B,BB). - -%eval_20(_Eq,_RetType,Depth,Self,['::'|PL],Prolog):- maplist(as_prolog(Depth,Self),PL,Prolog),!. -%eval_20(_Eq,_RetType,Depth,Self,['@'|PL],Prolog):- as_prolog(Depth,Self,['@'|PL],Prolog),!. - -eval_20(Eq,RetType,Depth,Self,['Cons', A, B ],[AA|BB]):- \+ no_cons_reduce, !, - eval(Eq,RetType,Depth,Self,A,AA), eval(Eq,RetType,Depth,Self,B,BB). - - - -% ================================================================= -% ================================================================= -% ================================================================= -% STATE EDITING -% ================================================================= -% ================================================================= -% ================================================================= - -eval_20(Eq,RetType,Depth,Self,['change-state!',StateExpr, UpdatedValue], Ret):- !, - call_in_shared_space(((eval(Eq,RetType,Depth,Self,StateExpr,StateMonad), - eval(Eq,RetType,Depth,Self,UpdatedValue,Value), 'change-state!'(Depth,Self,StateMonad, Value, Ret)))). -eval_20(Eq,RetType,Depth,Self,['new-state',UpdatedValue],StateMonad):- !, - call_in_shared_space(((eval(Eq,RetType,Depth,Self,UpdatedValue,Value), 'new-state'(Depth,Self,Value,StateMonad)))). -eval_20(Eq,RetType,Depth,Self,['get-state',StateExpr],Value):- !, - call_in_shared_space((eval(Eq,RetType,Depth,Self,StateExpr,StateMonad), 'get-state'(StateMonad,Value))). - -call_in_shared_space(G):- call_in_thread(main,G). - -% eval_20(Eq,RetType,Depth,Self,['get-state',Expr],Value):- !, eval(Eq,RetType,Depth,Self,Expr,State), arg(1,State,Value). - - - -check_type:- option_else(typecheck,TF,'False'), TF=='True'. - -:- dynamic is_registered_state/1. -:- flush_output. -:- setenv('RUST_BACKTRACE',full). - -% Function to check if an value is registered as a state name -:- dynamic(is_registered_state/1). -is_nb_state(G):- is_valid_nb_state(G) -> true ; - is_registered_state(G),nb_current(G,S),is_valid_nb_state(S). - - -:- multifile(state_type_method/3). -:- dynamic(state_type_method/3). -state_type_method(is_nb_state,new_state,init_state). -state_type_method(is_nb_state,clear_state,clear_nb_values). -state_type_method(is_nb_state,add_value,add_nb_value). -state_type_method(is_nb_state,remove_value,'change-state!'). -state_type_method(is_nb_state,replace_value,replace_nb_value). -state_type_method(is_nb_state,value_count,value_nb_count). -state_type_method(is_nb_state,'get-state','get-state'). -state_type_method(is_nb_state,value_iter,value_nb_iter). -%state_type_method(is_nb_state,query,state_nb_query). - -% Clear all values from a state -clear_nb_values(StateNameOrInstance) :- - fetch_or_create_state(StateNameOrInstance, State), - nb_setarg(1, State, []). - - - -% Function to confirm if a term represents a state -is_valid_nb_state(State):- compound(State),functor(State,'State',_). - -% Find the original name of a given state -state_original_name(State, Name) :- - is_registered_state(Name), - call_in_shared_space(nb_current(Name, State)). - -% Register and initialize a new state -init_state(Name) :- - State = 'State'(_,_), - asserta(is_registered_state(Name)), - call_in_shared_space(nb_setval(Name, State)). - -% Change a value in a state -'change-state!'(Depth,Self,StateNameOrInstance, UpdatedValue, Out) :- - fetch_or_create_state(StateNameOrInstance, State), - arg(2, State, Type), - ( (check_type,\+ get_type(Depth,Self,UpdatedValue,Type)) - -> (Out = ['Error', UpdatedValue, 'BadType']) - ; (nb_setarg(1, State, UpdatedValue), Out = State) ). - -% Fetch all values from a state -'get-state'(StateNameOrInstance, Values) :- - fetch_or_create_state(StateNameOrInstance, State), - arg(1, State, Values). - -'new-state'(Depth,Self,Init,'State'(Init, Type)):- check_type->get_type(Depth,Self,Init,Type);true. - -'new-state'(Init,'State'(Init, Type)):- check_type->get_type(10,'&self',Init,Type);true. - -fetch_or_create_state(Name):- fetch_or_create_state(Name,_). -% Fetch an existing state or create a new one - -fetch_or_create_state(State, State) :- is_valid_nb_state(State),!. -fetch_or_create_state(NameOrInstance, State) :- - ( atom(NameOrInstance) - -> (is_registered_state(NameOrInstance) - -> nb_current(NameOrInstance, State) - ; init_state(NameOrInstance), - nb_current(NameOrInstance, State)) - ; is_valid_nb_state(NameOrInstance) - -> State = NameOrInstance - ; writeln('Error: Invalid input.') - ), - is_valid_nb_state(State). - -% ================================================================= -% ================================================================= -% ================================================================= -% GET-TYPE -% ================================================================= -% ================================================================= -% ================================================================= - -eval_20(Eq,RetType,Depth,Self,['get-type',Val],TypeO):- !, - eval_get_type(Eq,RetType,Depth,Self,Val,TypeO). - - -eval_get_type(Eq,RetType,Depth,Self,Val,TypeO):- - get_type(Depth,Self,Val,Type),ground(Type),Type\==[], Type\==Val,!, - do_expander(Eq,RetType,Type,TypeO). - - - -eval_20(Eq,RetType,Depth,Self,['length',L],Res):- !, eval(Eq,RetType,Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). -eval_20(Eq,RetType,Depth,Self,['CountElement',L],Res):- !, eval(Eq,RetType,Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). - -eval_20(_Eq,_RetType,_Depth,_Self,['get-metatype',Val],TypeO):- !, - get_metatype(Val,TypeO). - -get_metatype(Val,Want):- get_metatype0(Val,Was),!,Want=Was. -get_metatype0(Val,'Variable'):- var(Val). -get_metatype0(Val,'Symbol'):- symbol(Val). -get_metatype0(Val,'Expression'):- is_list(Val). -get_metatype0(_Val,'Grounded'). - - - - - -% ================================================================= -% ================================================================= -% ================================================================= -% IMPORT/BIND -% ================================================================= -% ================================================================= -% ================================================================= -nb_bind(Name,Value):- nb_current(Name,Was),same_term(Value,Was),!. -nb_bind(Name,Value):- call_in_shared_space(nb_setval(Name,Value)),!. -eval_20(Eq,RetType,Depth,Self,['import!',Other,File],RetVal):- !, - (( into_space(Depth,Self,Other,Space), include_metta(Space,File),!,return_empty(Space,RetVal))), - check_returnval(Eq,RetType,RetVal). %RetVal=[]. -eval_20(Eq,RetType,_Depth,_Slf,['bind!',Other,['new-space']],RetVal):- atom(Other),!,assert(was_asserted_space(Other)), - return_empty([],RetVal), check_returnval(Eq,RetType,RetVal). -eval_20(Eq,RetType,Depth,Self,['bind!',Other,Expr],RetVal):- !, - must_det_ll((into_name(Self,Other,Name),!,eval(Eq,RetType,Depth,Self,Expr,Value), - nb_bind(Name,Value), return_empty(Value,RetVal))), - check_returnval(Eq,RetType,RetVal). -eval_20(Eq,RetType,Depth,Self,['pragma!',Other,Expr],RetVal):- !, - must_det_ll((into_name(Self,Other,Name),nd_ignore((eval(Eq,RetType,Depth,Self,Expr,Value), - set_option_value_interp(Name,Value))), return_empty(Value,RetVal), - check_returnval(Eq,RetType,RetVal))). -eval_20(Eq,RetType,_Dpth,Self,['transfer!',File],RetVal):- !, must_det_ll((include_metta(Self,File), - return_empty(Self,RetVal),check_returnval(Eq,RetType,RetVal))). - - -fromNumber(Var1,Var2):- var(Var1),var(Var2),!,freeze(Var1,fromNumber(Var1,Var2)),freeze(Var2,fromNumber(Var1,Var2)). -fromNumber(0,'Z'):-!. -fromNumber(N,['S',Nat]):- integer(N), M is N -1,!,fromNumber(M,Nat). - -eval_20(Eq,RetType,Depth,Self,['fromNumber',NE],RetVal):- !, - eval('=','Number',Depth,Self,NE,N), - fromNumber(N,RetVal), check_returnval(Eq,RetType,RetVal). - -eval_20(Eq,RetType,Depth,Self,['dedup!',Eval],RetVal):- !, - term_variables(Eval+RetVal,Vars), - no_repeats_var(YY),!, - eval_20(Eq,RetType,Depth,Self,Eval,RetVal),YY=Vars. - - -nd_ignore(Goal):- call(Goal)*->true;true. - - - - - - - - - -% ================================================================= -% ================================================================= -% ================================================================= -% AND/OR -% ================================================================= -% ================================================================= -% ================================================================= - -is_True(T):- atomic(T), T\=='False', T\==0. - -is_and(S):- \+ atom(S),!,fail. -is_and(','). -is_and(S):- is_and(S,_). - -is_and(S,_):- \+ atom(S),!,fail. -is_and('and','True'). -is_and('and2','True'). -is_and('#COMMA','True'). is_and(',','True'). % is_and('And'). - -is_comma(C):- var(C),!,fail. -is_comma(','). -is_comma('{}'). - -eval_20(Eq,RetType,Depth,Self,[Comma,X ],Res):- is_comma(Comma),!, eval_args(Eq,RetType,Depth,Self,X,Res). -eval_20(Eq,RetType,Depth,Self,[Comma,X,Y],Res):- is_comma(Comma),!, eval_args(Eq,_,Depth,Self,X,_), - eval_args(Eq,RetType,Depth,Self,Y,Res). -eval_20(Eq,RetType,Depth,Self,[Comma,X|Y],Res):- is_comma(Comma),!, eval_args(Eq,_,Depth,Self,X,_), - eval_args(Eq,RetType,Depth,Self,[Comma|Y],Res). - - -eval_20(Eq,RetType,_Dpth,_Slf,[And],True):- is_and(And,True),!,check_returnval(Eq,RetType,True). -%eval_20(Eq,RetType,Depth,Self,[And,X,Y],TF):- is_and(And,True),!, -% as_tf(( eval_args(Eq,RetType,Depth,Self,X,True),eval_args(Eq,RetType,Depth,Self,Y,True)),TF). -eval_20(Eq,RetType,Depth,Self,[And,X],TF):- is_and(And,True),!, as_tf(eval_args(Eq,RetType,Depth,Self,X,True),TF). -eval_20(Eq,RetType,Depth,Self,[And,X|Y],TF):- is_and(And,True),!, as_tf(eval_args(Eq,RetType,Depth,Self,X,True),TF1), - (TF1=='False' -> TF=TF1 ; eval_args(Eq,RetType,Depth,Self,[And|Y],TF)). - - -eval_20(Eq,RetType,Depth,Self,[chain,X],TF):- - eval_args(Eq,RetType,Depth,Self,X,TF). -eval_20(Eq,RetType,Depth,Self,[chain,X|Y],TF):- - eval_args(Eq,RetType,Depth,Self,X,_), - eval_args(Eq,RetType,Depth,Self,[chain|Y],TF). - -eval_20(Eq,RetType,Depth,Self,['or',X,Y],TF):- !, - as_tf((eval_args_true(Eq,RetType,Depth,Self,X);eval_args_true(Eq,RetType,Depth,Self,Y)),TF). - -eval_20(Eq,RetType,Depth,Self,['not',X],TF):- !, - as_tf(( \+ eval_args_true(Eq,RetType,Depth,Self,X)), TF). - -eval_20(Eq,RetType,Depth,Self,['eval',X],TF):- !, - eval_args(Eq,RetType,Depth,Self,X, TF). - -eval_20(Eq,RetType,Depth,Self,['number-of',X],N):- !, - bagof_eval(Eq,RetType,Depth,Self,X,ResL), - length(ResL,N), ignore(RetType='Number'). - -eval_20(Eq,RetType,Depth,Self,['number-of',X,N],TF):- !, - bagof_eval(Eq,RetType,Depth,Self,X,ResL), - length(ResL,N), true_type(Eq,RetType,TF). - -eval_20(Eq,RetType,Depth,Self,['findall!',Template,X],ResL):- !, - findall(Template,eval_args(Eq,RetType,Depth,Self,X,_),ResL). - - - -eval_20(Eq,RetType,Depth,Self,['limit!',N,E],R):- !, eval_20(Eq,RetType,Depth,Self,['limit',N,E],R). -eval_20(Eq,RetType,Depth,Self,['limit',NE,E],R):- !, - eval('=','Number',Depth,Self,NE,N), - limit(N,eval_ne(Eq,RetType,Depth,Self,E,R)). - -eval_20(Eq,RetType,Depth,Self,['offset!',N,E],R):- !, eval_20(Eq,RetType,Depth,Self,['offset',N,E],R). -eval_20(Eq,RetType,Depth,Self,['offset',NE,E],R):- !, - eval('=','Number',Depth,Self,NE,N), - offset(N,eval_ne(Eq,RetType,Depth,Self,E,R)). - -eval_20(Eq,RetType,Depth,Self,['max-time!',N,E],R):- !, eval_20(Eq,RetType,Depth,Self,['max-time',N,E],R). -eval_20(Eq,RetType,Depth,Self,['max-time',NE,E],R):- !, - eval('=','Number',Depth,Self,NE,N), - cwtl(N,eval_ne(Eq,RetType,Depth,Self,E,R)). - - -eval_20(Eq,RetType,Depth,Self,['call-cleanup!',NE,E],R):- !, - call_cleanup(eval(Eq,RetType,Depth,Self,NE,R), - eval(Eq,_U_,Depth,Self,NE,_)). - -eval_20(Eq,RetType,Depth,Self,['setup-call-cleanup!',S,NE,E],R):- !, - setup_call_cleanup(eval(Eq,_,Depth,Self,S,_), - eval(Eq,RetType,Depth,Self,NE,R), - eval(Eq,_,Depth,Self,NE,_)). - -eval_20(Eq,RetType,Depth,Self,['with-output-to!',S,NE],R):- !, - eval(Eq,_,Depth,Self,S,OUT), - with_output_to_stream(OUT, - eval(Eq,RetType,Depth,Self,NE,R)). - - - -% ================================================================= -% ================================================================= -% ================================================================= -% DATA FUNCTOR -% ================================================================= -% ================================================================= -% ================================================================= -eval20_failked(Eq,RetType,Depth,Self,[V|VI],[V|VO]):- - nonvar(V),is_metta_data_functor(V),is_list(VI),!, - maplist(eval(Eq,RetType,Depth,Self),VI,VO). - - -% ================================================================= -% ================================================================= -% ================================================================= -% EVAL FAILED -% ================================================================= -% ================================================================= -% ================================================================= - -eval_failed(Depth,Self,T,TT):- - finish_eval(Depth,Self,T,TT). - -%finish_eval(_,_,X,X):-!. - -finish_eval(_Dpth,_Slf,T,TT):- var(T),!,TT=T. -finish_eval(_Dpth,_Slf,[],[]):-!. -finish_eval(_Dpth,_Slf,[F|LESS],Res):- once(eval_selfless([F|LESS],Res)),fake_notrace([F|LESS]\==Res),!. -%finish_eval(Depth,Self,[V|Nil],[O]):- Nil==[], once(eval(Eq,RetType,Depth,Self,V,O)),V\=@=O,!. -finish_eval(Depth,Self,[H|T],[HH|TT]):- !, eval(Depth,Self,H,HH), finish_eval(Depth,Self,T,TT). -finish_eval(Depth,Self,T,TT):- eval(Depth,Self,T,TT). - - %eval(Eq,RetType,Depth,Self,X,Y):- eval_20(Eq,RetType,Depth,Self,X,Y)*->true;Y=[]. - -%eval_20(Eq,RetType,Depth,_,_,_):- Depth<1,!,fail. -%eval_20(Eq,RetType,Depth,_,X,Y):- Depth<3, !, ground(X), (Y=X). -%eval_20(Eq,RetType,_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. - -% Kills zero arity functions eval_20(Eq,RetType,Depth,Self,[X|Nil],[Y]):- Nil ==[],!,eval(Eq,RetType,Depth,Self,X,Y). - - - -% ================================================================= -% ================================================================= -% ================================================================= -% METTLOG PREDEFS -% ================================================================= -% ================================================================= -% ================================================================= - - -eval_20(Eq,RetType,_Dpth,_Slf,['arity',F,A],TF):- !,as_tf(current_predicate(F/A),TF),check_returnval(Eq,RetType,TF). -eval_20(Eq,RetType,Depth,Self,['CountElement',L],Res):- !, eval(Eq,RetType,Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1),check_returnval(Eq,RetType,Res). -eval_20(Eq,RetType,_Dpth,_Slf,['make_list',List],MettaList):- !, into_metta_cons(List,MettaList),check_returnval(Eq,RetType,MettaList). - - -eval_20(Eq,RetType,Depth,Self,['maplist!',Pred,ArgL1],ResL):- !, - maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ResL). -eval_20(Eq,RetType,Depth,Self,['maplist!',Pred,ArgL1,ArgL2],ResL):- !, - maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ArgL2,ResL). -eval_20(Eq,RetType,Depth,Self,['maplist!',Pred,ArgL1,ArgL2,ArgL3],ResL):- !, - maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ArgL2,ArgL3,ResL). - - eval_pred(Eq,RetType,Depth,Self,Pred,Arg1,Res):- - eval(Eq,RetType,Depth,Self,[Pred,Arg1],Res). - eval_pred(Eq,RetType,Depth,Self,Pred,Arg1,Arg2,Res):- - eval(Eq,RetType,Depth,Self,[Pred,Arg1,Arg2],Res). - eval_pred(Eq,RetType,Depth,Self,Pred,Arg1,Arg2,Arg3,Res):- - eval(Eq,RetType,Depth,Self,[Pred,Arg1,Arg2,Arg3],Res). - -eval_20(Eq,RetType,Depth,Self,['concurrent-maplist!',Pred,ArgL1],ResL):- !, - metta_concurrent_maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ResL). -eval_20(Eq,RetType,Depth,Self,['concurrent-maplist!',Pred,ArgL1,ArgL2],ResL):- !, - concurrent_maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ArgL2,ResL). -eval_20(Eq,RetType,Depth,Self,['concurrent-maplist!',Pred,ArgL1,ArgL2,ArgL3],ResL):- !, - concurrent_maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ArgL2,ArgL3,ResL). -eval_20(Eq,RetType,Depth,Self,['concurrent-forall!',Gen,Test|Options],Empty):- !, - maplist(s2p,Options,POptions), - call(thread:concurrent_forall( - user:eval_ne(Eq,RetType,Depth,Self,Gen,_), - user:forall(eval(Eq,RetType,Depth,Self,Test,_),true), - POptions)), - return_empty([],Empty). - -eval_20(Eq,RetType,Depth,Self,['hyperpose',ArgL],Res):- !, metta_hyperpose(Eq,RetType,Depth,Self,ArgL,Res). - - -simple_math(Var):- attvar(Var),!,fail. -simple_math([F|XY]):- !, atom(F),atom_length(F,1), is_list(XY),maplist(simple_math,XY). -simple_math(X):- number(X),!. - - -eval_20(Eq,RetType,Depth,Self,X,Y):- - (eval_40(Eq,RetType,Depth,Self,X,M)*-> M=Y ; - % finish_eval(Depth,Self,M,Y); - (eval_failed(Depth,Self,X,Y)*->true;X=Y)). - -eval_40(_Eq,_RetType,_Dpth,_Slf,['extend-py!',Module],Res):- !, 'extend-py!'(Module,Res). - -/* -into_values(List,Many):- List==[],!,Many=[]. -into_values([X|List],Many):- List==[],is_list(X),!,Many=X. -into_values(Many,Many). -eval_40(Eq,RetType,_Dpth,_Slf,Name,Value):- atom(Name), nb_current(Name,Value),!. -*/ -% Macro Functions -%eval_20(Eq,RetType,Depth,_,_,_):- Depth<1,!,fail. -eval_40(_Eq,_RetType,Depth,_,X,Y):- Depth<3, !, fail, ground(X), (Y=X). -eval_40(Eq,RetType,Depth,Self,[F|PredDecl],Res):- - fail, - Depth>1, - fake_notrace((sub_sterm1(SSub,PredDecl), ground(SSub),SSub=[_|Sub], is_list(Sub), maplist(atomic,SSub))), - eval(Eq,RetType,Depth,Self,SSub,Repl), - fake_notrace((SSub\=Repl, subst(PredDecl,SSub,Repl,Temp))), - eval(Eq,RetType,Depth,Self,[F|Temp],Res). - -% ================================================================= -% ================================================================= -% ================================================================= -% PLUS/MINUS -% ================================================================= -% ================================================================= -% ================================================================= -eval_40(_Eq,_RetType,_Dpth,_Slf,LESS,Res):- - ((((eval_selfless(LESS,Res),fake_notrace(LESS\==Res))))),!. - -eval_40(Eq,RetType,Depth,Self,['+',N1,N2],N):- number(N1),!, - eval(Eq,RetType,Depth,Self,N2,N2Res), fake_notrace(catch_err(N is N1+N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). -eval_40(Eq,RetType,Depth,Self,['-',N1,N2],N):- number(N1),!, - eval(Eq,RetType,Depth,Self,N2,N2Res), fake_notrace(catch_err(N is N1-N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). -eval_40(Eq,RetType,Depth,Self,['*',N1,N2],N):- number(N1),!, - eval(Eq,RetType,Depth,Self,N2,N2Res), fake_notrace(catch_err(N is N1*N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). - -eval_40(Eq,RetType,Depth,Self,['length',L],Res):- !, eval(Depth,Self,L,LL), - (is_list(LL)->length(LL,Res);Res=1), - check_returnval(Eq,RetType,Res). - - - -eval_40(Eq,RetType,Depth,Self,[P,A,X|More],YY):- is_list(X),X=[_,_,_],simple_math(X), - eval_selfless_2(X,XX),X\=@=XX,!, - eval_40(Eq,RetType,Depth,Self,[P,A,XX|More],YY). - -eval_40(Eq,RetType,_Dpth,_Slf,['==',X,Y],Res):- !, - suggest_type(RetType,'Bool'), - eq_unify(Eq,_SharedType, X, Y, Res). - -eq_unify(_Eq,_SharedType, X, Y, TF):- as_tf(X=:=Y,TF),!. -eq_unify(_Eq,_SharedType, X, Y, TF):- as_tf( '#='(X,Y),TF),!. -eq_unify( Eq, SharedType, X, Y, TF):- as_tf(eval_until_unify(Eq,SharedType, X, Y), TF). - - -suggest_type(_RetType,_Bool). - -eval_40(Eq,RetType,Depth,Self,[AE|More],Res):- fail, %is_special_op(AE),!, - eval_70(Eq,RetType,Depth,Self,[AE|More],Res), - check_returnval(Eq,RetType,Res). - -eval_40(Eq,RetType,Depth,Self,[AE|More],Res):- % fail, - maplist(must_eval_args(Eq,_,Depth,Self),More,Adjusted), - eval_70(Eq,RetType,Depth,Self,[AE|Adjusted],Res), - check_returnval(Eq,RetType,Res). - - -must_eval_args(Eq,RetType,Depth,Self,More,Adjusted):- - (eval_args(Eq,RetType,Depth,Self,More,Adjusted)*->true; - (with_debug(eval,eval_args(Eq,RetType,Depth,Self,More,Adjusted))*-> true; - ( - nl,writeq(eval_args(Eq,RetType,Depth,Self,More,Adjusted)),writeln('.'), - (More=Adjusted -> true ; - (trace, throw(must_eval_args(Eq,RetType,Depth,Self,More,Adjusted))))))). - - - -eval_70(Eq,RetType,Depth,Self,PredDecl,Res):- - Do_more_defs = do_more_defs(true), - clause(eval_80(Eq,RetType,Depth,Self,PredDecl,Res),Body), - Do_more_defs == do_more_defs(true), - call_ndet(Body,DET), - nb_setarg(1,Do_more_defs,false), - (DET==true -> ! ; true). - -% ================================================================= -% ================================================================= -% ================================================================= -% inherited by system -% ================================================================= -% ================================================================= -% ================================================================= -is_system_pred(S):- atom(S),atom_concat(_,'!',S). -is_system_pred(S):- atom(S),atom_concat(_,'-fn',S). -is_system_pred(S):- atom(S),atom_concat(_,'-p',S). - -% eval_80/6: Evaluates a Python function call within MeTTa. -% Parameters: -% - Eq: denotes get-type, match, or interpret call. -% - RetType: Expected return type of the MeTTa function. -% - Depth: Recursion depth or complexity control. -% - Self: Context or environment for the evaluation. -% - [MyFun|More]: List with MeTTa function and additional arguments. -% - RetVal: Variable to store the result of the Python function call. -eval_80(Eq, RetType, Depth, Self, [MyFun|More], RetVal) :- - % MyFun as a registered Python function with its module and function name. - metta_atom(Self, ['registered-python-function', PyModule, PyFun, MyFun]), - % Tries to fetch the type definition for MyFun, ignoring failures. - (( get_operator_typedef(Self, MyFun, Params, RetType), - try_adjust_arg_types(RetType, Depth, Self, [RetType|Params], [RetVal|More], [MVal|Adjusted]) - )->true; (maplist(as_prolog, More , Adjusted), MVal=RetVal)), - % Constructs a compound term for the Python function call with adjusted arguments. - compound_name_arguments(Call, PyFun, Adjusted), - % Optionally prints a debug tree of the Python call if tracing is enabled. - if_trace(host;python, print_tree(py_call(PyModule:Call, RetVal))), - % Executes the Python function call and captures the result in MVal which propagates to RetVal. - py_call(PyModule:Call, MVal), - % Checks the return value against the expected type and criteria. - check_returnval(Eq, RetType, RetVal). - - - -%eval_80(_Eq,_RetType,_Dpth,_Slf,LESS,Res):- fake_notrace((once((eval_selfless(LESS,Res),fake_notrace(LESS\==Res))))),!. - -% predicate inherited by system -eval_80(Eq,RetType,_Depth,_Self,[AE|More],TF):- - once((is_system_pred(AE), - length(More,Len), - is_syspred(AE,Len,Pred))), - \+ (atom(AE), atom_concat(_,'-fn',AE)), - current_predicate(Pred/Len), - %fake_notrace( \+ is_user_defined_goal(Self,[AE|More])),!, - %adjust_args(Depth,Self,AE,More,Adjusted), - maplist(as_prolog, More , Adjusted), - if_trace(host;prolog,print_tree(apply(Pred,Adjusted))), - catch_warn(efbug(show_call,eval_call(apply(Pred,Adjusted),TF))), - check_returnval(Eq,RetType,TF). - -show_ndet(G):- call(G). -%show_ndet(G):- call_ndet(G,DET),(DET==true -> ! ; fbug(show_ndet(G))). - -:- if( \+ current_predicate( adjust_args / 2 )). - - :- discontiguous eval_80/6. - -is_user_defined_goal(Self,Head):- - is_user_defined_head(Self,Head). - -:- endif. - -adjust_args_mp(_Eq,_RetType,Res,Res,_Depth,_Self,_Pred,_Len,_AE,Args,Adjusted):- Args==[],!,Adjusted=Args. -adjust_args_mp(Eq,RetType,Res,NewRes,Depth,Self,Pred,Len,AE,Args,Adjusted):- - functor(P,Pred,Len), predicate_property(P,meta_predicate(Needs)), - account_needs(1,Needs,Args,More),!, - adjust_args(Eq,RetType,Res,NewRes,Depth,Self,AE,More,Adjusted). -adjust_args_mp(Eq,RetType,Res,NewRes,Depth,Self,_Pred,_Len,AE,Args,Adjusted):- - adjust_args(Eq,RetType,Res,NewRes,Depth,Self,AE,Args,Adjusted). - -acct(0,A,call(eval(A,_))). -acct(':',A,call(eval(A,_))). -acct(_,A,A). -account_needs(_,_,[],[]). -account_needs(N,Needs,[A|Args],[M|More]):- arg(N,Needs,What),!, - acct(What,A,M),plus(1,N,NP1), - account_needs(NP1,Needs,Args,More). - -:- nodebug(metta(call)). - -s2ps(S,P):- S=='Nil',!,P=[]. -s2ps(S,P):- \+ is_list(S),!,P=S. -s2ps([F|S],P):- atom(F),maplist(s2ps,S,SS),join_s2ps(F,SS,P),!. -s2ps(S,S):-!. -join_s2ps('Cons',[H,T],[H|T]):-!. -join_s2ps(F,Args,P):-atom(F),P=..[F|Args]. - -eval_call(S,TF):- - s2ps(S,P), !, - fbug(eval_call(P,'$VAR'('TF'))),as_tf(P,TF). - -eval_80(Eq,RetType,_Depth,_Self,[AE|More],Res):- - is_system_pred(AE), - length([AE|More],Len), - is_syspred(AE,Len,Pred), - \+ (atom(AE), atom_concat(_,'-p',AE)), - %fake_notrace( \+ is_user_defined_goal(Self,[AE|More])),!, - %adjust_args(Depth,Self,AE,More,Adjusted),!, - Len1 is Len+1, - current_predicate(Pred/Len1), - maplist(as_prolog,More,Adjusted), - append(Adjusted,[Res],Args),!, - if_trace(host;prolog,print_tree(apply(Pred,Args))), - efbug(show_call,catch_warn(apply(Pred,Args))), - check_returnval(Eq,RetType,Res). - -:- if( \+ current_predicate( check_returnval / 3 )). -check_returnval(_,_RetType,_TF). -:- endif. - -:- if( \+ current_predicate( adjust_args / 5 )). -adjust_args(_Depth,_Self,_V,VI,VI). -:- endif. - -% user defined function -%eval_40(Eq,RetType,Depth,Self,[H|PredDecl],Res):- - % fake_notrace(is_user_defined_head(Self,H)),!, - % eval_defn(Eq,RetType,Depth,Self,[H|PredDecl],Res). - -eval_80(Eq,RetType,Depth,Self,PredDecl,Res):- - eval_defn(Eq,RetType,Depth,Self,PredDecl,Res). - - -last_element(T,E):- \+ compound(T),!,E=T. -last_element(T,E):- is_list(T),last(T,L),last_element(L,E),!. -last_element(T,E):- compound_name_arguments(T,_,List),last_element(List,E),!. - - - - -catch_warn(G):- quietly(catch_err(G,E,(fbug(catch_warn(G)-->E),fail))). -catch_nowarn(G):- quietly(catch_err(G,error(_,_),fail)). - - -% less Macro-ey Functions - - -as_tf(G,TF):- G\=[_|_], catch_nowarn((call(G)*->TF='True';TF='False')). -%eval_selfless_1(['==',X,Y],TF):- as_tf(X=:=Y,TF),!. -%eval_selfless_1(['==',X,Y],TF):- as_tf(X=@=Y,TF),!. - -is_assignment(V):- \+ atom(V),!, fail. -is_assignment('is'). is_assignment('is!'). -is_assignment('='). is_assignment('=='). -is_assignment('=:='). is_assignment(':='). - -eval_selfless(E,R):- eval_selfless_0(E,R). - -eval_selfless_0([F,X,XY],TF):- is_assignment(F), fake_notrace(args_to_mathlib([X,XY],Lib)),!,eval_selfless3(Lib,['=',X,XY],TF). -eval_selfless_0([F|XY],TF):- eval_selfless_1([F|XY],TF),!. -eval_selfless_0(E,R):- eval_selfless_2(E,R). - -eval_selfless_1([F|XY],TF):- \+ ground(XY),!,fake_notrace(args_to_mathlib(XY,Lib)),!,eval_selfless3(Lib,[F|XY],TF). -eval_selfless_1(['>',X,Y],TF):-!,as_tf(X>Y,TF). -eval_selfless_1(['<',X,Y],TF):-!,as_tf(X',X,Y],TF):-!,as_tf(X>=Y,TF). -eval_selfless_1(['<=',X,Y],TF):-!,as_tf(X=',X,Y],TF):-!,as_tf(X#>Y,TF). -compare_selfless0(cplfd,['<',X,Y],TF):-!,as_tf(X#',X,Y],TF):-!,as_tf(X#>=Y,TF). -compare_selfless0(cplfd,['<=',X,Y],TF):-!,as_tf(X#=',X,Y],TF):-!,as_tf(Lib:{X>Y},TF). -compare_selfless0(Lib,['<',X,Y],TF):-!,as_tf(Lib:{X',X,Y],TF):-!,as_tf(Lib:{X>=Y},TF). -compare_selfless0(Lib,['<=',X,Y],TF):-!,as_tf(Lib:{X=!;true). - -/* -eval_defn(Eq,_RetT,Depth,Self,[H|Args0],B):- - \+ get_operator_typedef1(Self,H,_ParamTypes,_RType),!, - maplist(eval_99(Eq,_,Depth,Self),Args0,Args), - eval_65(Eq,RetType,Depth,Self,[H|Args],B),!. -*/ -/* -eval_defn(Eq,_RetT,Depth,Self,[H|Args0],B):- symbol(H), - \+ fake_notrace((is_user_defined_head_f(Self,H))), - \+ get_operator_typedef1(Self,H,_ParamTypes,_RType),!, - maplist(eval_99(Eq,_,Depth,Self),Args0,Args), - eval_65(Eq,RetType,Depth,Self,[H|Args],B),!. -*/ -/* -eval_defn(Eq,RetType,Depth,Self,H,B):- - (eval_64(Eq,RetType,Depth,Self,H,B)*->true; - (fail,eval_67(Eq,RetType,Depth,Self,H,B))). -*/ -eval_defn(Eq,RetType,Depth,Self,X,Y):- - notrace(flag(eval_num,EX0,EX0+1)), - trace_eval(eval_61(Eq,RetType),metta_defn,Depth,Self,X,Y). - - -eval_61(Eq,RetType,Depth,Self,X,Y):- - if_or_else(eval_64(Eq,RetType,Depth,Self,X,Y), - eval_64_curried(Eq,RetType,Depth,Self,X,Y)). - -%eval_64(Eq,_RetType,_Dpth,Self,H,B):- Eq='=',!, metta_defn(Eq,Self,H,B). -eval_64(Eq,_RetType,_Dpth,Self,H,B):- - Eq=='match',!,call(metta_atom(Self,H)),B=H. - -% eval_64(Eq,RetType,Depth,Self,X,Y):- eval_64_curried(Eq,RetType,Depth,Self,X,Y). - -eval_64(Eq,_RetType,Depth,Self,[H|Args],B):- % no weird template matchers - % forall(metta_defn(Eq,Self,[H|Template],_), - % maplist(not_template_arg,Template)), - Eq='=', - (metta_defn(Eq,Self,[H|Args],B0)*->true;(fail,[H|Args]=B0)), - light_eval(Depth,Self,B0,B). - %(eval(Eq,RetType,Depth,Self,B,Y);metta_atom_iter(Depth,Self,Y)). -% Use the first template match -eval_65(Eq,_RetType,Depth,Self,[H|Args],B):- - Eq='=', - (metta_defn(Eq,Self,[H|Template],B0),Args=Template), - light_eval(Depth,Self,B0,B). - - - -eval_64_curried(Eq,RetType,Depth,Self,[[H|Start]|T1],Y):- - fake_notrace((is_user_defined_head_f(Self,H),is_list(Start))), - metta_defn(Eq,Self,[H|Start],Left), - [Left|T1] \=@= [[H|Start]|T1], - eval(Eq,RetType,Depth,Self,[Left|T1],Y). - - -light_eval(_Depth,_Self,B,B). - -not_template_arg(TArg):- var(TArg), !, \+ attvar(TArg). -not_template_arg(TArg):- atomic(TArg),!. -%not_template_arg(TArg):- is_list(TArg),!,fail. - - -% Has argument that is headed by the same function -eval_67(Eq,RetType,Depth,Self,[H1|Args],Res):- - fake_notrace((append(Left,[[H2|H2Args]|Rest],Args), H2==H1)),!, - eval(Eq,RetType,Depth,Self,[H2|H2Args],ArgRes), - fake_notrace((ArgRes\==[H2|H2Args], append(Left,[ArgRes|Rest],NewArgs))), - eval_defn(Eq,RetType,Depth,Self,[H1|NewArgs],Res). - -eval_67(Eq,RetType,Depth,Self,[[H|Start]|T1],Y):- - fake_notrace((is_user_defined_head_f(Self,H),is_list(Start))), - metta_defn(Eq,Self,[H|Start],Left), - eval(Eq,RetType,Depth,Self,[Left|T1],Y). - -% Has subterm to eval -eval_67(Eq,RetType,Depth,Self,[F|PredDecl],Res):- fail, - Depth>1, - quietly(sub_sterm1(SSub,PredDecl)), - fake_notrace((ground(SSub),SSub=[_|Sub], is_list(Sub),maplist(atomic,SSub))), - eval(Eq,RetType,Depth,Self,SSub,Repl), - fake_notrace((SSub\=Repl,subst(PredDecl,SSub,Repl,Temp))), - eval_defn(Eq,RetType,Depth,Self,[F|Temp],Res). - - - -% ================================================================= -% ================================================================= -% ================================================================= -% AGREGATES -% ================================================================= -% ================================================================= -% ================================================================= - -cwdl(DL,Goal):- call_with_depth_limit(Goal,DL,R), (R==depth_limit_exceeded->(!,fail);true). - -cwtl(DL,Goal):- catch(call_with_time_limit(DL,Goal),time_limit_exceeded(_),fail). - -%bagof_eval(Eq,RetType,Depth,Self,X,L):- bagof_eval(Eq,RetType,_RT,Depth,Self,X,L). - - -%bagof_eval(Eq,RetType,Depth,Self,X,S):- bagof(E,eval_ne(Eq,RetType,Depth,Self,X,E),S)*->true;S=[]. -bagof_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- typed_list(X,_Type,L),!. -bagof_eval(Eq,RetType,Depth,Self,X,L):- - findall(E,eval_ne(Eq,RetType,Depth,Self,X,E),L). - -setof_eval(Depth,Self,X,L):- setof_eval('=',_RT,Depth,Self,X,L). -setof_eval(Eq,RetType,Depth,Self,X,S):- bagof_eval(Eq,RetType,Depth,Self,X,L), - sort(L,S). - - -eval_ne(Eq,RetType,Depth,Self,X,E):- - eval(Eq,RetType,Depth,Self,X,E), \+ var(E), \+ is_empty(E). - - -:- ensure_loaded(metta_subst). - -solve_quadratic(A, B, I, J, K) :- - %X in -1000..1000, % Define a domain for X - (X + A) * (X + B) #= I*X*X + J*X + K. % Define the quadratic equation - %label([X]). % Find solutions for X diff --git a/.Attic/metta_lang/metta_eval.prev b/.Attic/metta_lang/metta_eval.prev deleted file mode 100755 index a4a947e568d..00000000000 --- a/.Attic/metta_lang/metta_eval.prev +++ /dev/null @@ -1,1549 +0,0 @@ -% -% post match modew -%:- style_check(-singleton). - -self_eval0(X):- \+ callable(X),!. -self_eval0(X):- is_valid_nb_state(X),!. -%self_eval0(X):- string(X),!. -%self_eval0(X):- number(X),!. -%self_eval0([]). -self_eval0(X):- is_metta_declaration(X),!. -self_eval0(X):- is_list(X),!,fail. -self_eval0(X):- typed_list(X,_,_),!. -%self_eval0(X):- compound(X),!. -%self_eval0(X):- is_ref(X),!,fail. -self_eval0('True'). self_eval0('False'). % self_eval0('F'). -self_eval0('Empty'). -self_eval0(X):- atom(X),!, \+ nb_current(X,_),!. - -self_eval(X):- notrace(self_eval0(X)). - -:- set_prolog_flag(access_level,system). -hyde(F/A):- functor(P,F,A), redefine_system_predicate(P),'$hide'(F/A), '$iso'(F/A). -:- 'hyde'(option_else/2). -:- 'hyde'(atom/1). -:- 'hyde'(quietly/1). -:- 'hyde'(notrace/1). -:- 'hyde'(var/1). -:- 'hyde'(is_list/1). -:- 'hyde'(copy_term/2). -:- 'hyde'(nonvar/1). -:- 'hyde'(quietly/1). -%:- 'hyde'(option_value/2). - - -is_metta_declaration([F|_]):- F == '->',!. -is_metta_declaration([F,_,_|T]):- T ==[], is_metta_declaration_f(F). - -is_metta_declaration_f(F):- F == ':', !. -is_metta_declaration_f(F):- F == '=', !, - \+ (current_self(Space), is_user_defined_head_f(Space,F)). - -(F==':'; - (F=='=', \+ - \+ (current_self(Space), is_user_defined_head_f(Space,F)))). -% is_metta_declaration([F|T]):- is_list(T), is_user_defined_head([F]),!. - -:- nb_setval(self_space, '&self'). -evals_to(XX,Y):- Y=@=XX,!. -evals_to(XX,Y):- Y=='True',!, is_True(XX),!. - -current_self(Space):- nb_current(self_space,Space). - -do_expander('=',_,X,X):-!. -do_expander(':',_,X,Y):- !, get_type(X,Y)*->X=Y. - -'get_type'(Arg,Type):- 'get-type'(Arg,Type). - - - - -eval_args(X,Y):- current_self(Space), - rtrace_on_existence_error(eval(100,Space,X,Y)). -eval_args(Depth,Self,X,Y):- locally(set_prolog_flag(gc,false),rtrace_on_existence_error(eval(Depth,Self,X,Y))). -eval_args(Eq,RetType,Depth,Self,X,Y):- - locally(set_prolog_flag(gc,true), - rtrace_on_existence_error( - eval(Eq,RetType,Depth,Self,X,Y))). - -%eval(Eq,RetType,Depth,_Self,X,_Y):- forall(between(6,Depth,_),write(' ')),writeqln(eval(Eq,RetType,X)),fail. -eval(Depth,Self,X,Y):- eval('=',_RetType,Depth,Self,X,Y). - -%eval(Eq,RetType,_Dpth,_Slf,X,Y):- nonvar(Y),X=Y,!. - -eval(Eq,RetType,Depth,Self,X,Y):- nonvar(Y),!, - get_type(Depth,Self,Y,RetType), !, - eval(Eq,RetType,Depth,Self,X,XX),evals_to(XX,Y). - -eval(_Eq,_RetType,_Dpth,_Slf,X,Y):- var(X),!,Y=X. - -eval(Eq,RetType,_Dpth,_Slf,[X|T],Y):- T==[], number(X),!, do_expander(Eq,RetType,X,YY),Y=[YY]. - -/* -eval(Eq,RetType,Depth,Self,[F|X],Y):- - (F=='superpose' ; ( option_value(no_repeats,false))), - notrace((D1 is Depth-1)),!, - eval_11(Eq,RetType,D1,Self,[F|X],Y). -*/ - -eval(Eq,RetType,Depth,Self,X,Y):- atom(Eq), ( Eq \== ('=')) ,!, - call(Eq,'=',RetType,Depth,Self,X,Y). - -eval(Eq,RetType,Depth,Self,X,Y):- - %notrace(allow_repeats_eval_(X)), - !, - eval_11(Eq,RetType,Depth,Self,X,Y). -eval(Eq,RetType,Depth,Self,X,Y):- - nop(notrace((no_repeats_var(YY)), - D1 is Depth-1)),!, - eval_11(Eq,RetType,D1,Self,X,Y), - notrace(( \+ (Y\=YY))). - -allow_repeats_eval_(_):- !. -allow_repeats_eval_(_):- option_value(no_repeats,false),!. -allow_repeats_eval_(X):- \+ is_list(X),!,fail. -allow_repeats_eval_([F|_]):- atom(F),allow_repeats_eval_f(F). -allow_repeats_eval_f('superpose'). -allow_repeats_eval_f('collapse'). - -debugging_metta(G):- notrace((is_debugging((eval))->ignore(G);true)). - - -:- nodebug(metta(eval)). - - -w_indent(Depth,Goal):- - \+ \+ mnotrace(ignore((( - format('~N'), - setup_call_cleanup(forall(between(Depth,101,_),write(' ')),Goal, format('~N')))))). -indentq(Depth,Term):- - \+ \+ mnotrace(ignore((( - format('~N'), - setup_call_cleanup(forall(between(Depth,101,_),write(' ')),format('~q',[Term]), - format('~N')))))). - - -with_debug(Flag,Goal):- is_debugging(Flag),!, call(Goal). -with_debug(Flag,Goal):- flag(eval_num,_,0), - setup_call_cleanup(set_debug(Flag,true),call(Goal),set_debug(Flag,false)). - -flag_to_var(Flag,Var):- atom(Flag), \+ atom_concat('trace-on-',_,Flag),!,atom_concat('trace-on-',Flag,Var). -flag_to_var(metta(Flag),Var):- !, nonvar(Flag), flag_to_var(Flag,Var). -flag_to_var(Flag,Var):- Flag=Var. - -set_debug(Flag,Val):- \+ atom(Flag), flag_to_var(Flag,Var), atom(Var),!,set_debug(Var,Val). -set_debug(Flag,true):- !, debug(metta(Flag)),flag_to_var(Flag,Var),set_option_value(Var,true). -set_debug(Flag,false):- nodebug(metta(Flag)),flag_to_var(Flag,Var),set_option_value(Var,false). -if_trace((Flag;true),Goal):- !, notrace(( catch_err(ignore((Goal)),E,wdmsg(E-->if_trace((Flag;true),Goal))))). -if_trace(Flag,Goal):- notrace((catch_err(ignore((is_debugging(Flag),Goal)),E,wdmsg(E-->if_trace(Flag,Goal))))). - - -%maybe_efbug(SS,G):- efbug(SS,G)*-> if_trace(eval,wdmsg(SS=G)) ; fail. -maybe_efbug(_,G):- call(G). -%efbug(P1,G):- call(P1,G). -efbug(_,G):- call(G). - - - -is_debugging(Flag):- var(Flag),!,fail. -is_debugging((A;B)):- !, (is_debugging(A) ; is_debugging(B) ). -is_debugging((A,B)):- !, (is_debugging(A) , is_debugging(B) ). -is_debugging(not(Flag)):- !, \+ is_debugging(Flag). -is_debugging(Flag):- Flag== false,!,fail. -is_debugging(Flag):- Flag== true,!. -is_debugging(Flag):- debugging(metta(Flag),TF),!,TF==true. -is_debugging(Flag):- debugging(Flag,TF),!,TF==true. -is_debugging(Flag):- flag_to_var(Flag,Var), - (option_value(Var,true)->true;(Flag\==Var -> is_debugging(Var))). - -:- nodebug(metta(overflow)). - - -eval_99(Eq,RetType,Depth,Self,X,Y):- - eval_20(Eq,RetType,Depth,Self,X,Y)*->true;eval_failed(Depth,Self,X,Y). - - - -eval_00(_Eq,_RetType,Depth,_Slf,X,Y):- Depth<1,!,X=Y, (\+ trace_on_overflow-> true; flag(eval_num,_,0),debug(metta(eval))). -eval_00(_Eq,_RetType,_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. -eval_00(Eq,RetType,Depth,Self,X,YO):- - Depth2 is Depth-1, - copy_term(X, XX), - eval_20(Eq,RetType,Depth,Self,X,M), - ((M\=@=XX, \+ self_eval(M))-> - eval_00(Eq,RetType,Depth2,Self,M,Y);Y=M), - once(if_or_else(subst_args(Eq,RetType,Depth2,Self,Y,YO), - if_or_else(finish_eval(Depth2,Self,Y,YO), - Y=YO))). - - - -eval_11(_Eq,_RetType,_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. -eval_11(Eq,RetType,Depth,Self,X,Y):- \+ is_debugging((eval)),!, - D1 is Depth-1, - eval_00(Eq,RetType,D1,Self,X,Y). -eval_11(Eq,RetType,Depth,Self,X,Y):- - notrace(( - - flag(eval_num,EX,EX+1), - D1 is Depth-1, - DR is 99-D1, - PrintRet = _, - option_else('trace-length',Max,100), - if_t((EX>Max), (set_debug(eval,false),MaxP1 is Max+1, set_debug(overflow,false), - format('; Switched off tracing. For a longer trace: !(pragma! trace-length ~w)',[MaxP1]))), - nop(notrace(no_repeats_var(YY))), - - if_t(DR<10,if_trace((eval),(PrintRet=1, indentq(Depth,'-->'(EX,eval(Self,X,'$VAR'('RET')),depth(DR)))))), - Ret=retval(fail))), - - call_cleanup(( - dcall(eval_00(Eq,RetType,D1,Self,X,Y)), - notrace(( \+ (Y\=YY), nb_setarg(1,Ret,Y)))), - - (PrintRet==1 -> indentq(Depth,'<--'(EX,Ret)) ; - mnotrace(ignore(((Y\=@=X, - if_t(DR<10,if_trace((eval),indentq(Depth,'<--'(EX,Ret)))))))))), - - (Ret\=@=retval(fail)->true;(rtrace(eval_00(Eq,RetType,D1,Self,X,Y)),fail)). - - - -eval_15(Eq,RetType,Depth,Self,X,Y):- !, - eval_20(Eq,RetType,Depth,Self,X,Y). - -eval_15(Eq,RetType,Depth,Self,X,Y):- - ((eval_20(Eq,RetType,Depth,Self,X,Y), - if_t(var(Y),dmsg((eval_20(Eq,RetType,Depth,Self,X,Y),var(Y)))), - nonvar(Y))*->true;(eval_failed(Depth,Self,X,Y),fail)). - - - - - - - - - - - - - -:- discontiguous eval_20/6. -:- discontiguous eval_40/6. -%:- discontiguous eval_30fz/5. -%:- discontiguous eval_31/5. -%:- discontiguous eval_defn/5. - -eval_20(Eq,RetType,_Dpth,_Slf,Name,Y):- - atom(Name), !, - (nb_current(Name,X)->do_expander(Eq,RetType,X,Y); - Y = Name). - - -eval_20(Eq,RetType,_Dpth,_Slf,X,Y):- self_eval(X),!,do_expander(Eq,RetType,X,Y). - -% ================================================================= -% ================================================================= -% ================================================================= -% VAR HEADS/ NON-LISTS -% ================================================================= -% ================================================================= -% ================================================================= - -eval_20(Eq,RetType,_Dpth,_Slf,[X|T],Y):- T==[], \+ callable(X),!, do_expander(Eq,RetType,X,YY),Y=[YY]. -%eval_20(Eq,RetType,_Dpth,Self,[X|T],Y):- T==[], atom(X), -% \+ is_user_defined_head_f(Self,X), -% do_expander(Eq,RetType,X,YY),!,Y=[YY]. - -eval_20(Eq,RetType,Depth,Self,X,Y):- atom(Eq), ( Eq \== ('=')) ,!, - call(Eq,'=',RetType,Depth,Self,X,Y). - - -eval_20(Eq,RetType,Depth,Self,[V|VI],VVO):- \+ is_list(VI),!, - eval(Eq,RetType,Depth,Self,VI,VM), - ( VM\==VI -> eval(Eq,RetType,Depth,Self,[V|VM],VVO) ; - (eval(Eq,RetType,Depth,Self,V,VV), (V\==VV -> eval(Eq,RetType,Depth,Self,[VV|VI],VVO) ; VVO = [V|VI]))). - -eval_20(Eq,RetType,_Dpth,_Slf,X,Y):- \+ is_list(X),!,do_expander(Eq,RetType,X,Y). - -eval_20(Eq,_RetType,Depth,Self,[V|VI],[V|VO]):- var(V),is_list(VI),!,maplist(eval(Eq,_ArgRetType,Depth,Self),VI,VO). - - -% ================================================================= -% ================================================================= -% ================================================================= -% TRACE/PRINT -% ================================================================= -% ================================================================= -% ================================================================= - -eval_20(Eq,RetType,_Dpth,_Slf,['repl!'],Y):- !, repl,check_returnval(Eq,RetType,Y). -eval_20(Eq,RetType,Depth,Self,['!',Cond],Res):- !, call(eval(Eq,RetType,Depth,Self,Cond,Res)). -eval_20(Eq,RetType,Depth,Self,['rtrace!',Cond],Res):- !, rtrace(eval(Eq,RetType,Depth,Self,Cond,Res)). -eval_20(Eq,RetType,Depth,Self,['trace',Cond],Res):- !, with_debug(eval,eval(Eq,RetType,Depth,Self,Cond,Res)). -eval_20(Eq,RetType,Depth,Self,['time',Cond],Res):- !, time_eval(eval(Cond),eval(Eq,RetType,Depth,Self,Cond,Res)). -eval_20(Eq,RetType,Depth,Self,['print',Cond],Res):- !, eval(Eq,RetType,Depth,Self,Cond,Res),format('~N'),print(Res),format('~N'). -% !(println! $1) -eval_20(Eq,RetType,Depth,Self,['println!'|Cond],Res):- !, maplist(eval(Eq,RetType,Depth,Self),Cond,[Res|Out]), - format('~N'),maplist(write_src,[Res|Out]),format('~N'). -eval_20(Eq,RetType,Depth,Self,['trace!',A|Cond],Res):- !, maplist(eval(Eq,RetType,Depth,Self),[A|Cond],[AA|Result]), - last(Result,Res), format('~N'),maplist(write_src,[AA]),format('~N'). - -%eval_20(Eq,RetType,Depth,Self,['trace!',A,B],C):- !,eval(Eq,RetType,Depth,Self,B,C),format('~N'),wdmsg(['trace!',A,B]=C),format('~N'). -%eval_20(Eq,RetType,_Dpth,_Slf,['trace!',A],A):- !, format('~N'),wdmsg(A),format('~N'). - -eval_20(Eq,RetType,_Dpth,_Slf,List,YY):- is_list(List),maplist(self_eval,List),List=[H|_], \+ atom(H), !,Y=List,do_expander(Eq,RetType,Y,YY). - -eval_20(Eq,_ListOfRetType,Depth,Self,['TupleConcat',A,B],OO):- fail, !, - eval(Eq,RetType,Depth,Self,A,AA), - eval(Eq,RetType,Depth,Self,B,BB), - append(AA,BB,OO). -eval_20(Eq,OuterRetType,Depth,Self,['range',A,B],OO):- (is_list(A);is_list(B)), - ((eval(Eq,RetType,Depth,Self,A,AA), - eval(Eq,RetType,Depth,Self,B,BB))), - ((AA+BB)\=@=(A+B)), - eval_20(Eq,OuterRetType,Depth,Self,['range',AA,BB],OO),!. - - -%eval_20(Eq,RetType,Depth,Self,['colapse'|List], Flat):- !, maplist(eval(Eq,RetType,Depth,Self),List,Res),flatten(Res,Flat). - - - - -% ================================================================= -% ================================================================= -% ================================================================= -% UNIT TESTING/assert -% ================================================================= -% ================================================================= -% ================================================================= - - -eval_20(Eq,RetType,Depth,Self,['assertTrue', X],TF):- !, eval(Eq,RetType,Depth,Self,['assertEqual',X,'True'],TF). -eval_20(Eq,RetType,Depth,Self,['assertFalse',X],TF):- !, eval(Eq,RetType,Depth,Self,['assertEqual',X,'False'],TF). - -eval_20(Eq,RetType,Depth,Self,['assertEqual',X,Y],RetVal):- !, - loonit_assert_source_tf( - ['assertEqual',X,Y], - (bagof_eval(Eq,RetType,Depth,Self,X,XX), bagof_eval(Eq,RetType,Depth,Self,Y,YY)), - equal_enough_for_test(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got,XX,[expected(_)],YY]). - -eval_20(Eq,RetType,Depth,Self,['assertNotEqual',X,Y],RetVal):- !, - loonit_assert_source_tf( - ['assertEqual',X,Y], - (bagof_eval(Eq,RetType,Depth,Self,X,XX), bagof_eval(Eq,RetType,Depth,Self,Y,YY)), - \+ equal_enough(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got,XX,expected,YY]). - -eval_20(Eq,RetType,Depth,Self,['assertEqualToResult',X,Y],RetVal):- !, - loonit_assert_source_tf( - ['assertEqualToResult',X,Y], - (bagof_eval(Eq,RetType,Depth,Self,X,XX), sort(Y,YY)), - equal_enough_for_test(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got,XX,expected,YY]). - - -loonit_assert_source_tf(Src,Goal,Check,TF):- - copy_term(Goal,OrigGoal), - loonit_asserts(Src, time_eval('\n; EVAL TEST\n;',Goal), Check), - as_tf(Check,TF),!, - ignore(( - once((TF='True', trace_on_pass);(TF='False', trace_on_fail)), - with_debug(metta(eval),time_eval('Trace',OrigGoal)))). - -sort_result(Res,Res):- \+ compound(Res),!. -sort_result([And|Res1],Res):- is_and(And),!,sort_result(Res1,Res). -sort_result([T,And|Res1],Res):- is_and(And),!,sort_result([T|Res1],Res). -sort_result([H|T],[HH|TT]):- !, sort_result(H,HH),sort_result(T,TT). -sort_result(Res,Res). - -unify_enough(L,L). -%unify_enough(L,C):- is_list(L),into_list_args(C,CC),!,unify_lists(CC,L). -%unify_enough(C,L):- is_list(L),into_list_args(C,CC),!,unify_lists(CC,L). -%unify_enough(C,L):- \+ compound(C),!,L=C. -%unify_enough(L,C):- \+ compound(C),!,L=C. -unify_enough(L,C):- into_list_args(L,LL),into_list_args(C,CC),unify_lists(CC,LL). - -%unify_lists(C,L):- \+ compound(C),!,L=C. -%unify_lists(L,C):- \+ compound(C),!,L=C. -unify_lists(L,L):-!. -unify_lists([C|CC],[L|LL]):- unify_enough(L,C),!,unify_lists(CC,LL). - -equal_enough(R,V):- is_list(R),is_list(V),sort(R,RR),sort(V,VV),!,equal_enouf(RR,VV),!. -equal_enough(R,V):- copy_term(R,RR),copy_term(V,VV),equal_enouf(R,V),!,R=@=RR,V=@=VV. - -%s_empty(X):- var(X),!. -s_empty(X):- var(X),!,fail. -is_empty('Empty'). -is_empty([]). -is_empty([X]):-!,is_empty(X). -has_let_star(Y):- sub_var('let*',Y). - -equal_enough_for_test(X,Y):- is_empty(X),!,is_empty(Y). -equal_enough_for_test(X,Y):- has_let_star(Y),!,\+ is_empty(X). -equal_enough_for_test(X,Y):- must_det_ll((subst_vars(X,XX),subst_vars(Y,YY))),!,equal_enough_for_test2(XX,YY),!. -equal_enough_for_test2(X,Y):- equal_enough(X,Y). - -equal_enouf(R,V):- is_ftVar(R), is_ftVar(V), R=V,!. -equal_enouf(X,Y):- is_empty(X),!,is_empty(Y). -equal_enouf(R,V):- R=@=V, R=V, !. -equal_enouf(_,V):- V=@='...',!. -equal_enouf(L,C):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). -equal_enouf(C,L):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). -%equal_enouf(R,V):- (var(R),var(V)),!, R=V. -equal_enouf(R,V):- (var(R);var(V)),!, R==V. -equal_enouf(R,V):- number(R),number(V),!, RV is abs(R-V), RV < 0.03 . -equal_enouf(R,V):- atom(R),!,atom(V), has_unicode(R),has_unicode(V). -equal_enouf(R,V):- (\+ compound(R) ; \+ compound(V)),!, R==V. -equal_enouf(L,C):- into_list_args(L,LL),into_list_args(C,CC),!,equal_enouf_l(CC,LL). - -equal_enouf_l([S1,V1|_],[S2,V2|_]):- S1 == 'State',S2 == 'State',!, equal_enouf(V1,V2). -equal_enouf_l(C,L):- \+ compound(C),!,L=@=C. -equal_enouf_l(L,C):- \+ compound(C),!,L=@=C. -equal_enouf_l([C|CC],[L|LL]):- !, equal_enouf(L,C),!,equal_enouf_l(CC,LL). - - -has_unicode(A):- atom_codes(A,Cs),member(N,Cs),N>127,!. - -set_last_error(_). - -% ================================================================= -% ================================================================= -% ================================================================= -% SPACE EDITING -% ================================================================= -% ================================================================= -% ================================================================= -% do_metta(_Who,What,Where,PredDecl,_TF):- do_metta(Where,What, PredDecl). -/* -eval_20(Eq,RetType,_Dpth,Self,['add-atom',Other,PredDecl],TF):- !, into_space(Self,Other,Space), as_tf(do_metta(Space,load,PredDecl),TF). -eval_20(Eq,RetType,_Dpth,Self,['remove-atom',Other,PredDecl],TF):- !, into_space(Self,Other,Space), as_tf(do_metta(Space,unload,PredDecl),TF). -eval_20(Eq,RetType,_Dpth,Self,['atom-count',Other],Count):- !, into_space(Self,Other,Space), findall(_,metta_defn(Eq,Other,_,_),L1),length(L1,C1),findall(_,get_metta_atom(Eq,Space,_),L2),length(L2,C2),Count is C1+C2. -eval_20(Eq,RetType,_Dpth,Self,['atom-replace',Other,Rem,Add],TF):- !, into_space(Self,Other,Space), copy_term(Rem,RCopy), - as_tf((metta_atom_iter_ref(Space,RCopy,Ref), RCopy=@=Rem,erase(Ref), do_metta(Other,load,Add)),TF). -*/ -eval_20(Eq,RetType,Depth,Self,[Op,Space|Args],Res):- is_space_op(Op),!, - eval_space_start(Eq,RetType,Depth,Self,[Op,Space|Args],Res). - - -eval_space_start(Eq,RetType,_Depth,_Self,[_Op,_Other,Atom],Res):- - (Atom == [] ; Atom =='Empty'; Atom =='Nil'),!,return_empty('False',Res),check_returnval(Eq,RetType,Res). - -eval_space_start(Eq,RetType,Depth,Self,[Op,Other|Args],Res):- - into_space(Depth,Self,Other,Space), - eval_space(Eq,RetType,Depth,Self,[Op,Space|Args],Res). - - -eval_space(Eq,RetType,_Dpth,_Slf,['add-atom',Space,PredDecl],Res):- !, - do_metta(python,load,Space,PredDecl,TF),return_empty(TF,Res),check_returnval(Eq,RetType,Res). - -eval_space(Eq,RetType,_Dpth,_Slf,['remove-atom',Space,PredDecl],Res):- !, - do_metta(python,unload,Space,PredDecl,TF),return_empty(TF,Res),check_returnval(Eq,RetType,Res). - -eval_space(Eq,RetType,_Dpth,_Slf,['atom-count',Space],Count):- !, - ignore(RetType='Number'),ignore(Eq='='), - findall(Atom, get_metta_atom_from(Space, Atom),Atoms), - length(Atoms,Count). - -eval_space(Eq,RetType,_Dpth,_Slf,['atom-replace',Space,Rem,Add],TF):- !, - copy_term(Rem,RCopy), as_tf((metta_atom_iter_ref(Space,RCopy,Ref), RCopy=@=Rem,erase(Ref), do_metta(Space,load,Add)),TF), - check_returnval(Eq,RetType,TF). - -eval_space(Eq,RetType,_Dpth,_Slf,['get-atoms',Space],Atom):- !, - ignore(RetType='Atom'), get_metta_atom_from(Space, Atom), check_returnval(Eq,RetType,Atom). - -/* -get_atoms(_Dpth,_Slf,Other,Atom):- Other=='&self',!,get_metta_atom_from(Other, Atom). -% get_atoms_fail(Depth,Self,Other,Atom):- fail, is_asserted_space(Other),!, get_metta_atom(Eq,Other,Atom). -get_atoms(Depth,Self,Other,AtomO):- - into_space(Depth,Self,Other,Space), - once((space_to_Space(Depth,Self,Space,SpaceC), - into_listoid(SpaceC,AtomsL))), - %no_repeat_var(NRAtom), - dcall((member(Atom,AtomsL), - %Atom = NRAtom, - AtomO=Atom)). - -space_to_Space(_Dpth,_Slf,Space,SpaceC):- compound(Space),functor(Space,_,1),arg(1,Space,L),is_list(L),!,SpaceC=Space. -space_to_Space(_Dpth,_Slf,Space,SpaceC):- findall(Atom, get_metta_atom_from(Space, Atom),Atoms), - SpaceC = 'hyperon::space::DynSpace'(Atoms). -*/ - -%eval_space(Eq,RetType,Depth,Self,['match',Other,Goal,Template],Template):- into_space(Self,Other,Space),!, metta_atom_iter(Eq,Depth,Space,Goal). -%eval_space(Eq,RetType,Depth,Self,['match',Other,Goal,Template,Else],Template):- into_space(Self,Other,Space),!, (metta_atom_iter(Eq,Depth,Space,Goal)*->true;Else=Template). - -% Match-ELSE -eval_space(Eq,RetType,Depth,Self,['match',Other,Goal,Template,Else],Template):- !, - ((eval_space(Eq,RetType,Depth,Self,['match',Other,Goal,Template],Template), - \+ return_empty([],Template))*->true;Template=Else). -% Match-TEMPLATE - -eval_space(Eq,RetType,Depth,Self,['match',Other,Goal,Template],Res):- !, - metta_atom_iter(Eq,Depth,Self,Other,Goal), - Template=Res. - %finish_eval(Eq,RetType,Depth,Self,Template,Res). -/* - dcall(( % copy_term(Goal+Template,CGoal+CTemplate), - catch_err(try_match(Eq,RetType,Depth,Self,Other,Goal),E, - ((wdmsg(catch_err(try_match(Eq,RetType,Depth,Self,Other,Goal))=E)), - rtrace(try_match(Eq,RetType,Depth,Self,Other,Goal)))))), - %print(Template), - finish_eval(Eq,RetType,Depth,Self,Template,Res). - -try_match(Eq,RetType,Depth,Self,Space,Goal):- !, - % into_space(Depth,Self,Other,Space), - metta_atom_iter(Eq,Depth,Self,Space,Goal). - -%try_match(Depth,Self,Other,Goal,_Template):- get_atoms(Depth,Self,Other,Goal). % Template=Res. -metta_atom_iter(Eq,Depth,Other,Goal):- - current_self(Self), - metta_atom_iter(Eq,Depth,Self,Other,Goal). - -metta_atom_iter_fail(Depth,_Slf,Other,[Equal,[F|H],B]):- fail, '=' == Equal,!, % trace, - dcall(metta_defn(Eq,Other,[F|HH],BB)), - once(eval_until_unify(Eq,RetType,Depth,Other,H,HH)), - once(eval_until_unify(Eq,RetType,Depth,Other,B,BB)). -*/ - -metta_atom_iter(Eq,_Depth,_Slf,Other,[Equal,[F|H],B]):- Eq == Equal,!, % trace, - (metta_defn(Eq,Other,[F|H],B)). % once(eval_until_unify(Eq,RetType,Depth,Other,H,HH)). - -%metta_atom_iter(Eq,Depth,_Slf,Other,[Equal,[F|H],B]):- '=' == Equal,!, % trace, - % dcall(metta_defn(Eq,Other,[F|HH],B)), once(eval_until_unify(Eq,RetType,Depth,Other,H,HH)). - -metta_atom_iter(_Eq,Depth,_,_,_):- Depth<3,!,fail. -% And -metta_atom_iter(Eq,Depth,Self,Other,[And|Y]):- atom(And), is_and(And),!, - (Y==[] -> true ; ( D2 is Depth -1, Y = [H|T], metta_atom_iter(Eq,D2,Self,Other,H),metta_atom_iter(Eq,D2,Self,Other,[And|T]))). - -metta_atom_iter(Eq,_Dpth,_Slf,Other,H):- get_metta_atom(Eq,Other,H). - -% is this OK? -metta_atom_iter(Eq,Depth,Self,Other,H):- metta_defn(Eq,Other,H,B), D2 is Depth -1, metta_atom_iter(Eq,D2,Self,Other,B). -%metta_atom_iter_l2(Depth,Self,Other,H):- metta_atom_iter(Eq,Depth,Self,Other,H). -%$metta_atom_iter(Eq,_Dpth,_Slf,[]):-!. - -eval_20(Eq,RetType,_Dpth,_Slf,['new-space'],Space):- !, 'new-space'(Space),check_returnval(Eq,RetType,Space). - - -/* - -metta_atom_iter(Eq,_Dpth,Other,[Equal,H,B]):- '=' == Equal,!, - (metta_defn(Eq,Other,H,B)*->true;(get_metta_atom(Eq,Other,H),B='True')). - -metta_atom_iter(Eq,Depth,_,_):- Depth<3,!,fail. -metta_atom_iter(Eq,_Dpth,_Slf,[]):-!. -metta_atom_iter(Eq,_Dpth,Other,H):- get_metta_atom(Eq,Other,H). -metta_atom_iter(Eq,Depth,Other,H):- D2 is Depth -1, metta_defn(Eq,Other,H,B),metta_atom_iter(Eq,D2,Other,B). -metta_atom_iter(Eq,_Dpth,_Slf,[And]):- is_and(And),!. -metta_atom_iter(Eq,Depth,Self,[And,X|Y]):- is_and(And),!,D2 is Depth -1, metta_atom_iter(Eq,D2,Self,X),metta_atom_iter(Eq,D2,Self,[And|Y]). -*/ -/* -metta_atom_iter2(_,Self,[=,X,Y]):- metta_defn(Eq,Self,X,Y). -metta_atom_iter2(_Dpth,Other,[Equal,H,B]):- '=' == Equal,!, metta_defn(Eq,Other,H,B). -metta_atom_iter2(_Dpth,Self,X,Y):- metta_defn(Eq,Self,X,Y). %, Y\=='True'. -metta_atom_iter2(_Dpth,Self,X,Y):- get_metta_atom(Eq,Self,[=,X,Y]). %, Y\=='True'. -*/ -%metta_atom_iter_ref(Other,[Eq,H,B],Ref):-clause(metta_defn(Eq,Other,H,B),true,Ref). -metta_atom_iter_ref(Other,H,Ref):-clause(metta_atom_asserted(Other,H),true,Ref). - - -% ================================================================= -% ================================================================= -% ================================================================= -% CASE/SWITCH -% ================================================================= -% ================================================================= -% ================================================================= -% Macro: case -:- nodebug(metta(case)). -/* -!(assertEqualToResult - (case - (Link $X B) - ( ( (g $Y) - (Link $X $Y)))) ()) -*/ -/* -eval_20(Eq,RetType,Depth,Self,['case',A,CL],Value):- !, -((eval(Depth,Self,A,AA), - if_trace((case),(writeqln('switch'(A)=AA))), - eval_case_result(Eq,RetType,Depth,Self,A,AA,CL,Value))*->true; -Value=found_none). - -eval_case_result(Eq,RetType,Depth,Self,A,AA,CL,Value):- - must_det_ll(into_case_list(1,CL,KVs)), - select_switch(Depth,Self,AA,KVs,Match,Value), - if_trace((case),(writeqln('matched'=Match))), - if_trace((case),(writeqln('result'=Value))), - check_returnval(Value,Eq,RetType). -eval_case_result(Eq,RetType,Depth,Self,A,AA,CL,Value):- - select(['%void%',_],CL,Rest), Rest == [],!, Value =[]. -eval_case_result(Eq,RetType,Depth,Self,A,AA,CL,Value):- - select(['%void%',Value],CL,Rest),!. - - -select_switch(Depth,_Self,_A,_Cases,_Match,_Value):- Depth<1,!,fail. -select_switch(Depth,Self,A,Cases,Match,Value):- - Depth2 is Depth -1, - ((if_trace((case),(writeqln('select-1'=A))),select_case(Depth2,Self,A,Cases,Match,Value))*->true; - ((eval_complete_change(Eq,_RetType,Depth2,Self,A,AA),if_trace((case),(writeqln('select-2'=AA))), - select_switch(Depth2,Self, AA,Cases,Match,Value))*->true; - (best_key('%void%',Cases,Match,Value)))). - - select_case(Depth,Self,AA,Cases,Match,Value):- - ((best_key(AA,Cases,Match,Value) *-> true ; - ((maybe_special_keys(Depth,Self,Cases,CasES), best_key(AA,CasES,Match,Value)) *-> true; - (fail)))). - - best_key(AA,Cases,Match,Value):- - ((member(Match-Value,Cases),AA ==Match,must_det_ll(AA = Match))->true; - ((member(Match-Value,Cases),AA=@=Match,must_det_ll(AA = Match))->true; - ((member(Match-Value,Cases), AA=Match))->true; - ((member(Match-Value,Cases),unify_enough(AA,Match))->true))). - - %into_case_list([[C|ASES0]],CASES):- is_list(C),!, into_case_list([C|ASES0],CASES),!. - into_case_list(N,[SV|CL],[S-V|CASES]):- - must_det_ll(is_case(S,SV,V)), - if_trace((case),(format('~N'), writeqln('case'(N)=(S>V)))), - N2 is N+1, - into_case_list(N2,CL,CASES). - into_case_list(_,[],[]). - - is_case(AA,[AA,Value],Value):-!. - is_case(AA,[AA|Value],Value). - - %maybe_special_keys(Depth,Self,[K-V|KVI],[AK-V|KVO]):- fail,eval(Eq,RetType,Depth,Self,K,AK), K\=@=AK,!, maybe_special_keys(Depth,Self,KVI,KVO). - maybe_special_keys(Depth,Self,[_|KVI],KVO):- - fail, maybe_special_keys(Depth,Self,KVI,KVO). - maybe_special_keys(_Depth,_Self,[],[]). - -*/ - -% if there is only a void then always return nothing for each Case -eval_20(Eq,_RetType,Depth,Self,['case',A,[[Void,_]]],Res):- - '%void%' == Void, - eval(Eq,_UnkRetType,Depth,Self,A,_),!,Res =[]. - -% if there is nothing for case just treat like a collapse -eval_20(Eq,_RetType,Depth,Self,['case',A,[]],Empty):- - %forall(eval(Eq,_RetType2,Depth,Self,Expr,_),true), - once(eval(Eq,_RetType2,Depth,Self,A,_)), - return_empty([],Empty). - -% Macro: case -eval_20(Eq,RetType,Depth,Self,['case',A,CL|T],Res):- - must_det_ll(T==[]), - into_case_list(CL,CASES), - findall(Key-Value, - (nth0(Nth,CASES,Case0), - (is_case(Key,Case0,Value), - if_trace(metta(case),(format('~N'),writeqln(c(Nth,Key)=Value))))),KVs),!, - eval_case(Eq,RetType,Depth,Self,A,KVs,Res). - -eval_case(Eq,CaseRetType,Depth,Self,A,KVs,Res):- - ((eval(Eq,_UnkRetType,Depth,Self,A,AA), - if_trace((case),(writeqln('case'=A))), - if_trace(metta(case),writeqln('switch'=AA)), - (select_case(Depth,Self,AA,KVs,Value)->true;(member(Void -Value,KVs),Void=='%void%'))) - *->true;(member(Void -Value,KVs),Void=='%void%')), - eval(Eq,CaseRetType,Depth,Self,Value,Res). - - select_case(Depth,Self,AA,Cases,Value):- - (best_key(AA,Cases,Value) -> true ; - (maybe_special_keys(Depth,Self,Cases,CasES), - (best_key(AA,CasES,Value) -> true ; - (member(Void -Value,CasES),Void=='%void%')))). - - best_key(AA,Cases,Value):- - ((member(Match-Value,Cases),AA ==Match)->true; - ((member(Match-Value,Cases),AA=@=Match)->true; - (member(Match-Value,Cases),AA = Match))). - - %into_case_list([[C|ASES0]],CASES):- is_list(C),!, into_case_list([C|ASES0],CASES),!. - into_case_list(CASES,CASES):- is_list(CASES),!. - is_case(AA,[AA,Value],Value):-!. - is_case(AA,[AA|Value],Value). - - maybe_special_keys(Depth,Self,[K-V|KVI],[AK-V|KVO]):- - eval(Depth,Self,K,AK), K\=@=AK,!, - maybe_special_keys(Depth,Self,KVI,KVO). - maybe_special_keys(Depth,Self,[_|KVI],KVO):- - maybe_special_keys(Depth,Self,KVI,KVO). - maybe_special_keys(_Depth,_Self,[],[]). - - -% ================================================================= -% ================================================================= -% ================================================================= -% COLLAPSE/SUPERPOSE -% ================================================================= -% ================================================================= -% ================================================================= - - - -%[collapse,[1,2,3]] -eval_20(Eq,RetType,Depth,Self,['collapse',List],Res):-!, - bagof_eval(Eq,RetType,Depth,Self,List,Res). - -eval_20(Eq,RetType,Depth,Self,PredDecl,Res):- - Do_more_defs = do_more_defs(true), - clause(eval_21(Eq,RetType,Depth,Self,PredDecl,Res),Body), - Do_more_defs == do_more_defs(true), - call_ndet(Body,DET), - nb_setarg(1,Do_more_defs,false), - (DET==true -> ! ; true). - - -eval_21(Eq,RetType,Depth,Self,['CollapseCardinality',List],Len):-!, - bagof_eval(Eq,RetType,Depth,Self,List,Res), - length(Res,Len). -/* -eval_21(_Eq,_RetType,_Depth,_Self,['TupleCount', [N]],N):- number(N),!. - - -eval_21(Eq,RetType,Depth,Self,['TupleCount',List],Len):-!, - bagof_eval(Eq,RetType,Depth,Self,List,Res), - length(Res,Len). -*/ - -%[superpose,[1,2,3]] -eval_20(Eq,RetType,Depth,Self,['superpose',List],Res):- !, - (((is_user_defined_head(Eq,Self,List) ,eval(Eq,RetType,Depth,Self,List,UList), List\=@=UList) - *-> eval_20(Eq,RetType,Depth,Self,['superpose',UList],Res) - ; ((member(E,List),eval(Eq,RetType,Depth,Self,E,Res))*->true;return_empty([],Res)))), - \+ Res = 'Empty'. - -%[sequential,[1,2,3]] -eval_20(Eq,RetType,Depth,Self,['sequential',List],Res):- !, - (((fail,is_user_defined_head(Eq,Self,List) ,eval(Eq,RetType,Depth,Self,List,UList), List\=@=UList) - *-> eval_20(Eq,RetType,Depth,Self,['sequential',UList],Res) - ; ((member(E,List),eval_ne(Eq,RetType,Depth,Self,E,Res))*->true;return_empty([],Res)))). - - -get_sa_p1(P3,E,Cmpd,SA):- compound(Cmpd), get_sa_p2(P3,E,Cmpd,SA). -get_sa_p2(P3,E,Cmpd,call(P3,N1,Cmpd)):- arg(N1,Cmpd,E). -get_sa_p2(P3,E,Cmpd,SA):- arg(_,Cmpd,Arg),get_sa_p1(P3,E,Arg,SA). -eval20_failed(Eq,RetType,Depth,Self, Term, Res):- - mnotrace(( get_sa_p1(setarg,ST,Term,P1), % ST\==Term, - compound(ST), ST = [F,List],F=='superpose',nonvar(List), %maplist(atomic,List), - call(P1,Var))), !, - %max_counting(F,20), - member(Var,List), - eval(Eq,RetType,Depth,Self, Term, Res). - - -sub_sterm(Sub,Sub). -sub_sterm(Sub,Term):- sub_sterm1(Sub,Term). -sub_sterm1(_ ,List):- \+ compound(List),!,fail. -sub_sterm1(Sub,List):- is_list(List),!,member(SL,List),sub_sterm(Sub,SL). -sub_sterm1(_ ,[_|_]):-!,fail. -sub_sterm1(Sub,Term):- arg(_,Term,SL),sub_sterm(Sub,SL). -eval20_failed_2(Eq,RetType,Depth,Self, Term, Res):- - mnotrace(( get_sa_p1(setarg,ST,Term,P1), - compound(ST), ST = [F,List],F=='collapse',nonvar(List), %maplist(atomic,List), - call(P1,Var))), !, bagof_eval(Eq,RetType,Depth,Self,List,Var), - eval(Eq,RetType,Depth,Self, Term, Res). - - -% ================================================================= -% ================================================================= -% ================================================================= -% NOP/EQUALITU/DO -% ================================================================= -% ================================================================= -% ================================================================ -eval_20(_Eq,_RetType,_Depth,_Self,['nop'], _ ):- !, fail. -eval_20(_Eq,_RetType1,Depth,Self,['nop',Expr], Empty):- !, - ignore(eval('=',_RetType2,Depth,Self,Expr,_)), - return_empty([], Empty). - -eval_20(Eq,_RetType1,Depth,Self,['do',Expr], Empty):- !, - forall(eval(Eq,_RetType2,Depth,Self,Expr,_),true), - %eval_ne(Eq,_RetType2,Depth,Self,Expr,_),!, - return_empty([],Empty). - -max_counting(F,Max):- flag(F,X,X+1), X true; (flag(F,_,10),!,fail). -% ================================================================= -% ================================================================= -% ================================================================= -% if/If -% ================================================================= -% ================================================================= -% ================================================================= - - - -eval_20(Eq,RetType,Depth,Self,['if',Cond,Then,Else],Res):- !, - eval(Eq,'Bool',Depth,Self,Cond,TF), - (is_True(TF) - -> eval(Eq,RetType,Depth,Self,Then,Res) - ; eval(Eq,RetType,Depth,Self,Else,Res)). - -eval_20(Eq,RetType,Depth,Self,['If',Cond,Then,Else],Res):- !, - eval(Eq,'Bool',Depth,Self,Cond,TF), - (is_True(TF) - -> eval(Eq,RetType,Depth,Self,Then,Res) - ; eval(Eq,RetType,Depth,Self,Else,Res)). - -eval_20(Eq,RetType,Depth,Self,['If',Cond,Then],Res):- !, - eval(Eq,'Bool',Depth,Self,Cond,TF), - (is_True(TF) -> eval(Eq,RetType,Depth,Self,Then,Res) ; - (!, fail,Res = [],!)). - -eval_20(Eq,RetType,Depth,Self,['if',Cond,Then],Res):- !, - eval(Eq,'Bool',Depth,Self,Cond,TF), - (is_True(TF) -> eval(Eq,RetType,Depth,Self,Then,Res) ; - (!, fail,Res = [],!)). - - -eval_20(Eq,RetType,_Dpth,_Slf,[_,Nothing],NothingO):- - 'Nothing'==Nothing,!,do_expander(Eq,RetType,Nothing,NothingO). - -% ================================================================= -% ================================================================= -% ================================================================= -% LET/LET* -% ================================================================= -% ================================================================= -% ================================================================= - - - -eval_until_unify(_Eq,_RetType,_Dpth,_Slf,X,X):- !. -eval_until_unify(Eq,RetType,Depth,Self,X,Y):- eval_until_eq(Eq,RetType,Depth,Self,X,Y). - -eval_until_eq(Eq,RetType,_Dpth,_Slf,X,Y):- X=Y,check_returnval(Eq,RetType,Y). -%eval_until_eq(Eq,RetType,Depth,Self,X,Y):- var(Y),!,eval_in_steps_or_same(Eq,RetType,Depth,Self,X,XX),Y=XX. -%eval_until_eq(Eq,RetType,Depth,Self,Y,X):- var(Y),!,eval_in_steps_or_same(Eq,RetType,Depth,Self,X,XX),Y=XX. -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- \+is_list(Y),!,eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),Y=XX. -eval_until_eq(Eq,RetType,Depth,Self,Y,X):- \+is_list(Y),!,eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),Y=XX. -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),eval_until_eq(Eq,RetType,Depth,Self,Y,XX). -eval_until_eq(_Eq,_RetType,_Dpth,_Slf,X,Y):- length(X,Len), \+ length(Y,Len),!,fail. -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), - EX=EY,!, maplist(eval_until_eq(Eq,RetType,Depth,Self),RX,RY). -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), - ((var(EX);var(EY)),eval_until_eq(Eq,RetType,Depth,Self,EX,EY)), - maplist(eval_until_eq(Eq,RetType,Depth,Self),RX,RY). -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), - h((is_list(EX);is_list(EY)),eval_until_eq(Eq,RetType,Depth,Self,EX,EY)), - maplist(eval_until_eq(Eq,RetType,Depth,Self),RX,RY). - - eval_1change(Eq,RetType,Depth,Self,EX,EXX):- - eval_20(Eq,RetType,Depth,Self,EX,EXX), EX \=@= EXX. - -eval_complete_change(Eq,RetType,Depth,Self,EX,EXX):- - eval(Eq,RetType,Depth,Self,EX,EXX), EX \=@= EXX. - -eval_in_steps_some_change(_Eq,_RetType,_Dpth,_Slf,EX,_):- \+ is_list(EX),!,fail. -eval_in_steps_some_change(Eq,RetType,Depth,Self,EX,EXX):- eval_1change(Eq,RetType,Depth,Self,EX,EXX). -eval_in_steps_some_change(Eq,RetType,Depth,Self,X,Y):- append(L,[EX|R],X),is_list(EX), - eval_in_steps_some_change(Eq,RetType,Depth,Self,EX,EXX), EX\=@=EXX, - append(L,[EXX|R],XX),eval_in_steps_or_same(Eq,RetType,Depth,Self,XX,Y). - -eval_in_steps_or_same(Eq,RetType,Depth,Self,X,Y):-eval_in_steps_some_change(Eq,RetType,Depth,Self,X,Y). -eval_in_steps_or_same(Eq,RetType,_Dpth,_Slf,X,Y):- X=Y,check_returnval(Eq,RetType,Y). - - % (fail,return_empty([],Template))). - - -eval_20(Eq,RetType,Depth,Self,['let',A,A5,AA],OO):- !, - %(var(A)->true;trace), - ((eval(Eq,RetType,Depth,Self,A5,AE), AE=A)), - eval(Eq,RetType,Depth,Self,AA,OO). -%eval_20(Eq,RetType,Depth,Self,['let',A,A5,AA],AAO):- !,eval(Eq,RetType,Depth,Self,A5,A),eval(Eq,RetType,Depth,Self,AA,AAO). -eval_20(Eq,RetType,Depth,Self,['let*',[],Body],RetVal):- !, eval(Eq,RetType,Depth,Self,Body,RetVal). -eval_20(Eq,RetType,Depth,Self,['let*',[[Var,Val]|LetRest],Body],RetVal):- !, - eval_20(Eq,RetType,Depth,Self,['let',Var,Val,['let*',LetRest,Body]],RetVal). - - -% ================================================================= -% ================================================================= -% ================================================================= -% CONS/CAR/CDR -% ================================================================= -% ================================================================= -% ================================================================= - - - -into_pl_list(Var,Var):- var(Var),!. -into_pl_list(Nil,[]):- Nil == 'Nil',!. -into_pl_list([Cons,H,T],[HH|TT]):- Cons == 'Cons', !, into_pl_list(H,HH),into_pl_list(T,TT),!. -into_pl_list(X,X). - -into_metta_cons(Var,Var):- var(Var),!. -into_metta_cons([],'Nil'):-!. -into_metta_cons([Cons, A, B ],['Cons', AA, BB]):- 'Cons'==Cons, no_cons_reduce, !, - into_metta_cons(A,AA), into_metta_cons(B,BB). -into_metta_cons([H|T],['Cons',HH,TT]):- into_metta_cons(H,HH),into_metta_cons(T,TT),!. -into_metta_cons(X,X). - -into_listoid(AtomC,Atom):- AtomC = [Cons,H,T],Cons=='Cons',!, Atom=[H,[T]]. -into_listoid(AtomC,Atom):- is_list(AtomC),!,Atom=AtomC. -into_listoid(AtomC,Atom):- typed_list(AtomC,_,Atom),!. - -:- if( \+ current_predicate( typed_list / 3 )). -typed_list(Cmpd,Type,List):- compound(Cmpd), Cmpd\=[_|_], compound_name_arguments(Cmpd,Type,[List|_]),is_list(List). -:- endif. - -%eval_20(Eq,RetType,Depth,Self,['colapse'|List], Flat):- !, maplist(eval(Eq,RetType,Depth,Self),List,Res),flatten(Res,Flat). - -%eval_20(Eq,RetType,Depth,Self,['flatten'|List], Flat):- !, maplist(eval(Eq,RetType,Depth,Self),List,Res),flatten(Res,Flat). - - -eval_20(Eq,RetType,_Dpth,_Slf,['car-atom',Atom],CAR_Y):- !, Atom=[CAR|_],!,do_expander(Eq,RetType,CAR,CAR_Y). -eval_20(Eq,RetType,_Dpth,_Slf,['cdr-atom',Atom],CDR_Y):- !, Atom=[_|CDR],!,do_expander(Eq,RetType,CDR,CDR_Y). - -eval_20(Eq,RetType,Depth,Self,['Cons', A, B ],['Cons', AA, BB]):- no_cons_reduce, !, - eval(Eq,RetType,Depth,Self,A,AA), eval(Eq,RetType,Depth,Self,B,BB). - -eval_20(Eq,RetType,Depth,Self,['Cons', A, B ],[AA|BB]):- \+ no_cons_reduce, !, - eval(Eq,RetType,Depth,Self,A,AA), eval(Eq,RetType,Depth,Self,B,BB). - - - -% ================================================================= -% ================================================================= -% ================================================================= -% STATE EDITING -% ================================================================= -% ================================================================= -% ================================================================= - -eval_20(Eq,RetType,Depth,Self,['change-state!',StateExpr, UpdatedValue], Ret):- !, eval(Eq,RetType,Depth,Self,StateExpr,StateMonad), - eval(Eq,RetType,Depth,Self,UpdatedValue,Value), 'change-state!'(Depth,Self,StateMonad, Value, Ret). -eval_20(Eq,RetType,Depth,Self,['new-state',UpdatedValue],StateMonad):- !, - eval(Eq,RetType,Depth,Self,UpdatedValue,Value), 'new-state'(Depth,Self,Value,StateMonad). -eval_20(Eq,RetType,Depth,Self,['get-state',StateExpr],Value):- !, - eval(Eq,RetType,Depth,Self,StateExpr,StateMonad), 'get-state'(StateMonad,Value). - - - -% eval_20(Eq,RetType,Depth,Self,['get-state',Expr],Value):- !, eval(Eq,RetType,Depth,Self,Expr,State), arg(1,State,Value). - - - -check_type:- option_else(typecheck,TF,'False'), TF=='True'. - -:- dynamic is_registered_state/1. -:- flush_output. -:- setenv('RUST_BACKTRACE',full). - -% Function to check if an value is registered as a state name -:- dynamic(is_registered_state/1). -is_nb_state(G):- is_valid_nb_state(G) -> true ; - is_registered_state(G),nb_current(G,S),is_valid_nb_state(S). - -/* -:- multifile(space_type_method/3). -:- dynamic(space_type_method/3). -space_type_method(is_nb_space,new_space,init_space). -space_type_method(is_nb_space,clear_space,clear_nb_atoms). -space_type_method(is_nb_space,add_atom,add_nb_atom). -space_type_method(is_nb_space,remove_atom,'change-space!'). -space_type_method(is_nb_space,replace_atom,replace_nb_atom). -space_type_method(is_nb_space,atom_count,atom_nb_count). -space_type_method(is_nb_space,get_atoms,'get-space'). -space_type_method(is_nb_space,atom_iter,atom_nb_iter). -*/ - -:- multifile(state_type_method/3). -:- dynamic(state_type_method/3). -state_type_method(is_nb_state,new_state,init_state). -state_type_method(is_nb_state,clear_state,clear_nb_values). -state_type_method(is_nb_state,add_value,add_nb_value). -state_type_method(is_nb_state,remove_value,'change-state!'). -state_type_method(is_nb_state,replace_value,replace_nb_value). -state_type_method(is_nb_state,value_count,value_nb_count). -state_type_method(is_nb_state,'get-state','get-state'). -state_type_method(is_nb_state,value_iter,value_nb_iter). -%state_type_method(is_nb_state,query,state_nb_query). - -% Clear all values from a state -clear_nb_values(StateNameOrInstance) :- - fetch_or_create_state(StateNameOrInstance, State), - nb_setarg(1, State, []). - - - -% Function to confirm if a term represents a state -is_valid_nb_state(State):- compound(State),functor(State,'State',_). - -% Find the original name of a given state -state_original_name(State, Name) :- - is_registered_state(Name), - nb_current(Name, State). - -% Register and initialize a new state -init_state(Name) :- - State = 'State'(_,_), - asserta(is_registered_state(Name)), - nb_setval(Name, State). - -% Change a value in a state -'change-state!'(Depth,Self,StateNameOrInstance, UpdatedValue, Out) :- - fetch_or_create_state(StateNameOrInstance, State), - arg(2, State, Type), - ( (check_type,\+ get_type(Depth,Self,UpdatedValue,Type)) - -> (Out = ['Error', UpdatedValue, 'BadType']) - ; (nb_setarg(1, State, UpdatedValue), Out = State) ). - -% Fetch all values from a state -'get-state'(StateNameOrInstance, Values) :- - fetch_or_create_state(StateNameOrInstance, State), - arg(1, State, Values). - -'new-state'(Depth,Self,Init,'State'(Init, Type)):- check_type->get_type(Depth,Self,Init,Type);true. - -'new-state'(Init,'State'(Init, Type)):- check_type->get_type(10,'&self',Init,Type);true. - -fetch_or_create_state(Name):- fetch_or_create_state(Name,_). -% Fetch an existing state or create a new one - -fetch_or_create_state(State, State) :- is_valid_nb_state(State),!. -fetch_or_create_state(NameOrInstance, State) :- - ( atom(NameOrInstance) - -> (is_registered_state(NameOrInstance) - -> nb_current(NameOrInstance, State) - ; init_state(NameOrInstance), - nb_current(NameOrInstance, State)) - ; is_valid_nb_state(NameOrInstance) - -> State = NameOrInstance - ; writeln('Error: Invalid input.') - ), - is_valid_nb_state(State). - -% ================================================================= -% ================================================================= -% ================================================================= -% GET-TYPE -% ================================================================= -% ================================================================= -% ================================================================= - -eval_20(Eq,RetType,Depth,Self,['get-type',Val],TypeO):- !, get_type(Depth,Self,Val,Type),ground(Type),Type\==[], Type\==Val,!, - do_expander(Eq,RetType,Type,TypeO). - - - -eval_20(Eq,RetType,Depth,Self,['length',L],Res):- !, eval(Eq,RetType,Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). -eval_20(Eq,RetType,Depth,Self,['CountElement',L],Res):- !, eval(Eq,RetType,Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). - - - - - - -% ================================================================= -% ================================================================= -% ================================================================= -% IMPORT/BIND -% ================================================================= -% ================================================================= -% ================================================================= -nb_bind(Name,Value):- nb_current(Name,Was),same_term(Value,Was),!. -nb_bind(Name,Value):- nb_setval(Name,Value),!. -eval_20(Eq,RetType,Depth,Self,['import!',Other,File],RetVal):- - (( into_space(Depth,Self,Other,Space),!, include_metta(Space,File),!,return_empty(Space,RetVal))), - check_returnval(Eq,RetType,RetVal). %RetVal=[]. -eval_20(Eq,RetType,_Depth,_Slf,['bind!',Other,['new-space']],RetVal):- atom(Other),!,assert(was_asserted_space(Other)), - return_empty([],RetVal), check_returnval(Eq,RetType,RetVal). -eval_20(Eq,RetType,Depth,Self,['bind!',Other,Expr],RetVal):- - must_det_ll((into_name(Self,Other,Name),!,eval(Eq,RetType,Depth,Self,Expr,Value), - nb_bind(Name,Value), return_empty(Value,RetVal))), - check_returnval(Eq,RetType,RetVal). -eval_20(Eq,RetType,Depth,Self,['pragma!',Other,Expr],RetVal):- - must_det_ll((into_name(Self,Other,Name),!,nd_ignore((eval(Eq,RetType,Depth,Self,Expr,Value), - set_option_value(Name,Value))), return_empty(Value,RetVal), - check_returnval(Eq,RetType,RetVal))). -eval_20(Eq,RetType,_Dpth,Self,['transfer!',File],RetVal):- !, must_det_ll((include_metta(Self,File), return_empty(Self,RetVal),check_returnval(Eq,RetType,RetVal))). - - -nd_ignore(Goal):- call(Goal)*->true;true. - - - - - - - - - -% ================================================================= -% ================================================================= -% ================================================================= -% AND/OR -% ================================================================= -% ================================================================= -% ================================================================= - -is_True(T):- T\=='False',T\==[]. - -is_and(S):- \+ atom(S),!,fail. -is_and(','). -is_and(S):- is_and(S,_). - -is_and(S,_):- \+ atom(S),!,fail. -is_and('and','True'). -is_and('and2','True'). -is_and('#COMMA','True'). is_and(',','True'). % is_and('And'). - -eval_20(Eq,RetType,_Dpth,_Slf,[And],True):- is_and(And,True),!,check_returnval(Eq,RetType,True). -eval_20(Eq,RetType,Depth,Self,[And,X,Y],TF):- is_and(And,True),!, as_tf(( - eval_args(Eq,RetType,Depth,Self,X,True),eval_args(Eq,RetType,Depth,Self,Y,True)),TF). -eval_20(Eq,RetType,Depth,Self,[And,X],True):- is_and(And,True),!, - eval_args(Eq,RetType,Depth,Self,X,True). -eval_20(Eq,RetType,Depth,Self,[And,X|Y],TF):- is_and(And,_True),!, - eval_args(Eq,RetType,Depth,Self,X,TF1), \+ \+ is_True(TF1), - eval_args(Eq,RetType,Depth,Self,[And|Y],TF). - -eval_20(Eq,RetType,Depth,Self,['or',X,Y],TF):- !, - as_tf((eval_args(Eq,RetType,Depth,Self,X,'True');eval_args(Eq,RetType,Depth,Self,Y,'True')),TF). - - -% ================================================================= -% ================================================================= -% ================================================================= -% MeTTaLog Extras -% ================================================================= -% ================================================================= -% ================================================================= - -eval_20(_Eq,_RetType1,_Depth,_Self,['call',S], TF):- !, eval_call(S,TF). -eval_20(Eq,RetType,Depth,Self,['eval',S], Res):- !, eval(Eq,RetType,Depth,Self,S, Res). - - -% ================================================================= -% ================================================================= -% ================================================================= -% DATA FUNCTOR -% ================================================================= -% ================================================================= -% ================================================================= -eval20_failked(Eq,RetType,Depth,Self,[V|VI],[V|VO]):- - nonvar(V),is_metta_data_functor(V),is_list(VI),!, - maplist(eval(Eq,RetType,Depth,Self),VI,VO). - - -% ================================================================= -% ================================================================= -% ================================================================= -% EVAL FAILED -% ================================================================= -% ================================================================= -% ================================================================= -eval_20(Eq,RetType,Depth,Self,X,Y):- - (eval_40(Eq,RetType,Depth,Self,X,M)*-> - M=Y ; - % finish_eval(Depth,Self,M,Y); - (eval_failed(Depth,Self,X,Y)*->true;X=Y)). - -eval_failed(Depth,Self,T,TT):- - finish_eval(Depth,Self,T,TT). - -finish_eval(_Dpth,_Slf,T,TT):- var(T),!,TT=T. -finish_eval(_Dpth,_Slf,[],[]):-!. -%finish_eval(_Dpth,_Slf,[F|LESS],Res):- once(eval_selfless([F|LESS],Res)),mnotrace([F|LESS]\==Res),!. -%finish_eval(Depth,Self,[V|Nil],[O]):- Nil==[], once(eval(Eq,RetType,Depth,Self,V,O)),V\=@=O,!. -finish_eval(Depth,Self,[H|T],[HH|TT]):- !, - eval(Depth,Self,H,HH), - finish_eval(Depth,Self,T,TT). -finish_eval(Depth,Self,T,TT):- eval(Depth,Self,T,TT). - - %eval(Eq,RetType,Depth,Self,X,Y):- eval_20(Eq,RetType,Depth,Self,X,Y)*->true;Y=[]. - -%eval_20(Eq,RetType,Depth,_,_,_):- Depth<1,!,fail. -%eval_20(Eq,RetType,Depth,_,X,Y):- Depth<3, !, ground(X), (Y=X). -%eval_20(Eq,RetType,_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. - -% Kills zero arity functions eval_20(Eq,RetType,Depth,Self,[X|Nil],[Y]):- Nil ==[],!,eval(Eq,RetType,Depth,Self,X,Y). - - -/* -into_values(List,Many):- List==[],!,Many=[]. -into_values([X|List],Many):- List==[],is_list(X),!,Many=X. -into_values(Many,Many). -eval_40(Eq,RetType,_Dpth,_Slf,Name,Value):- atom(Name), nb_current(Name,Value),!. -*/ -% Macro Functions -%eval_20(Eq,RetType,Depth,_,_,_):- Depth<1,!,fail. -eval_40(_Eq,_RetType,Depth,_,X,Y):- Depth<3, !, fail, ground(X), (Y=X). -eval_40(Eq,RetType,Depth,Self,[F|PredDecl],Res):- fail, - Depth>1, - mnotrace((sub_sterm1(SSub,PredDecl), ground(SSub),SSub=[_|Sub], is_list(Sub), maplist(atomic,SSub))), - eval(Eq,RetType,Depth,Self,SSub,Repl), - mnotrace((SSub\=Repl, subst(PredDecl,SSub,Repl,Temp))), - eval(Eq,RetType,Depth,Self,[F|Temp],Res). - - -% ================================================================= -% ================================================================= -% ================================================================= -% PLUS/MINUS -% ================================================================= -% ================================================================= -% ================================================================= -eval_40(Eq,RetType,Depth,Self,['+',N1,N2],N):- number(N1),!, - eval(Eq,RetType,Depth,Self,N2,N2Res), notrace(catch_err(N is N1+N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). -eval_40(Eq,RetType,Depth,Self,['-',N1,N2],N):- number(N1),!, - eval(Eq,RetType,Depth,Self,N2,N2Res), notrace(catch_err(N is N1-N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). -eval_40(Eq,RetType,Depth,Self,['*',N1,N2],N):- number(N1),!, - eval(Eq,RetType,Depth,Self,N2,N2Res), notrace(catch_err(N is N1*N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). - -% ================================================================= -% ================================================================= -% ================================================================= -% METTLOG PREDEFS -% ================================================================= -% ================================================================= -% ================================================================= - -eval_40(Eq,RetType,Depth,Self,['length',L],Res):- !, eval(Depth,Self,L,LL), - (is_list(LL)->length(LL,Res);Res=1), - check_returnval(Eq,RetType,Res). - -eval_40(Eq,RetType,_Dpth,_Slf,['arity',F,A],TF):- !,as_tf(current_predicate(F/A),TF),check_returnval(Eq,RetType,TF). - -eval_40(Eq,RetType,Depth,Self,['CountElement',L],Res):- !, eval(Eq,RetType,Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1),check_returnval(Eq,RetType,Res). -eval_40(Eq,RetType,_Dpth,_Slf,['make_list',List],MettaList):- !, into_metta_cons(List,MettaList),check_returnval(Eq,RetType,MettaList). - -% user defined function -eval_40(Eq,RetType,Depth,Self,[H|PredDecl],Res):- - mnotrace(is_user_defined_head(Self,H)),!, - eval_defn(Eq,RetType,Depth,Self,[H|PredDecl],Res). - -eval_40(Eq,RetType,_Dpth,_Slf,['==',X,Y],Res):- !, - suggest_type(RetType,'Bool'), - eq_unify(Eq,_SharedType, X, Y, Res). - -eq_unify(_Eq,_SharedType, X, Y, TF):- as_tf(X=:=Y,TF),!. -eq_unify(_Eq,_SharedType, X, Y, TF):- as_tf( '#='(X,Y),TF),!. -eq_unify( Eq, SharedType, X, Y, TF):- as_tf(eval_until_unify(Eq,SharedType, X, Y), TF). - - -suggest_type(_RetType,_Bool). - -eval_40(Eq,RetType,Depth,Self,[AE|More],Res):- is_special_op(AE),!, - eval_70(Eq,RetType,Depth,Self,[AE|More],Res), - check_returnval(Eq,RetType,Res). - -eval_40(Eq,RetType,Depth,Self,[AE|More],Res):- - maplist(must_eval_args(Eq,_,Depth,Self),More,Adjusted), - eval_70(Eq,RetType,Depth,Self,[AE|Adjusted],Res), - check_returnval(Eq,RetType,Res). - -must_eval_args(Eq,RetType,Depth,Self,More,Adjusted):- - (eval_args(Eq,RetType,Depth,Self,More,Adjusted)*->true; - (with_debug(eval,eval_args(Eq,RetType,Depth,Self,More,Adjusted))*-> true; - ( - nl,writeq(eval_args(Eq,RetType,Depth,Self,More,Adjusted)),writeln('.'), - (More=Adjusted -> true ; - (trace, throw(must_eval_args(Eq,RetType,Depth,Self,More,Adjusted))))))). - - - - -eval_70(Eq,RetType,Depth,Self,PredDecl,Res):- - Do_more_defs = do_more_defs(true), - clause(eval_80(Eq,RetType,Depth,Self,PredDecl,Res),Body), - Do_more_defs == do_more_defs(true), - call(Body),nb_setarg(1,Do_more_defs,false). - - -% ================================================================= -% ================================================================= -% ================================================================= -% inherited by system -% ================================================================= -% ================================================================= -% ================================================================= -is_system_pred(S):- atom(S),atom_concat(_,'!',S). - - - -eval_80(_Eq,_RetType,_Dpth,_Slf,LESS,Res):- - notrace((ground(LESS),once((eval_selfless(LESS,Res),mnotrace(LESS\==Res))))),!. - - -% predicate inherited by system -eval_80(Eq,RetType,_Depth,_Self,[AE|More],TF):- - is_system_pred(AE), - length(More,Len), - is_syspred(AE,Len,Pred), - %mnotrace( \+ is_user_defined_goal(Self,[AE|More])),!, - %adjust_args(Depth,Self,AE,More,Adjusted), - More = Adjusted, - catch_warn(efbug(show_call,eval_call(apply(Pred,Adjusted),TF))), - check_returnval(Eq,RetType,TF). - -:- if( \+ current_predicate( adjust_args / 2 )). - - :- discontiguous eval_80/6. - -is_user_defined_goal(Self,Head):- - is_user_defined_head(Self,Head). - -:- endif. - -eval_call(S,TF):- - s2p(S,P), !, - dmsg(eval_call(P,'$VAR'('TF'))),as_tf(P,TF). - -eval_80(Eq,RetType,_Depth,_Self,[AE|More],Res):- - is_system_pred(AE), - length([AE|More],Len), - is_syspred(AE,Len,Pred), - %mnotrace( \+ is_user_defined_goal(Self,[AE|More])),!, - %adjust_args(Depth,Self,AE,More,Adjusted),!, - More = Adjusted, - append(Adjusted,[Res],Args),!, - efbug(show_call,catch_warn(apply(Pred,Args))), - check_returnval(Eq,RetType,Res). - -:- if( \+ current_predicate( check_returnval / 3 )). -check_returnval(_,_RetType,_TF). -:- endif. - -:- if( \+ current_predicate( adjust_args / 5 )). -adjust_args(_Depth,_Self,_V,VI,VI). -:- endif. - -eval_80(Eq,RetType,Depth,Self,PredDecl,Res):- - eval_67(Eq,RetType,Depth,Self,PredDecl,Res). - - - -last_element(T,E):- \+ compound(T),!,E=T. -last_element(T,E):- is_list(T),last(T,L),last_element(L,E),!. -last_element(T,E):- compound_name_arguments(T,_,List),last_element(List,E),!. - - - - -catch_warn(G):- quietly(catch_err(G,E,(wdmsg(catch_warn(G)-->E),fail))). -catch_nowarn(G):- quietly(catch_err(G,error(_,_),fail)). - - -as_tf(G,TF):- G\=[_|_], catch_nowarn((call(G)*->TF='True';TF='False')). -%eval_selfless(['==',X,Y],TF):- as_tf(X=:=Y,TF),!. -%eval_selfless(['==',X,Y],TF):- as_tf(X=@=Y,TF),!. -eval_selfless(['>',X,Y],TF):-!,as_tf(X>Y,TF). -eval_selfless(['<',X,Y],TF):-!,as_tf(X',X,Y],TF):-!,as_tf(X>=Y,TF). -eval_selfless(['<=',X,Y],TF):-!,as_tf(X='). -is_special_op('let'). -is_special_op('let*'). -is_special_op('if'). -is_special_op('rtrace'). -is_special_op('or'). -is_special_op('and'). -is_special_op('not'). -is_special_op('match'). -is_special_op('call'). -is_special_op('let'). -is_special_op('nop'). -is_special_op('assertEqual'). -is_special_op('assertEqualToResult'). - -is_metta_builtin(Special):- is_special_op(Special). -is_metta_builtin('=='). -is_metta_builtin(F):- once(atom(F);var(F)), current_op(_,yfx,F). -is_metta_builtin('println!'). -is_metta_builtin('transfer!'). -is_metta_builtin('collapse'). -is_metta_builtin('superpose'). -is_metta_builtin('+'). -is_metta_builtin('-'). -is_metta_builtin('*'). -is_metta_builtin('/'). -is_metta_builtin('%'). -is_metta_builtin('=='). -is_metta_builtin('<'). -is_metta_builtin('>'). -is_metta_builtin('all'). -is_metta_builtin('import!'). -is_metta_builtin('pragma!'). - -*/ -% ================================================================= -% ================================================================= -% ================================================================= -% USER DEFINED FUNCTIONS -% ================================================================= -% ================================================================= -% ================================================================= - -call_ndet(Goal,DET):- call(Goal),deterministic(DET). - -eval_defn(Eq,RetType,Depth,Self,H,B):- - (eval_64(Eq,RetType,Depth,Self,H,B)*->true; - (fail,eval_67(Eq,RetType,Depth,Self,H,B))). - - -%eval_64(Eq,_RetType,_Dpth,Self,H,B):- Eq='=',!, metta_defn(Eq,Self,H,B). -eval_64(Eq,_RetType,_Dpth,Self,H,B):- - Eq='match', dcall(metta_atom(Self,H)),B=H. - - -eval_64(Eq,RetType,Depth,Self,[[H|Start]|T1],Y):- - mnotrace((is_user_defined_head_f(Self,H),is_list(Start))), - metta_defn(Eq,Self,[H|Start],Left), - [Left|T1] \=@= [[H|Start]|T1], - eval(Eq,RetType,Depth,Self,[Left|T1],Y). - -eval_64(Eq,_RetType,Depth,Self,[H|Args],B):- % no weird template matchers - % forall(metta_defn(Eq,Self,[H|Template],_), - % maplist(not_template_arg,Template)), - Eq='=', - (metta_defn(Eq,Self,[H|Args],B0)*->true;(fail,[H|Args]=B0)), - light_eval(Depth,Self,B0,B). - %(eval(Eq,RetType,Depth,Self,B,Y);metta_atom_iter(Depth,Self,Y)). -% Use the first template match -eval_64(Eq,_RetType,Depth,Self,[H|Args],B):- fail, - Eq='=', - (metta_defn(Eq,Self,[H|Template],B0),Args=Template), - light_eval(Depth,Self,B0,B). - - -light_eval(_Depth,_Self,B,B). - -not_template_arg(TArg):- var(TArg), !, \+ attvar(TArg). -not_template_arg(TArg):- atomic(TArg),!. -%not_template_arg(TArg):- is_list(TArg),!,fail. - - -% Has argument that is headed by the same function -eval_67(Eq,RetType,Depth,Self,[H1|Args],Res):- - mnotrace((append(Left,[[H2|H2Args]|Rest],Args), H2==H1)),!, - eval(Eq,RetType,Depth,Self,[H2|H2Args],ArgRes), - mnotrace((ArgRes\==[H2|H2Args], append(Left,[ArgRes|Rest],NewArgs))), - eval_defn(Eq,RetType,Depth,Self,[H1|NewArgs],Res). - -eval_67(Eq,RetType,Depth,Self,[[H|Start]|T1],Y):- - mnotrace((is_user_defined_head_f(Self,H),is_list(Start))), - metta_defn(Eq,Self,[H|Start],Left), - eval(Eq,RetType,Depth,Self,[Left|T1],Y). - -% Has subterm to eval -eval_67(Eq,RetType,Depth,Self,[F|PredDecl],Res):- fail, - Depth>1, - quietly(sub_sterm1(SSub,PredDecl)), - mnotrace((ground(SSub),SSub=[_|Sub], is_list(Sub),maplist(atomic,SSub))), - eval(Eq,RetType,Depth,Self,SSub,Repl), - mnotrace((SSub\=Repl,subst(PredDecl,SSub,Repl,Temp))), - eval_defn(Eq,RetType,Depth,Self,[F|Temp],Res). - -%eval_67(Eq,RetType,Depth,Self,X,Y):- (eval_68(Eq,RetType,Depth,Self,X,Y)*->true;metta_atom_iter(Depth,Self,[=,X,Y])). -/* -eval_67_fail(Depth,Self,PredDecl,Res):- fail, - ((term_variables(PredDecl,Vars), - (metta_atom(Self,PredDecl) *-> (Vars ==[]->Res='True';Vars=Res); - (eval(Eq,RetType,Depth,Self,PredDecl,Res),ignore(Vars ==[]->Res='True';Vars=Res))))), - PredDecl\=@=Res. -*/ - -%eval_68(Eq,RetType,_Dpth,Self,[H|_],_):- mnotrace( \+ is_user_defined_head_f(Self,H) ), !,fail. -%eval_68(Eq,RetType,_Dpth,Self,[H|T1],Y):- metta_defn(Eq,Self,[H|T1],Y). -%eval_68(Eq,RetType,_Dpth,Self,[H|T1],'True'):- metta_atom(Self,[H|T1]). -%eval_68(Eq,RetType,_Dpth,Self,CALL,Y):- fail,append(Left,[Y],CALL),metta_defn(Eq,Self,Left,Y). - - -%eval_6(Depth,Self,['ift',CR,Then],RO):- fail, !, %fail, % trace, -% metta_defn(Eq,Self,['ift',R,Then],Become),eval(Eq,RetType,Depth,Self,CR,R),eval(Eq,RetType,Depth,Self,Then,_True),eval(Eq,RetType,Depth,Self,Become,RO). - - -%not_compound(Term):- \+ is_list(Term),!. -%eval_40(Eq,RetType,Depth,Self,Term,Res):- maplist(not_compound,Term),!,eval_645(Depth,Self,Term,Res). - - -% function inherited by system -/* -eval_80(Eq,RetType,Depth,Self,[F|X],FY):- is_function(F), \+ is_special_op(F), is_list(X), - maplist(eval(Eq,ArgTypes,Depth,Self),X,Y),!, - eval_maybe_subst(Depth,Self,[F|Y],FY). - -eval_80(Eq,RetType,Depth,Self,FX,FY):- eval_maybe_subst(Depth,Self,FX,FY). - -eval_maybe_subst(Depth,Self,[AE|More],TF):- length(More,Len), - (is_syspred(AE,Len,Pred),catch_warn(as_tf(apply(Pred,More),TF)))*->true;eval_86(Depth,Self,[AE|More],TF). -eval_86(_Dpth,_Slf,[AE|More],TF):- length([AE|More],Len), is_syspred(AE,Len,Pred),append(More,[TF],Args),!,catch_warn(apply(Pred,Args)). -*/ -%eval_80(Eq,RetType,Depth,Self,[X1|[F2|X2]],[Y1|Y2]):- is_function(F2),!,eval(Eq,RetType,Depth,Self,[F2|X2],Y2),eval(Eq,RetType,Depth,Self,X1,Y1). - - -% ================================================================= -% ================================================================= -% ================================================================= -% AGREGATES -% ================================================================= -% ================================================================= -% ================================================================= - -cwdl(DL,Goal):- call_with_depth_limit(Goal,DL,R), (R==depth_limit_exceeded->(!,fail);true). - -%bagof_eval(Eq,RetType,Depth,Self,X,L):- bagof_eval(Eq,RetType,_RT,Depth,Self,X,L). - - -%bagof_eval(Eq,RetType,Depth,Self,X,S):- bagof(E,eval_ne(Eq,RetType,Depth,Self,X,E),S)*->true;S=[]. -bagof_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- typed_list(X,_Type,L),!. -bagof_eval(Eq,RetType,Depth,Self,X,L):- - findall(E,eval_ne(Eq,RetType,Depth,Self,X,E),L). - -setof_eval(Depth,Self,X,L):- setof_eval('=',_RT,Depth,Self,X,L). -setof_eval(Eq,RetType,Depth,Self,X,S):- bagof_eval(Eq,RetType,Depth,Self,X,L), - sort(L,S). - - -eval_ne(Eq,RetType,Depth,Self,X,E):- - eval(Eq,RetType,Depth,Self,X,E), \+ var(E), \+ is_empty(E). - - - - -:- ensure_loaded(metta_subst). diff --git a/.Attic/metta_lang/metta_interp.new b/.Attic/metta_lang/metta_interp.new deleted file mode 100755 index b7c3898d074..00000000000 --- a/.Attic/metta_lang/metta_interp.new +++ /dev/null @@ -1,1921 +0,0 @@ -:- encoding(iso_latin_1). -:- multifile(is_metta_data_functor/1). -:- dynamic(is_metta_data_functor/1). -:- multifile(is_nb_space/1). -:- dynamic(is_nb_space/1). -%:- '$set_source_module'('user'). -:- set_stream(user_input,tty(true)). -:- use_module(library(readline)). -:- use_module(library(editline)). -:- use_module(library(filesex)). -:- use_module(library(shell)). -%:- use_module(library(tabling)). -:- use_module(library(system)). -:- ensure_loaded(metta_compiler). -%:- ensure_loaded(metta_types). -:- ensure_loaded(metta_data). -:- ensure_loaded(metta_space). -:- ensure_loaded(metta_eval). -:- set_stream(user_input,tty(true)). -:- set_prolog_flag(encoding,iso_latin_1). -:- set_prolog_flag(encoding,utf8). -%:- set_prolog_flag(encoding,octet). -/* -Now PASSING NARS.TEC:\opt\logicmoo_workspace\packs_sys\logicmoo_opencog\MeTTa\hyperon-wam\src\pyswip\metta_interp.pl -C:\opt\logicmoo_workspace\packs_sys\logicmoo_opencog\MeTTa\hyperon-wam\src\pyswip1\metta_interp.pl -STS1.01) -Now PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.08) -Now PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.14) -Now PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.15) -Now PASSING TEST-SCRIPTS.C1-GROUNDED-BASIC.15) -Now PASSING TEST-SCRIPTS.E2-STATES.08) -PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.02) -PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.07) -PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.09) -PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.11) -PASSING TEST-SCRIPTS.C1-GROUNDED-BASIC.14) -PASSING TEST-SCRIPTS.E2-STATES.07) ------------------------------------------ -FAILING TEST-SCRIPTS.D5-AUTO-TYPES.01) -Now FAILING TEST-SCRIPTS.00-LANG-CASE.03) -Now FAILING TEST-SCRIPTS.B5-TYPES-PRELIM.19) -Now FAILING TEST-SCRIPTS.C1-GROUNDED-BASIC.20) - -*/ - - -option_value_def('repl',auto). -option_value_def('prolog',false). -option_value_def('compile',false). -option_value_def('table',false). -option_value_def(no_repeats,false). -option_value_def('time',true). -option_value_def('exec',true). -option_value_def('html',false). -option_value_def('python',false). -option_value_def('halt',false). -option_value_def('doing_repl',false). -option_value_def('test-retval',false). -option_value_def('trace-length',100). -option_value_def('stack-max',100). -option_value_def('trace-on-overtime',20.0). -option_value_def('trace-on-overflow',false). -option_value_def('trace-on-error',true). -option_value_def('trace-on-load',true). -option_value_def('trace-on-exec',true). -option_value_def('trace-on-eval',true). -option_value_def('trace-on-fail',false). -option_value_def('trace-on-pass',false). - - - - -set_is_unit_test(TF):- - set_option_value('trace-on-load',TF), - set_option_value('trace-on-exec',TF), - set_option_value('trace-on-eval',TF), - set_option_value('trace-on-pass',false), - set_option_value('trace-on-fail',false), - set_option_value('exec',rtrace), - set_option_value('eval',rtrace), - !. - -:- set_is_unit_test(true). -%:- set_is_unit_test. - -trace_on_fail:- option_value('trace-on-fail',true). -trace_on_overflow:- option_value('trace-on-overflow',true). -trace_on_pass:- option_value('trace-on-pass',true). -doing_repl:- option_value('doing_repl',true). -if_repl(Goal):- doing_repl->call(Goal);true. - -any_floats(S):- member(E,S),float(E),!. - -% ============================ -% %%%% Arithmetic Operations -% ============================ -%:- use_module(library(clpfd)). -:- use_module(library(clpq)). -%:- use_module(library(clpr)). - -% Addition -%'+'(Addend1, Addend2, Sum):- \+ any_floats([Addend1, Addend2, Sum]),!,Sum #= Addend1+Addend2 . -'+'(Addend1, Addend2, Sum):- notrace(catch_err(plus(Addend1, Addend2, Sum),_,fail)),!. -'+'(Addend1, Addend2, Sum):- {Sum = Addend1+Addend2}. -% Subtraction -'-'(Sum, Addend1, Addend2):- '+'(Addend1, Addend2, Sum). - -% Multiplication -'*'(Factor1, Factor2, Product):- {Product = Factor1*Factor2}. -% Division -'/'(Dividend, Divisor, Quotient):- {Dividend = Quotient * Divisor}. -% Modulus -'mod'(Dividend, Divisor, Remainder):- {Remainder = Dividend mod Divisor}. -% Exponentiation -'exp'(Base, Exponent, Result):- eval_H(['exp', Base, Exponent], Result). -% Square Root -'sqrt'(Number, Root):- eval_H(['sqrt', Number], Root). - -% ============================ -% %%%% List Operations -% ============================ -% Retrieve Head of the List -'car-atom'(List, Head):- eval_H(['car-atom', List], Head). -% Retrieve Tail of the List -'cdr-atom'(List, Tail):- eval_H(['cdr-atom', List], Tail). -% Construct a List -'Cons'(Element, List, 'Cons'(Element, List)):- !. -% Collapse List -'collapse'(List, CollapsedList):- eval_H(['collapse', List], CollapsedList). -% Count Elements in List -'CountElement'(List, Count):- eval_H(['CountElement', List], Count). -% Find Length of List -%'length'(List, Length):- eval_H(['length', List], Length). - -% ============================ -% %%%% Nondet Opteration -% ============================ -% Superpose a List -'superpose'(List, SuperposedList):- eval_H(['superpose', List], SuperposedList). - -% ============================ -% %%%% Testing -% ============================ - -% `assertEqual` Predicate -% This predicate is used for asserting that the Expected value is equal to the Actual value. -% Expected: The value that is expected. -% Actual: The value that is being checked against the Expected value. -% Result: The result of the evaluation of the equality. -% Example: `assertEqual(5, 5, Result).` would succeed, setting Result to true (or some success indicator). -%'assertEqual'(Expected, Actual, Result):- use_metta_compiler,!,as_tf((Expected=Actual),Result). -'assertEqual'(Expected, Actual, Result):- ignore(Expected=Actual), eval_H(['assertEqual', Expected, Actual], Result). - -% `assertEqualToResult` Predicate -% This predicate asserts that the Expected value is equal to the Result of evaluating Actual. -% Expected: The value that is expected. -% Actual: The expression whose evaluation is being checked against the Expected value. -% Result: The result of the evaluation of the equality. -% Example: If Actual evaluates to the Expected value, this would succeed, setting Result to true (or some success indicator). -'assertEqualToResult'(Expected, Actual, Result):- eval_H(['assertEqualToResult', Expected, Actual], Result). - -% `assertFalse` Predicate -% This predicate is used to assert that the evaluation of EvalThis is false. -% EvalThis: The expression that is being evaluated and checked for falsehood. -% Result: The result of the evaluation. -% Example: `assertFalse((1 > 2), Result).` would succeed, setting Result to true (or some success indicator), as 1 > 2 is false. -'assertFalse'(EvalThis, Result):- eval_H(['assertFalse', EvalThis], Result). - -% `assertNotEqual` Predicate -% This predicate asserts that the Expected value is not equal to the Actual value. -% Expected: The value that is expected not to match the Actual value. -% Actual: The value that is being checked against the Expected value. -% Result: The result of the evaluation of the inequality. -% Example: `assertNotEqual(5, 6, Result).` would succeed, setting Result to true (or some success indicator). -'assertNotEqual'(Expected, Actual, Result):- eval_H(['assertNotEqual', Expected, Actual], Result). - -% `assertTrue` Predicate -% This predicate is used to assert that the evaluation of EvalThis is true. -% EvalThis: The expression that is being evaluated and checked for truth. -% Result: The result of the evaluation. -% Example: `assertTrue((2 > 1), Result).` would succeed, setting Result to true (or some success indicator), as 2 > 1 is true. -'assertTrue'(EvalThis, Result):- eval_H(['assertTrue', EvalThis], Result). - -% `rtrace` Predicate -% This predicate is likely used for debugging; possibly for tracing the evaluation of Condition. -% Condition: The condition/expression being traced. -% EvalResult: The result of the evaluation of Condition. -% Example: `rtrace((2 + 2), EvalResult).` would trace the evaluation of 2 + 2 and store its result in EvalResult. -'rtrace'(Condition, EvalResult):- eval_H(['rtrace', Condition], EvalResult). - -% `time` Predicate -% This predicate is used to measure the time taken to evaluate EvalThis. -% EvalThis: The expression whose evaluation time is being measured. -% EvalResult: The result of the evaluation of EvalThis. -% Example: `time((factorial(5)), EvalResult).` would measure the time taken to evaluate factorial(5) and store its result in EvalResult. -'time'(EvalThis, EvalResult):- eval_H(['time', EvalThis], EvalResult). - -% ============================ -% %%%% Debugging, Printing and Utility Operations -% ============================ -% REPL Evaluation -'repl!'(EvalResult):- eval_H(['repl!'], EvalResult). -% Condition Evaluation -'!'(Condition, EvalResult):- eval_H(['!', Condition], EvalResult). -% Import File into Environment -'import!'(Environment, Filename, Namespace):- eval_H(['import!', Environment, Filename], Namespace). -% Evaluate Expression with Pragma -'pragma!'(Environment, Expression, EvalValue):- eval_H(['pragma!', Environment, Expression], EvalValue). -% Print Message to Console -'print'(Message, EvalResult):- eval_H(['print', Message], EvalResult). -% No Operation, Returns EvalResult unchanged -'nop'(Expression, EvalResult):- eval_H(['nop', Expression], EvalResult). - -% ============================ -% %%%% Variable Bindings -% ============================ -% Bind Variables -'bind!'(Environment, Variable, Value):- eval_H(['bind!', Environment, Variable], Value). -% Let binding for single variable -'let'(Variable, Expression, Body, Result):- eval_H(['let', Variable, Expression, Body], Result). -% Sequential let binding -'let*'(Bindings, Body, Result):- eval_H(['let*', Bindings, Body], Result). - -% ============================ -% %%%% Reflection -% ============================ -% Get Type of Value -'get-type'(Value, Type):- eval_H(['get-type', Value], Type). - - -metta_cmd_args(Rest):- current_prolog_flag(late_metta_opts,Rest),!. -metta_cmd_args(Rest):- current_prolog_flag(argv,P),append(_,['--'|Rest],P),!. -metta_cmd_args(Rest):- current_prolog_flag(os_argv,P),append(_,['--'|Rest],P),!. -metta_cmd_args(Rest):- current_prolog_flag(argv,Rest). -run_cmd_args:- metta_cmd_args(Rest), !, do_cmdline_load_metta('&self',Rest). - - -metta_make_hook:- loonit_reset, option_value(not_a_reload,true),!. -metta_make_hook:- - metta_cmd_args(Rest), into_reload_options(Rest,Reload), cmdline_load_metta('&self',Reload). - -:- multifile(prolog:make_hook/2). -:- dynamic(prolog:make_hook/2). -prolog:make_hook(after, _Some):- nop( metta_make_hook). - -into_reload_options(Reload,Reload). - -is_cmd_option(Opt,M, TF):- atom(M), - atom_concat('-',Opt,Flag), - atom_contains(M,Flag),!, - get_flag_value(M,FV), - TF=FV. - -get_flag_value(M,V):- atomic_list_concat([_,V],'=',M),!. -get_flag_value(M,false):- atom_contains(M,'-no'),!. -get_flag_value(_,true). - - -:- ignore((( - \+ prolog_load_context(reloading,true), - forall(option_value_def(Opt,Default),set_option_value(Opt,Default))))). - -%process_option_value_def:- \+ option_value('python',false), skip(ensure_loaded(metta_python)). -process_option_value_def:- option_value('python',load), ensure_loaded(src/main/metta_python). -process_option_value_def. - - -%process_late_opts:- once(option_value('html',true)), once(shell('./total_loonits.sh')). -process_late_opts:- current_prolog_flag(os_argv,[_]),!,ignore(repl). -process_late_opts:- forall(process_option_value_def,true). -%process_late_opts:- halt(7). -process_late_opts. - -%do_cmdline_load_metta(_Slf,Rest):- select('--prolog',Rest,RRest),!, -% set_option_value('prolog',true), -% set_prolog_flag(late_metta_opts,RRest). -do_cmdline_load_metta(Self,Rest):- - set_prolog_flag(late_metta_opts,Rest), - forall(process_option_value_def,true), - cmdline_load_metta(Self,Rest),!, - forall(process_late_opts,true). - -load_metta_file(Self,Filemask):- atom_concat(_,'.metta',Filemask),!, load_metta(Self,Filemask). -load_metta_file(_Slf,Filemask):- load_flybase(Filemask). - -% done -cmdline_load_metta(_,Nil):- Nil==[],!. -cmdline_load_metta(Self,[Filemask|Rest]):- atom(Filemask), \+ atom_concat('-',_,Filemask), - must_det_ll((Src=load_metta_file(Self,Filemask),nl,write('; '),write_src(Src),nl,catch_red(Src),!,flush_output, - cmdline_load_metta(Self,Rest))). - -cmdline_load_metta(Self,['-g',M|Rest]):- - read_term_from_atom(M, Term, []), - ignore(call(Term)), - cmdline_load_metta(Self,Rest). - -cmdline_load_metta(Self,[M|Rest]):- - m_opt(M,Opt),!, - is_cmd_option(Opt,M,TF),!, - format('~N'),write(' ; '), write_src(is_cmd_option(Opt,M,TF)), nl, !, set_option_value(Opt,TF), - set_tty_color_term(true), - cmdline_load_metta(Self,Rest). - -cmdline_load_metta(Self,[M|Rest]):- - format('~N'),write('; unused '), write_src(M), nl, !, - cmdline_load_metta(Self,Rest). - - -set_tty_color_term(TF):- - current_output(X),set_stream(X,tty(TF)), - set_stream(current_output,tty(TF)), - set_prolog_flag(color_term ,TF). - -m_opt(M,Opt):- - m_opt0(M,Opt1), - m_opt1(Opt1,Opt). - -m_opt1(Opt1,Opt):- atomic_list_concat([Opt|_],'=',Opt1). - -m_opt0(M,Opt):- atom_concat('--no-',Opt,M),!. -m_opt0(M,Opt):- atom_concat('--',Opt,M),!. -m_opt0(M,Opt):- atom_concat('-',Opt,M),!. - -:- set_prolog_flag(occurs_check,true). - -start_html_of(_Filename):- \+ tee_file(_TEE_FILE),!. -start_html_of(_Filename):- - must_det_ll(( - S = _, - %retractall(metta_defn(Eq,S,_,_)), - nop(retractall(metta_type(S,_,_))), - %retractall(get_metta_atom(Eq,S,_,_,_)), - loonit_reset, - tee_file(TEE_FILE), - sformat(S,'cat /dev/null > "~w"',[TEE_FILE]), - - writeln(doing(S)), - ignore(shell(S)))). - -save_html_of(_Filename):- \+ tee_file(_TEE_FILE),!. -save_html_of(_):- \+ has_loonit_results, \+ option_value('html',true). -save_html_of(Filename):- - must_det_ll(( - file_name_extension(Base,_,Filename), - file_name_extension(Base,'metta.html',HtmlFilename), - loonit_reset, - tee_file(TEE_FILE), - writeln('
Return to Summaries
'), - sformat(S,'ansi2html -u < "~w" > "~w" ',[TEE_FILE,HtmlFilename]), - writeln(doing(S)), - ignore(shell(S)))). - -tee_file(TEE_FILE):- getenv('TEE_FILE',TEE_FILE),!. -tee_file(TEE_FILE):- metta_dir(Dir),directory_file_path(Dir,'TEE.ansi',TEE_FILE),!. -metta_dir(Dir):- getenv('METTA_DIR',Dir),!. - -load_metta(Filename):- - %clear_spaces, - load_metta('&self',Filename). - - -load_metta(_Self,Filename):- Filename=='--repl',!,repl. -load_metta(Self,Filename):- - (\+ atom(Filename); \+ exists_file(Filename)),!, - with_wild_path(load_metta(Self),Filename),!,loonit_report. -load_metta(Self,RelFilename):- - atom(RelFilename), - exists_file(RelFilename),!, - absolute_file_name(RelFilename,Filename), - track_load_into_file(Filename, - include_metta(Self,RelFilename)). - -include_metta(Self,Filename):- - (\+ atom(Filename); \+ exists_file(Filename)),!, - must_det_ll(with_wild_path(include_metta(Self),Filename)),!. - -include_metta(Self,RelFilename):- - must_det_ll(( - atom(RelFilename), - exists_file(RelFilename),!, - absolute_file_name(RelFilename,Filename), - must_det_ll((setup_call_cleanup(open(Filename,read,In, [encoding(utf8)]), - ((directory_file_path(Directory, _, Filename), - assert(metta_file(Self,Filename,Directory)), - with_cwd(Directory, - must_det_ll( load_metta_file_stream(Filename,Self,In))))),close(In)))))). - -load_metta_file_stream(Filename,Self,In):- - with_option(loading_file,Filename, - %current_exec_file(Filename), - ((must_det_ll(( - set_exec_num(Filename,1), - load_answer_file(Filename), - set_exec_num(Filename,0))), - once((repeat, (( - ((nb_current(read_mode,Mode),Mode\==[])->true;Mode=load), - once(read_metta(In,Expr)), %write_src(read_metta=Expr),nl, - must_det_ll((do_metta(file(Filename),Mode,Self,Expr,_O)->true; - pp_m(unknown_do_metta(file(Filename),Mode,Self,Expr)))), - flush_output)), - at_end_of_stream(In)))))),!. - - -clear_spaces:- clear_space(_). -clear_space(S):- - %retractall(metta_defn(_,S,_,_)), - nop(retractall(metta_type(S,_,_))), - retractall(metta_atom_asserted(S,_)). - - -lsm:- lsm(_). -lsm(S):- - listing(metta_file(S,_,_)), - %listing(mdyn_type(S,_,_,_)), - forall(mdyn_type(S,_,_,Src),color_g_mesg('#22a5ff',write_f_src(Src))), - nl,nl,nl, - forall(mdyn_defn(S,_,_,Src),color_g_mesg('#00ffa5',write_f_src(Src))), - %listing(mdyn_defn(S,_,_,_)), - !. - -write_f_src(H,B):- H=@=B,!,write_f_src(H). -write_f_src(H,B):- write_f_src(['=',H,B]). - -hb_f(HB,ST):- sub_term(ST,HB),(atom(ST),ST\==(=),ST\==(:)),!. -write_f_src(HB):- - hb_f(HB,ST), - option_else(current_def,CST,[]),!, - (CST == ST -> true ; (nl,nl,nl,set_option_value(current_def,ST))), - write_src(HB). - - - -debug_only(G):- notrace(ignore(catch_warn(G))). -debug_only(_What,G):- ignore((fail,notrace(catch_warn(G)))). - - -'True':- true. -'False':- fail. - - -'mettalog::vspace-main':- repl. - -into_underscores(D,U):- atom(D),!,atomic_list_concat(L,'-',D),atomic_list_concat(L,'_',U). -into_underscores(D,U):- descend_and_transform(into_underscores,D,U),!. - -into_hyphens(D,U):- atom(D),!,atomic_list_concat(L,'_',D),atomic_list_concat(L,'-',U). -into_hyphens(D,U):- descend_and_transform(into_hyphens,D,U),!. - -descend_and_transform(P2, Input, Transformed) :- - ( var(Input) - -> Transformed = Input % Keep variables as they are - ; compound(Input) - -> (compound_name_arguments(Input, Functor, Args), - maplist(descend_and_transform(P2), Args, TransformedArgs), - compound_name_arguments(Transformed, Functor, TransformedArgs)) - ; (atom(Input),call(P2,Input,Transformed)) - -> true % Transform atoms using xform_atom/2 - ; Transformed = Input % Keep other non-compound terms as they are - ). - -/* -is_syspred(H,Len,Pred):- notrace(is_syspred0(H,Len,Pred)). -is_syspred0(H,_Ln,_Prd):- \+ atom(H),!,fail. -is_syspred0(H,_Ln,_Prd):- upcase_atom(H,U),downcase_atom(H,U),!,fail. -is_syspred0(H,Len,Pred):- current_predicate(H/Len),!,Pred=H. -is_syspred0(H,Len,Pred):- atom_concat(Mid,'!',H), H\==Mid, is_syspred0(Mid,Len,Pred),!. -is_syspred0(H,Len,Pred):- into_underscores(H,Mid), H\==Mid, is_syspred0(Mid,Len,Pred),!. - -fn_append(List,X,Call):- - fn_append1(List,X,ListX), - into_fp(ListX,Call). - - - - - -is_metta_data_functor(Eq,F):- - current_self(Self),is_metta_data_functor(Eq,Self,F). - -is_metta_data_functor(Eq,Other,H):- - metta_type(Other,H,_), - \+ get_metta_atom(Eq,Other,[H|_]), - \+ metta_defn(Eq,Other,[H|_],_). -*/ -is_function(F):- atom(F). - -is_False(X):- X\=='True', (is_False1(X)-> true ; (eval_H(X,Y),is_False1(Y))). -is_False1(Y):- (Y==0;Y==[];Y=='False'). - -is_conz(Self):- compound(Self), Self=[_|_]. - -%dont_x(eval_H(Depth,Self,metta_if(A=1,atom_concat(metta_,_,F). -needs_expanded(eval_H(Term,_),Expand):- !,sub_term(Expand,Term),compound(Expand),Expand\=@=Term, - compound(Expand), \+ is_conz(Expand), \+ is_ftVar(Expand), needs_expand(Expand). -needs_expanded([A|B],Expand):- sub_term(Expand,[A|B]), compound(Expand), \+ is_conz(Expand), \+ is_ftVar(Expand), needs_expand(Expand). - -fn_append1(eval_H(Term,X),X,eval_H(Term,X)):-!. -fn_append1(Term,X,eval_H(Term,X)). - - -% Check if parentheses are balanced in a list of characters -balanced_parentheses(Chars) :- balanced_parentheses(Chars, 0). -balanced_parentheses([], 0). -balanced_parentheses(['('|T], N) :- N1 is N + 1, balanced_parentheses(T, N1). -balanced_parentheses([')'|T], N) :- N > 0, N1 is N - 1, balanced_parentheses(T, N1). -balanced_parentheses([H|T], N) :- H \= '(', H \= ')', balanced_parentheses(T, N). -% Recursive function to read lines until parentheses are balanced. -repl_read(NewAccumulated, Expr):- - atom_concat(Atom, '.', NewAccumulated), - catch_err((read_term_from_atom(Atom, Term, []), Expr=call(Term)), E, - (write('Syntax error: '), writeq(E), nl, repl_read(Expr))),!. - - -repl_read("!", '!'):-!. -repl_read("+", '+'):-!. -repl_read(Str,Atom):- atom_string(Atom,Str),metta_interp_mode(Atom,_),!. - -repl_read(Str, Expr):- atom_concat('@',_,Str),!,atom_string(Expr,Str). -repl_read(NewAccumulated, Expr):- - normalize_space(string(Renew),NewAccumulated), Renew \== NewAccumulated, !, - repl_read(Renew, Expr). -%repl_read(NewAccumulated,exec(Expr)):- string_concat("!",Renew,NewAccumulated), !, repl_read(Renew, Expr). -repl_read(NewAccumulated, Expr):- string_chars(NewAccumulated, Chars), - balanced_parentheses(Chars), length(Chars, Len), Len > 0, - parse_sexpr_metta(NewAccumulated, Expr), !, - normalize_space(string(Renew),NewAccumulated), - add_history_string(Renew). -repl_read(Accumulated, Expr) :- read_line_to_string(current_input, Line), repl_read(Accumulated, Line, Expr). -repl_read(Accumulated, "", Expr):- !, repl_read(Accumulated, Expr). -repl_read(_Accumulated, Line, Expr):- Line == end_of_file, !, Expr = Line. -repl_read(Accumulated, Line, Expr) :- atomics_to_string([Accumulated," ",Line], NewAccumulated), !, - repl_read(NewAccumulated, Expr). - -repl_read(O2):- clause(t_l:s_reader_info(O2),_,Ref),erase(Ref). -repl_read(Expr) :- repeat, - remove_pending_buffer_codes(_,Was),text_to_string(Was,Str), - repl_read(Str, Expr1), - once(((atom(Expr1),atom_concat('@',_,Expr1), - \+ atom_contains(Expr1,"="), - repl_read(Expr2)) - -> Expr=[Expr1,Expr2] ; Expr1 = Expr)), - % this cutrs the repeat/0 - ((peek_pending_codes(_,Peek),Peek==[])->!;true). - -add_history_string(Str):- notrace(ignore(add_history01(Str))),!. - -add_history_src(Exec):- notrace(ignore((Exec\=[],with_output_to(string(H),with_indents(false,write_src(Exec))),add_history_string(H)))). - - -add_history_pl(Exec):- notrace(ignore((Exec\=[],with_output_to(string(H),with_indents(false,(writeq(Exec),writeln('.')))),add_history_string(H)))). - -read_metta1(_,O2):- clause(t_l:s_reader_info(O2),_,Ref),erase(Ref). -read_metta1(In,Expr):- current_input(In0),In==In0,!, repl_read(Expr). -read_metta1(In,Expr):- string(In),!,parse_sexpr_metta(In,Expr),!. -read_metta1(In,Expr):- peek_char(In,Char), read_metta1(In,Char,Expr). - -read_metta1(In,Char,Expr):- char_type(Char,white),get_char(In,Char),put(Char),!,read_metta1(In,Expr). -read_metta1(In,'!',Expr):- get_char(In,_), !, read_metta(In,Read1),!,Expr=exec(Read1). -read_metta1(In,';',Expr):- get_char(In,_), !, (maybe_read_pl(In,Expr)-> true ; (read_line_to_string(In,Str),write_comment(Str),!,read_metta(In,Expr))),!. -read_metta1(In,_,Expr):- maybe_read_pl(In,Expr),!. -read_metta1(In,_,Read1):- parse_sexpr_metta(In,Expr),!,must_det_ll(Expr=Read1). - - -maybe_read_pl(In,Expr):- - peek_line(In,Line1), Line1\=='', atom_contains(Line1, '.'),atom_contains(Line1, ':-'), - notrace(((catch_err((read_term_from_atom(Line1, Term, []), Term\==end_of_file, Expr=call(Term)),_, fail),!, - read_term(In, Term, [])))). -peek_line(In,Line1):- peek_string(In, 1024, Str), split_string(Str, "\r\n", "\s", [Line1,_|_]),!. -peek_line(In,Line1):- peek_string(In, 4096, Str), split_string(Str, "\r\n", "\s", [Line1,_|_]),!. - - - - -%read_line_to_sexpr(Stream,UnTyped), -read_sform(Str,F):- trace, string(Str),open_string(Str,S),!,read_sform(S,F). -read_sform(S,F):- - read_sform1(S,F1), - ( F1\=='!' -> F=F1 ; - (read_sform1(S,F2), F = exec(F2))). - -read_sform1(Str,F):- string(Str),open_string(Str,S),!,read_sform1(S,F). -read_sform1(S,F):- at_end_of_stream(S),!,F=end_of_file. -read_sform1(S,M):- peek_char(S,C),read_sform3(C,S,F), untyped_to_metta(F,M). -%read_sform1(S,F):- profile(parse_sexpr_metta(S,F)). - -read_sform3(C,S,F):- char_type(C,white),get_char(S,_),!,read_sform1(S,F). -read_sform3(';',S,'$COMMENT'(F,0,0)):- !, read_line_to_string(S,F). -read_sform3(';',S,F):- read_line_to_string(S,_),!,read_sform1(S,F). -read_sform3('!',S,exec(F)):- !,get_char(S,_),read_sform1(S,F). -read_sform3(_,S,F):- read_line_to_string(S,L),!,read_sform_cont(L,S,F). - -read_sform_cont(L,S,F):- L=="", !, read_sform1(S,F). -read_sform_cont(L,_S,F):- input_to_forms(L,F),!. -read_sform_cont(L,S,F):- read_line_to_string(S,L2), - atomic_to_string([L,' ',L2],L3),read_sform_cont(L3,S,F),!. - -in2_stream(N1,S1):- integer(N1),!,stream_property(S1,file_no(N1)),!. -in2_stream(N1,S1):- atom(N1),stream_property(S1,alias(N1)),!. -in2_stream(N1,S1):- is_stream(N1),S1=N1,!. -in2_stream(N1,S1):- atom(N1),stream_property(S1,file_name(N1)),!. -is_same_streams(N1,N2):- in2_stream(N1,S1),in2_stream(N2,S2),!,S1==S2. - -%read_metta(In,Expr):- current_input(CI), \+ is_same_streams(CI,In), !, read_sform(In,Expr). -read_metta(_,O2):- clause(t_l:s_reader_info(O2),_,Ref),erase(Ref). -read_metta(In,Expr):- current_input(In0),In==In0,!, repl_read(Expr). -read_metta(In,Expr):- - read_metta1(In,Read1), - (Read1=='!' - -> (read_metta1(In,Read2), Expr=exec(Read2), nop(add_history_src(Expr))) - ; Expr = Read1),!. - -parse_sexpr_metta(I,O):- string(I),normalize_space(string(M),I),parse_sexpr_metta1(M,O),!. -parse_sexpr_metta(I,O):- parse_sexpr_untyped(I,U),trly(untyped_to_metta,U,O). - -parse_sexpr_metta1(M,exec(O)):- string_concat('!',I,M),!,parse_sexpr_metta1(I,O). -parse_sexpr_metta1(M,(O)):- string_concat('+',I,M),!,parse_sexpr_metta1(I,O). -parse_sexpr_metta1(I,O):- parse_sexpr_untyped(I,U),trly(untyped_to_metta,U,O). - - -write_comment(_):- silent_loading,!. -write_comment(Cmt):- connlf,format(';;~w~n',[Cmt]). -do_metta_cmt(_,'$COMMENT'(Cmt,_,_)):- write_comment(Cmt),!. -do_metta_cmt(_,'$STRING'(Cmt)):- write_comment(Cmt),!. -do_metta_cmt(Self,[Cmt]):- !, do_metta_cmt(Self, Cmt),!. - - -mlog_sym('@'). - -%untyped_to_metta(I,exec(O)):- compound(I),I=exec(M),!,untyped_to_metta(M,O). -untyped_to_metta(I,O):- - must_det_ll(( - trly(mfix_vars1,I,M), - trly(cons_to_c,M,OM), - trly(cons_to_l,OM,O))). - - -trly(P2,A,B):- once(call(P2,A,M)),A\=@=M,!,trly(P2,M,B). -trly(_,A,A). - -mfix_vars1(I,O):- var(I),!,I=O. -mfix_vars1('$t','$VAR'('T')):-!. -mfix_vars1('$T','$VAR'('T')):-!. -%mfix_vars1(I,O):- I=='T',!,O='True'. -%mfix_vars1(I,O):- I=='F',!,O='False'. -%mfix_vars1(I,O):- is_i_nil(I),!,O=[]. -mfix_vars1(I,O):- I=='true',!,O='True'. -mfix_vars1(I,O):- I=='false',!,O='False'. -mfix_vars1('$STRING'(I),O):- option_value(strings,true),!, mfix_vars1(I,O). -mfix_vars1('$STRING'(I),O):- !, mfix_vars1(I,M),atom_chars(O,M),!. -%mfix_vars1('$STRING'(I),O):- !, mfix_vars1(I,M),name(O,M),!. -mfix_vars1([H|T],O):- H=='[', is_list(T), last(T,L),L==']',append(List,[L],T), !, O = ['[...]',List]. -mfix_vars1([H|T],O):- H=='{', is_list(T), last(T,L),L=='}',append(List,[L],T), !, O = ['{...}',List]. -mfix_vars1('$OBJ'(claz_bracket_vector,List),O):- is_list(List),!, O = ['[...]',List]. -mfix_vars1(I,O):- I = ['[', X, ']'], nonvar(X), !, O = ['[...]',X]. -mfix_vars1(I,O):- I = ['{', X, '}'], nonvar(X), !, O = ['{...}',X]. -mfix_vars1('$OBJ'(claz_bracket_vector,List),Res):- is_list(List),!, append(['['|List],[']'],Res),!. -mfix_vars1(I,O):- I==[Quote, S], Quote==quote,S==s,!, O=is. -mfix_vars1([K,H|T],Cmpd):- atom(K),mlog_sym(K),is_list(T),mfix_vars1([H|T],[HH|TT]),atom(HH),is_list(TT),!, - compound_name_arguments(Cmpd,HH,TT). -%mfix_vars1([H|T],[HH|TT]):- !, mfix_vars1(H,HH),mfix_vars1(T,TT). -mfix_vars1(List,ListO):- is_list(List),!,maplist(mfix_vars1,List,ListO). -mfix_vars1(I,O):- string(I),option_value('string-are-atoms',true),!,atom_string(O,I). - -mfix_vars1(I,O):- compound(I),!,compound_name_arguments(I,F,II),F\=='$VAR',maplist(mfix_vars1,II,OO),!,compound_name_arguments(O,F,OO). -mfix_vars1(I,O):- \+ atom(I),!,I=O. -mfix_vars1(I,'$VAR'(O)):- atom_concat('$',N,I),dvar_name(N,O),!. -mfix_vars1(I,I). - -no_cons_reduce. - -dvar_name(t,'T'):- !. -dvar_name(N,O):- atom(N),atom_number(N,Num),atom_concat('Num',Num,M),!,svar_fixvarname(M,O). -dvar_name(N,O):- number(N),atom_concat('Num',N,M),!,svar_fixvarname(M,O). -dvar_name(N,O):- \+ atom(N),!,format(atom(A),'~w',[N]),dvar_name(A,O). -dvar_name('','__'):-!. % "$" -dvar_name('_','_'):-!. % "$_" -dvar_name(N,O):- svar_fixvarname(N,O),!. -dvar_name(N,O):- must_det_ll((atom_chars(N,Lst),maplist(c2vn,Lst,NList),atomic_list_concat(NList,S),svar_fixvarname(S,O))),!. -c2vn(A,A):- char_type(A,prolog_identifier_continue),!. -c2vn(A,A):- char_type(A,prolog_var_start),!. -c2vn(A,AA):- char_code(A,C),atomic_list_concat(['_C',C,'_'],AA). - -cons_to_l(I,I):- no_cons_reduce,!. -cons_to_l(I,O):- var(I),!,O=I. -cons_to_l(I,O):- is_i_nil(I),!,O=[]. -cons_to_l(I,O):- I=='nil',!,O=[]. -cons_to_l(C,O):- \+ compound(C),!,O=C. -cons_to_l([Cons,H,T|List],[HH|TT]):- List==[], atom(Cons),is_cons_f(Cons), t_is_ttable(T), cons_to_l(H,HH),!,cons_to_l(T,TT). -cons_to_l(List,ListO):- is_list(List),!,maplist(cons_to_l,List,ListO). -cons_to_l(I,I). - -cons_to_c(I,I):- no_cons_reduce,!. -cons_to_c(I,O):- var(I),!,O=I. -cons_to_c(I,O):- is_i_nil(I),!,O=[]. -cons_to_c(I,O):- I=='nil',!,O=[]. -cons_to_c(C,O):- \+ compound(C),!,O=C. -cons_to_c([Cons,H,T|List],[HH|TT]):- List==[], atom(Cons),is_cons_f(Cons), t_is_ttable(T), cons_to_c(H,HH),!,cons_to_c(T,TT). -cons_to_c(I,O):- \+ is_list(I), compound_name_arguments(I,F,II),maplist(cons_to_c,II,OO),!,compound_name_arguments(O,F,OO). -cons_to_c(I,I). - - - -t_is_ttable(T):- var(T),!. -t_is_ttable(T):- is_i_nil(T),!. -t_is_ttable(T):- is_ftVar(T),!. -t_is_ttable([F|Args]):- F=='Cons',!,is_list(Args). -t_is_ttable([_|Args]):- !, \+ is_list(Args). -t_is_ttable(_). - -is_cons_f(Cons):- is_cf_nil(Cons,_). -is_cf_nil('Cons','NNNil'). -%is_cf_nil('::','nil'). - -is_i_nil(I):- - is_cf_nil('Cons',Nil), I == Nil. - -subst_vars(TermWDV, NewTerm):- - subst_vars(TermWDV, NewTerm, NamedVarsList), - maybe_set_var_names(NamedVarsList). - -subst_vars(TermWDV, NewTerm, NamedVarsList) :- - subst_vars(TermWDV, NewTerm, [], NamedVarsList). - -subst_vars(Term, Term, NamedVarsList, NamedVarsList) :- var(Term), !. -subst_vars([], [], NamedVarsList, NamedVarsList):- !. -subst_vars([TermWDV|RestWDV], [Term|Rest], Acc, NamedVarsList) :- !, - subst_vars(TermWDV, Term, Acc, IntermediateNamedVarsList), - subst_vars(RestWDV, Rest, IntermediateNamedVarsList, NamedVarsList). -subst_vars('$VAR'('_'), _, NamedVarsList, NamedVarsList) :- !. -subst_vars('$VAR'(VName), Var, Acc, NamedVarsList) :- nonvar(VName), svar_fixvarname(VName,Name), !, - (memberchk(Name=Var, Acc) -> NamedVarsList = Acc ; ( !, Var = _, NamedVarsList = [Name=Var|Acc])). -subst_vars(Term, Var, Acc, NamedVarsList) :- atom(Term),atom_concat('$',DName,Term), - dvar_name(DName,Name),!,subst_vars('$VAR'(Name), Var, Acc, NamedVarsList). - -subst_vars(TermWDV, NewTerm, Acc, NamedVarsList) :- - compound(TermWDV), !, - compound_name_arguments(TermWDV, Functor, ArgsWDV), - subst_vars(ArgsWDV, Args, Acc, NamedVarsList), - compound_name_arguments(NewTerm, Functor, Args). -subst_vars(Term, Term, NamedVarsList, NamedVarsList). - - - -:- nb_setval(variable_names,[]). - - -assert_preds(_Self,_Load,_Preds):- \+ preview_compiler,!. -assert_preds(_Self,Load,Preds):- - expand_to_hb(Preds,H,_B),functor(H,F,A), - color_g_mesg('#005288',( - ignore(( - \+ predicate_property(H,defined), - if_t(use_metta_compiler,catch_i(dynamic(F,A))), - format(' :- ~q.~n',[dynamic(F/A)]), - if_t(option_value('tabling',true), format(' :- ~q.~n',[table(F/A)])))), - if_t((preview_compiler), - format('~N~n ~@',[portray_clause(Preds)])), - if_t(use_metta_compiler,if_t(\+ predicate_property(H,static),add_assertion(Preds))))), - nop(metta_anew1(Load,Preds)). - - -%load_hook(_Load,_Hooked):- !. -load_hook(Load,Hooked):- ignore(( \+ ((forall(load_hook0(Load,Hooked),true))))),!. - -load_hook0(_,_):- \+ current_prolog_flag(metta_interp,ready),!. -load_hook0(_,_):- \+ preview_compiler,!. -load_hook0(Load,metta_defn(=,Self,H,B)):- - functs_to_preds([=,H,B],Preds), - assert_preds(Self,Load,Preds). -/* -load_hook0(Load,get_metta_atom(Eq,Self,H)):- B = 'True', - H\=[':'|_], functs_to_preds([=,H,B],Preds), - assert_preds(Self,Load,Preds). -*/ - -use_metta_compiler:- notrace(option_value('compile','full')), !. -preview_compiler:- \+ option_value('compile',false), !. -%preview_compiler:- use_metta_compiler,!. - - - -op_decl(match, [ 'Space', 'Atom', 'Atom'], '%Undefined%'). -op_decl('remove-atom', [ 'Space', 'Atom'], 'EmptyType'). -op_decl('add-atom', [ 'Space', 'Atom'], 'EmptyType'). -op_decl('get-atoms', [ 'Space' ], 'Atom'). - -op_decl('car-atom', [ 'Expression' ], 'Atom'). -op_decl('cdr-atom', [ 'Expression' ], 'Expression'). - -op_decl(let, [ 'Atom', '%Undefined%', 'Atom' ], 'Atom'). -op_decl('let*', [ 'Expression', 'Atom' ], 'Atom'). - -op_decl(and, [ 'Bool', 'Bool' ], 'Bool'). -op_decl(or, [ 'Bool', 'Bool' ], 'Bool'). -op_decl(case, [ 'Expression', 'Atom' ], 'Atom'). -/* -op_decl(apply, [ 'Atom', 'Variable', 'Atom' ], 'Atom'). -op_decl(chain, [ 'Atom', 'Variable', 'Atom' ], 'Atom'). -op_decl('filter-atom', [ 'Expression', 'Variable', 'Atom' ], 'Expression'). -op_decl('foldl-atom', [ 'Expression', 'Atom', 'Variable', 'Variable', 'Atom' ], 'Atom'). -op_decl('map-atom', [ 'Expression', 'Variable', 'Atom' ], 'Expression'). -op_decl(quote, [ 'Atom' ], 'Atom'). -op_decl('if-decons', [ 'Atom', 'Variable', 'Variable', 'Atom', 'Atom' ], 'Atom'). -op_decl('if-empty', [ 'Atom', 'Atom', 'Atom' ], 'Atom'). -op_decl('if-error', [ 'Atom', 'Atom', 'Atom' ], 'Atom'). -op_decl('if-non-empty-expression', [ 'Atom', 'Atom', 'Atom' ], 'Atom'). -op_decl('if-not-reducible', [ 'Atom', 'Atom', 'Atom' ], 'Atom'). -op_decl(return, [ 'Atom' ], 'ReturnType'). -op_decl('return-on-error', [ 'Atom', 'Atom'], 'Atom'). -op_decl(unquote, [ '%Undefined%'], '%Undefined%'). -op_decl(cons, [ 'Atom', 'Atom' ], 'Atom'). -op_decl(decons, [ 'Atom' ], 'Atom'). -op_decl(empty, [], '%Undefined%'). -op_decl('Error', [ 'Atom', 'Atom' ], 'ErrorType'). -op_decl(eval, [ 'Atom' ], 'Atom'). -op_decl(function, [ 'Atom' ], 'Atom'). -op_decl(id, [ 'Atom' ], 'Atom'). -op_decl(unify, [ 'Atom', 'Atom', 'Atom', 'Atom' ], 'Atom'). -*/ -op_decl(unify, [ 'Atom', 'Atom', 'Atom', 'Atom'], '%Undefined%'). -op_decl(if, [ 'Bool', 'Atom', 'Atom'], _T). -op_decl('%', [ 'Number', 'Number' ], 'Number'). -op_decl('*', [ 'Number', 'Number' ], 'Number'). -op_decl('-', [ 'Number', 'Number' ], 'Number'). -op_decl('+', [ 'Number', 'Number' ], 'Number'). -op_decl(combine, [ X, X], X). - -op_decl('bind!', ['Symbol','%Undefined%'], 'EmptyType'). -op_decl('import!', ['Space','Atom'], 'EmptyType'). -op_decl('get-type', ['Atom'], 'Atom'). - -type_decl('Any'). -type_decl('Atom'). -type_decl('Bool'). -type_decl('ErrorType'). -type_decl('Expression'). -type_decl('Number'). -type_decl('ReturnType'). -type_decl('Space'). -type_decl('Symbol'). -type_decl('MemoizedState'). -type_decl('Type'). -type_decl('%Undefined%'). -type_decl('Variable'). - -:- dynamic(get_metta_atom/2). -:- dynamic(metta_atom_asserted/2). -metta_atom_stdlib([:, Type, 'Type']):- type_decl(Type). -metta_atom_stdlib([:, Op, [->|List]]):- op_decl(Op,Params,ReturnType),append(Params,[ReturnType],List). - -%get_metta_atom(Eq,KB, [F|List]):- KB='&flybase',fb_pred(F, Len), length(List,Len),apply(F,List). - - -get_metta_atom(Eq,Space, Atom):- get_metta_atom_from(Space, Atom), \+ (Atom =[EQ,_,_], EQ==Eq). - -get_metta_atom_from(KB, [F, A| List]):- KB='&flybase',fb_pred(F, Len), length([A|List],Len),apply(F,[A|List]). -get_metta_atom_from([Superpose,ListOf], Atom):- Superpose == 'superpose',is_list(ListOf),!,member(KB,ListOf),get_metta_atom_from(KB,Atom). -get_metta_atom_from(Space, Atom):- typed_list(Space,_,L),!, member(Atom,L). -get_metta_atom_from(KB,Atom):- (KB=='&self'; KB='&stdlib'), metta_atom_stdlib(Atom). -get_metta_atom_from(KB,Atom):- if_or_else(metta_atom_asserted( KB,Atom),metta_atom_asserted_fallback( KB,Atom)). - -metta_atom_asserted_fallback( KB,Atom):- fail, is_list(KB),!, member(Atom,KB). -%metta_atom_asserted_fallback( KB,Atom):- get_metta_atom_from(KB,Atom) - -%metta_atom(KB,[F,A|List]):- metta_atom(KB,F,A,List), F \== '=',!. -metta_defn(Eq,KB,Head,Body):- ignore(Eq = '='), get_metta_atom_from(KB,[Eq,Head,Body]). -metta_type(S,H,B):- get_metta_atom_from(S,[':',H,B]). -%typed_list(Cmpd,Type,List):- compound(Cmpd), Cmpd\=[_|_], compound_name_arguments(Cmpd,Type,[List|_]),is_list(List). - - -%maybe_xform(metta_atom(KB,[F,A|List]),metta_atom(KB,F,A,List)):- is_list(List),!. -maybe_xform(metta_defn(Eq,KB,Head,Body),metta_atom(KB,[Eq,Head,Body])). -maybe_xform(metta_type(KB,Head,Body),metta_atom(KB,[':',Head,Body])). -maybe_xform(metta_atom(KB,HeadBody),metta_atom_asserted(KB,HeadBody)). -maybe_xform(_OBO,_XForm):- !, fail. - -metta_anew1(Load,_OBO):- var(Load),trace,!. -metta_anew1(Load,OBO):- maybe_xform(OBO,XForm),!,metta_anew1(Load,XForm). - -metta_anew1(Ch,OBO):- metta_interp_mode(Ch,Mode), !, metta_anew1(Mode,OBO). -metta_anew1(load,OBO):- OBO= metta_atom(Space,Atom),!,'add-atom'(Space, Atom). -metta_anew1(unload,OBO):- OBO= metta_atom(Space,Atom),!,'remove-atom'(Space, Atom). - -metta_anew1(load,OBO):- !, must_det_ll((load_hook(load,OBO), - subst_vars(OBO,Cl),show_failure(assertz_if_new(Cl)))). %to_metta(Cl). -metta_anew1(unload,OBO):- subst_vars(OBO,Cl),load_hook(unload,OBO), - expand_to_hb(Cl,Head,Body), - predicate_property(Head,number_of_clauses(_)), - ignore((clause(Head,Body,Ref),clause(Head2,Body2,Ref),(Head+Body)=@=(Head2+Body2),erase(Ref),pp_m(Cl))). - -metta_anew2(Load,_OBO):- var(Load),trace,!. -metta_anew2(Load,OBO):- maybe_xform(OBO,XForm),!,metta_anew2(Load,XForm). -metta_anew2(Ch,OBO):- metta_interp_mode(Ch,Mode), !, metta_anew2(Mode,OBO). -metta_anew2(load,OBO):- must_det_ll((load_hook(load,OBO),subst_vars_not_last(OBO,Cl),assertz_if_new(Cl))). %to_metta(Cl). -metta_anew2(unload,OBO):- subst_vars_not_last(OBO,Cl),load_hook(unload,OBO), - expand_to_hb(Cl,Head,Body), - predicate_property(Head,number_of_clauses(_)), - ignore((clause(Head,Body,Ref),clause(Head2,Body2,Ref),(Head+Body)=@=(Head2+Body2),erase(Ref),pp_m(Cl))). - - -metta_anew(Ch,Src,OBO):- metta_interp_mode(Ch,Mode), !, metta_anew(Mode,Src,OBO). -metta_anew(Load,_Src,OBO):- silent_loading,!,metta_anew1(Load,OBO). -metta_anew(Load,Src,OBO):- maybe_xform(OBO,XForm),!,metta_anew(Load,Src,XForm). -metta_anew(Load,Src,OBO):- format('~N'), color_g_mesg('#0f0f0f',(write(' ; Action: '),writeq(Load=OBO))), - color_g_mesg('#ffa500', write_src(Src)), - metta_anew1(Load,OBO),format('~n'). - -subst_vars_not_last(A,B):- - functor(A,_F,N),arg(N,A,E), - subst_vars(A,B), - nb_setarg(N,B,E),!. - -con_write(W):-check_silent_loading, write(W). -con_writeq(W):-check_silent_loading, writeq(W). -writeqln(Q):- check_silent_loading,write(' '),con_writeq(Q),connl. - -connlf:- check_silent_loading, format('~N'). -connl:- check_silent_loading,nl. -% check_silent_loading:- silent_loading,!,trace,break. -check_silent_loading. -silent_loading:- is_converting,!. -silent_loading:- \+ option_value('trace-on-load',true), !. - - - -uncompound(OBO,Src):- \+ compound(OBO),!, Src = OBO. -uncompound('$VAR'(OBO),'$VAR'(OBO)):-!. -uncompound(IsList,Src):- is_list(IsList),!,maplist(uncompound,IsList,Src). -uncompound([Is|NotList],[SrcH|SrcT]):-!, uncompound(Is,SrcH),uncompound(NotList,SrcT). -uncompound(Compound,Src):- compound_name_arguments(Compound,Name,Args),maplist(uncompound,[Name|Args],Src). - -:- dynamic(all_data_to/1). -all_data_once:- all_data_to(_),!. -all_data_once:- open(all_data,write,Out,[alias(all_data),encoding(utf8),lock(write)]), - assert(all_data_to(Out)), - writeln(Out,':- encoding(utf8).'), - writeln(Out,':- style_check(-discontiguous).'), - all_data_preds. - -all_data_preds:- - all_data_to(Out), - with_output_to(Out, -((listing(table_n_type/3), - listing(load_state/2), - listing(is_loaded_from_file_count/2), - listing(fb_pred/2), - listing(fb_arg_type/1), - listing(fb_arg_table_n/3), - listing(fb_arg/1), - listing(done_reading/1)))),!. - -all_data_done:- - all_data_preds, - retract(all_data_to(Out)), - close(Out). - - - -%real_assert(OBO):- is_converting,!,print_src(OBO). -real_assert(OBO):- all_data_to(Out),!,write_canonical(Out,OBO),!,writeln(Out,'.'). -real_assert(OBO):- call(OBO),!. -real_assert(OBO):- assert(OBO), - (is_converting->print_src(OBO);true). - -print_src(OBO):- format('~N'), uncompound(OBO,Src),!, write_src(Src). - -assert_to_metta(_):- reached_file_max,!. -assert_to_metta(OBO):- !, functor(OBO,Fn,A),decl_fb_pred(Fn,A), !,real_assert(OBO),!, - incr_file_count(_),heartbeat. - -assert_to_metta(OBO):- - ignore(( A>=2,A<700, - OBO=..[Fn|Cols], - must_det_ll(( - make_assertion4(Fn,Cols,Data,OldData), - functor(Data,FF,AA), - decl_fb_pred(FF,AA), - ((fail,call(Data))->true;( - must_det_ll(( - real_assert(Data), - incr_file_count(_), - ignore((((should_show_data(X), - ignore((fail,OldData\==Data,write('; oldData '),write_src(OldData),format(' ; ~w ~n',[X]))), - write_src(Data),format(' ; ~w ~n',[X]))))), - ignore(( - fail, option_value(output_stream,OutputStream), - is_stream(OutputStream), - should_show_data(X1),X1<1000,must_det_ll((display(OutputStream,Data),writeln(OutputStream,'.'))))))))))))),!. - -assert_MeTTa(OBO):- !, assert_to_metta(OBO). -%assert_MeTTa(OBO):- !, assert_to_metta(OBO),!,heartbeat. -/* -assert_MeTTa(Data):- !, heartbeat, functor(Data,F,A), A>=2, - decl_fb_pred(F,A), - incr_file_count(_), - ignore((((should_show_data(X), - write(newData(X)),write(=),write_src(Data))))), - assert(Data),!. -*/ - - -%:- dynamic((metta_type/3,metta_defn/3,get_metta_atom/2)). - -into_space(Self,'&self',Self):-!. -into_space(_,Other,Other):-!. - - -into_space(Self,Myself,SelfO):- into_space(30,Self,Myself,SelfO). - -into_space(_Dpth,Self,Myself,Self):-Myself=='&self',!. -into_space(_Dpth,Self,None,Self):- 'None' == None,!. -into_space(Depth,Self,Other,Result):- eval_H(Depth,Self,Other,Result). -into_name(_,Other,Other). - -%eval_f_args(Depth,Self,F,ARGS,[F|EARGS]):- maplist(eval_H(Depth,Self),ARGS,EARGS). - - -combine_result(TF,R2,R2):- TF == [], !. -combine_result(TF,_,TF):-!. - - -do_metta1_e(_Self,_,exec(Exec)):- !,write_exec(Exec),!. -do_metta1_e(_Self,_,[=,A,B]):- !, with_concepts(false, - (con_write('(= '), with_indents(false,write_src(A)), (is_list(B) -> connl ; true),con_write(' '),with_indents(true,write_src(B)),con_write(')'))),connl. -do_metta1_e(_Self,_LoadExec,Term):- write_src(Term),connl. - -write_exec(Exec):- notrace(write_exec0(Exec)). -%write_exec0(Exec):- atom(Exec),!,write_exec0([Exec]). -write_exec0(Exec):- - wots(S,write_src(exec(Exec))), - nb_setval(exec_src,Exec), - ignore((notrace((color_g_mesg_ok('#0D6328',(format('~N'),writeln(S))))))). - - - - -asserted_do_metta(Space,Load,Src):- asserted_do_metta2(Space,Load,Src,Src). - -asserted_do_metta2(Self,Load,[TypeOp,Fn,Type], Src):- TypeOp = ':', \+ is_list(Type),!, - must_det_ll(( - color_g_mesg_ok('#ffa500',metta_anew(Load,Src,metta_atom(Self,[':',Fn,Type]))))),!. - -asserted_do_metta2(Self,Load,[TypeOp,Fn,TypeDecL], Src):- TypeOp = ':',!, - must_det_ll(( - decl_length(TypeDecL,Len),LenM1 is Len - 1, last_element(TypeDecL,LE), - color_g_mesg_ok('#ffa500',metta_anew(Load,Src,metta_atom(Self,[':',Fn,TypeDecL]))), - metta_anew1(Load,metta_arity(Self,Fn,LenM1)), - arg_types(TypeDecL,[],EachArg), - metta_anew1(Load,metta_params(Self,Fn,EachArg)),!, - metta_anew1(Load,metta_last(Self,Fn,LE)))). - -asserted_do_metta2(Self,Load,[TypeOp,Fn,TypeDecL,RetType], Src):- TypeOp = ':',!, - must_det_ll(( - decl_length(TypeDecL,Len), - append(TypeDecL,[RetType],TypeDecLRet), - color_g_mesg_ok('#ffa500',metta_anew(Load,Src,metta_atom(Self,[':',Fn,TypeDecLRet]))), - metta_anew1(Load,metta_arity(Self,Fn,Len)), - arg_types(TypeDecL,[RetType],EachArg), - metta_anew1(Load,metta_params(Self,Fn,EachArg)), - metta_anew1(Load,metta_return(Self,Fn,RetType)))),!. - -/*do_metta(File,Self,Load,PredDecl, Src):-fail, - metta_anew(Load,Src,metta_atom(Self,PredDecl)), - ignore((PredDecl=['=',Head,Body], metta_anew(Load,Src,metta_defn(Eq,Self,Head,Body)))), - ignore((Body == 'True',!,do_metta(File,Self,Load,Head))), - nop((fn_append(Head,X,Head), fn_append(PredDecl,X,Body), - metta_anew((Head:- Body)))),!.*/ - -asserted_do_metta2(Self,Load,[EQ,Head,Result], Src):- EQ=='=', !, - must_det_ll(( - discover_head(Self,Load,Head), - color_g_mesg_ok('#ffa500',metta_anew(Load,Src,metta_defn(EQ,Self,Head,Result))), - discover_body(Self,Load,Result))). - -asserted_do_metta2(Self,Load,PredDecl, Src):- - ignore(discover_head(Self,Load,PredDecl)), - color_g_mesg_ok('#ffa500',metta_anew(Load,Src,metta_atom(Self,PredDecl))). - - -always_exec(exec(W)):- !, is_list(W), always_exec(W). -always_exec(Comp):- compound(Comp),compound_name_arity(Comp,Name,N),atom_concat('eval',_,Name),Nm1 is N-1, arg(Nm1,Comp,TA),!,always_exec(TA). -always_exec(List):- \+ is_list(List),!,fail. -always_exec([Var|_]):- \+ atom(Var),!,fail. -always_exec(['extend-py!'|_]):- !, fail. -always_exec([H|_]):- atom_concat(_,'!',H),!. %pragma!/print!/transfer!/include! etc -always_exec(['assertEqualToResult'|_]):-!,fail. -always_exec(['assertEqual'|_]):-!,fail. -always_exec(_):-!,fail. % everything else - -if_t(A,B,C):- trace,if_t((A,B),C). - - -check_answers_for(TermV,Ans):- (string(TermV);var(Ans);var(TermV)),!,fail. -check_answers_for(TermV,_):- sformat(S,'~q',[TermV]),atom_contains(S,"[assert"),!,fail. -check_answers_for(_,Ans):- contains_var('BadType',Ans),!,fail. -check_answers_for(TermV,_):- inside_assert(TermV,BaseEval), always_exec(BaseEval),!,fail. - -%check_answers_for([TermV],Ans):- !, check_answers_for(TermV,Ans). -%check_answers_for(TermV,[Ans]):- !, check_answers_for(TermV,Ans). -check_answers_for(_,_). - -got_exec_result2(Val,Nth,Ans):- is_list(Ans), exclude(==(','),Ans,Ans2), Ans\==Ans2,!, - got_exec_result2(Val,Nth,Ans2). -got_exec_result2(Val,Nth,Ans):- - must_det_ll(( - Nth100 is Nth+100, - get_test_name(Nth100,TestName), - nb_current(exec_src,Exec), - if_t( ( \+ is_unit_test_exec(Exec)), - ((equal_enough(Val,Ans) - -> write_pass_fail_result_now(TestName,exec,Exec,'PASS',Ans,Val) - ; write_pass_fail_result_now(TestName,exec,Exec,'FAIL',Ans,Val)))))). - -write_pass_fail_result_now(TestName,exec,Exec,PASS_FAIL,Ans,Val):- - (PASS_FAIL=='PASS'->flag(loonit_success, X, X+1);flag(loonit_failure, X, X+1)), - (PASS_FAIL=='PASS'->Color=cyan;Color=red), - color_g_mesg(Color,write_pass_fail_result_c(TestName,exec,Exec,PASS_FAIL,Ans,Val)),!,nl, - nl,writeln('--------------------------------------------------------------------------'),!. - -write_pass_fail_result_c(TestName,exec,Exec,PASS_FAIL,Ans,Val):- - nl,write_mobj(exec,[(['assertEqualToResult',Exec,Ans])]), - nl,write_src('!'(['assertEqual',Val,Ans])), - write_pass_fail_result(TestName,exec,Exec,PASS_FAIL,Ans,Val). - -is_unit_test_exec(Exec):- sformat(S,'~w',[Exec]),sub_atom(S,_,_,_,'assert'). -is_unit_test_exec(Exec):- sformat(S,'~q',[Exec]),sub_atom(S,_,_,_,"!',"). - -return_empty('Empty'). -return_empty(_,Empty):- return_empty(Empty). -return_empty(_RetType,_,Empty):- return_empty(Empty). - -convert_tax(_How,Self,Tax,Expr,NewHow):- - metta_interp_mode(Ch,Mode), - string_concat(Ch,TaxM,Tax),!, - normalize_space(string(NewTax),TaxM), - convert_tax(Mode,Self,NewTax,Expr,NewHow). -convert_tax(How,_Self,Tax,Expr,How):- - %parse_sexpr_metta(Tax,Expr). - normalize_space(string(NewTax),Tax), - read_metta(NewTax,Expr). - - -metta_interp_mode('+',load). -metta_interp_mode('-',unload). -metta_interp_mode('!',exec). -metta_interp_mode('?',call). -metta_interp_mode('^',load_like_file). - - -call_sexpr(Mode,Self,Tax,_S,Out):- - metta_interp_mode(Mode,How), - (atom(Tax);string(Tax)), - normalize_space(string(TaxM),Tax), - convert_tax(How,Self,TaxM,Expr,NewHow),!, - show_call(do_metta(python,NewHow,Self,Expr,Out)). - - -do_metta(_File,_Load,_Self,In,Out):- var(In),!,In=Out. -do_metta(_From,_Mode,_Self,end_of_file,'Empty'):- !. %, halt(7), writeln('\n\n% To restart, use: ?- repl.'). -do_metta(_File,_Load,_Self,Cmt,Out):- Cmt==[],!, Out=[]. - -do_metta(From,Load,Self,'$COMMENT'(Expr,_,_),Out):- !, do_metta(From,comment(Load),Self,Expr,Out). -do_metta(From,Load,Self,'$STRING'(Expr),Out):- !, do_metta(From,comment(Load),Self,Expr,Out). -do_metta(From,comment(Load),Self,[Expr],Out):- !, do_metta(From,comment(Load),Self,Expr,Out). -do_metta(From,comment(Load),Self,Cmt,Out):- write_comment(Cmt), !, - ignore(( atomic(Cmt),atomic_list_concat([_,Src],'MeTTaLog only: ',Cmt),!,atom_string(Src,SrcCode),do_metta(mettalog_only(From),Load,Self,SrcCode,Out))), - ignore(( atomic(Cmt),atomic_list_concat([_,Src],'MeTTaLog: ',Cmt),!,atom_string(Src,SrcCode),do_metta(mettalog_only(From),Load,Self,SrcCode,Out))),!. - -do_metta(From,How,Self,Src,Out):- string(Src),!, - normalize_space(string(TaxM),Src), - convert_tax(How,Self,TaxM,Expr,NewHow),!, - do_metta(From,NewHow,Self,Expr,Out). - -do_metta(From,_,Self,exec(Expr),Out):- !, do_metta(From,exec,Self,Expr,Out). -do_metta(From,_,Self, call(Expr),Out):- !, do_metta(From,call,Self,Expr,Out). -do_metta(From,_,Self, ':-'(Expr),Out):- !, do_metta(From,call,Self,Expr,Out). -do_metta(From,call,Self,TermV,FOut):- !, - call_for_term_variables(TermV,Term,NamedVarsList,X), must_be(nonvar,Term), - copy_term(NamedVarsList,Was), - Output = NamedVarsList, - user:interactively_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut). -do_metta(_File,Load,Self,Src,Out):- Load\==exec, !, as_tf(asserted_do_metta(Self,Load,Src),Out). - -do_metta(file(Filename),exec,Self,TermV,Out):- - notrace(( - inc_exec_num(Filename), - must_det_ll(( - get_exec_num(Filename,Nth), - Nth>0)), - file_answers(Filename, Nth, Ans), - check_answers_for(TermV,Ans),!, - must_det_ll(( - color_g_mesg_ok('#ffa500', - (writeln(';; In file as: '), - color_g_mesg([bold,fg('#FFEE58')], write_src(exec(TermV))), - write(';; To unit test case:'))))),!, - do_metta_exec(file(Filename),Self,['assertEqualToResult',TermV,Ans],Out))). - -do_metta(From,exec,Self,TermV,Out):- !, do_metta_exec(From,Self,TermV,Out). - -do_metta_exec(From,Self,TermV,FOut):- - Output = X, - notrace(into_metta_callable(Self,TermV,Term,X,NamedVarsList,Was)), - user:interactively_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut). - - -call_for_term_variables(TermV,catch_red(show_failure(Term)),NamedVarsList,X):- - term_variables(TermV, AllVars), call_for_term_variables4v(TermV,AllVars,Term,NamedVarsList,X),!, - must_be(callable,Term). -call_for_term_variables(TermV,catch_red(show_failure(Term)),NamedVarsList,X):- - get_term_variables(TermV, DCAllVars, Singletons, NonSingletons), - call_for_term_variables5(TermV, DCAllVars, Singletons, NonSingletons, Term,NamedVarsList,X),!, - must_be(callable,Term). - -into_metta_callable(_Self,TermV,Term,X,NamedVarsList,Was):- use_metta_compiler, !, - must_det_ll(((( - - % ignore(Res = '$VAR'('ExecRes')), - RealRes = Res, - compile_for_exec(Res,TermV,ExecGoal),!, - subst_vars(Res+ExecGoal,Res+Term,NamedVarsList), - copy_term(NamedVarsList,Was), - term_variables(Term,Vars), - notrace((color_g_mesg('#114411',print_tree(exec(Res):-ExecGoal)))), - %nl,writeq(Term),nl, - ((\+ \+ - ((numbervars(v(TermV,Term,NamedVarsList,Vars),999,_,[attvar(bind)]), - %nb_current(variable_names,NamedVarsList), - %nl,print(subst_vars(Term,NamedVarsList,Vars)), - nl)))), - nop(maplist(verbose_unify,Vars)), - %NamedVarsList=[_=RealRealRes|_], - var(RealRes), X = RealRes)))),!. - - -into_metta_callable(Self,TermV,CALL,X,NamedVarsList,Was):-!, - option_else('stack-max',StackMax,100), - CALL = eval_H(StackMax,Self,Term,X), - notrace(( must_det_ll(( - if_t(preview_compiler,write_compiled_exec(TermV,_Goal)), - subst_vars(TermV,Term,NamedVarsList), - copy_term(NamedVarsList,Was) - %term_variables(Term,Vars), - %nl,writeq(Term),nl, - %skip((\+ \+ - %((numbervars(v(TermV,Term,NamedVarsList,Vars),999,_,[attvar(bind)]), %nb_current(variable_names,NamedVarsList), - %nl,print(subst_vars(TermV,Term,NamedVarsList,Vars)),nl)))), - %nop(maplist(verbose_unify,Vars)))))),!. - )))). - -eval_H(StackMax,Self,Term,X):- - (always_exec(Term) -> - if_or_else(eval_args('=',_,StackMax,Self,Term,X), - (fail,subst_args('=',_,StackMax,Self,Term,X))); - call_max_time(eval_args('=',_,StackMax,Self,Term,X),3.0, - (fail,subst_args('=',_,StackMax,Self,Term,X)))). - -eval_H(Term,X):- - if_or_else((eval_args(Term,X),X\==Term),(fail,subst_args(Term,Y),Y\==Term)). - -%eval_H(Term,X):- if_or_else((subst_args(Term,X),X\==Term),(eval_args(Term,Y),Y\==Term)). - -print_goals(TermV):- write_src(TermV). - - -if_or_else(Goal,Else):- call(Goal)*->true;call(Else). - -interacting:- tracing,!. -interacting:- current_prolog_flag(debug,true),!. -interacting:- option_value(interactive,true),!. - -% call_max_time(+Goal, +MaxTime, +Else) -call_max_time(Goal,_MaxTime, Else) :- interacting,!, if_or_else(Goal,Else). -call_max_time(Goal,_MaxTime, Else) :- !, if_or_else(Goal,Else). -call_max_time(Goal, MaxTime, Else) :- - catch(if_or_else(call_with_time_limit(MaxTime, Goal),Else), time_limit_exceeded, Else). - - -catch_err(G,E,C):- catch(G,E,(atom(E)->throw(E);C)). - -%repl:- option_value('repl',prolog),!,prolog. -%:- ensure_loaded(metta_toplevel). - -%:- discontiguous do_metta_exec/3. - -repl:- setup_call_cleanup(flag(repl_level,Was,Was+1),repl0, - (flag(repl_level,_,Was),(Was==0 -> maybe_halt(7) ; true))). - -repl0:- catch(repl2,end_of_input,true). -repl1:- - with_option('doing_repl',true, - with_option(repl,true,repl2)). %catch((repeat, repl2, fail)'$aborted',true). -repl2:- -%notrace((current_input(In),nop(catch(load_history,_,true)))), - % ignore(install_readline(In)), - repeat, - %with_option(not_a_reload,true,make), - catch(once(repl3),restart_reading,true),fail. -repl3:- - notrace(( flag(eval_num,_,0), - current_space(Self), - ((nb_current(read_mode,Mode),Mode\==[])->true;Mode='!'), - ignore(shell('stty sane ; stty echo')), - current_input(In), - format(atom(P),'metta ~w ~w> ',[Self, Mode]))), - setup_call_cleanup( - notrace(prompt(Was,P)), - notrace((ttyflush,read_metta(In,Expr),ttyflush)), - notrace(prompt(_,Was))), - ignore(shell('stty sane ; stty echo')), - notrace(ignore(check_has_directive(Expr))), - notrace(if_t(Expr==end_of_file,throw(end_of_input))), - once(do_metta(repl_true,Mode,Self,Expr,_)). - -check_has_directive(Atom):- atom(Atom),atom_concat(_,'.',Atom),!. -check_has_directive(call(N=V)):- nonvar(N),!, set_directive(N,V). -check_has_directive(call(Rtrace)):- rtrace == Rtrace,!, rtrace,notrace(throw(restart_reading)). -check_has_directive(NEV):- atom(NEV), atomic_list_concat([N,V],'=',NEV), set_directive(N,V). -check_has_directive([AtEq,Value]):-atom(AtEq),atom_concat('@',Name,AtEq), set_directive(Name,Value). -check_has_directive(ModeChar):- atom(ModeChar),metta_interp_mode(ModeChar,_Mode),!,set_directive(read_mode,ModeChar). -check_has_directive(AtEq):-atom(AtEq),atom_concat('@',NEV,AtEq),check_has_directive(NEV,true). -check_has_directive(_). -set_directive(N,V):- atom_concat('@',NN,N),!,set_directive(NN,V). -set_directive(N,V):- N==mode,!,set_directive(read_mode,V). -set_directive(N,V):- show_call(set_option_value(N,V)),!,notrace(throw(restart_reading)). - -read_pending_white_codes(In):- - read_pending_codes(In,[10],[]),!. -read_pending_white_codes(_). - -call_for_term_variables4v(Term,[] ,as_tf(Term,TF),NamedVarsList,TF):- get_global_varnames(NamedVarsList),!. -call_for_term_variables4v(Term,[X] , Term, NamedVarsList,X):- get_global_varnames(NamedVarsList). - - -not_in_eq(List, Element) :- - member(V, List), V == Element. - -get_term_variables(Term, DontCaresN, CSingletonsN, CNonSingletonsN) :- - term_variables(Term, AllVars), - get_global_varnames(VNs), - writeqln(term_variables(Term, AllVars)=VNs), - term_singletons(Term, Singletons), - term_dont_cares(Term, DontCares), - include(not_in_eq(Singletons), AllVars, NonSingletons), - include(not_in_eq(DontCares), NonSingletons, CNonSingletons), - include(not_in_eq(DontCares), Singletons, CSingletons), - maplist(into_named_vars,[DontCares, CSingletons, CNonSingletons], - [DontCaresN, CSingletonsN, CNonSingletonsN]), - writeqln([DontCaresN, CSingletonsN, CNonSingletonsN]). - -term_dont_cares(Term, DontCares):- - term_variables(Term, AllVars), - get_global_varnames(VNs), - include(has_sub_var(AllVars),VNs,HVNs), - include(underscore_vars,HVNs,DontCareNs), - maplist(arg(2),DontCareNs,DontCares). - -into_named_vars(Vars,L):- is_list(Vars), !, maplist(name_for_var_vn,Vars,L). -into_named_vars(Vars,L):- term_variables(Vars,VVs),!,into_named_vars(VVs,L). - -has_sub_var(AllVars,_=V):- sub_var(V,AllVars). -underscore_vars(V):- var(V),!,name_for_var(V,N),!,underscore_vars(N). -underscore_vars(N=_):- !, atomic(N),!,underscore_vars(N). -underscore_vars(N):- atomic(N),!,atom_concat('_',_,N). - -get_global_varnames(VNs):- nb_current('variable_names',VNs),VNs\==[],!. -get_global_varnames(VNs):- prolog_load_context(variable_names,VNs),!. -maybe_set_var_names(List):- List==[],!. -maybe_set_var_names(List):- % wdmsg(maybe_set_var_names(List)), - is_list(List),!,nb_linkval(variable_names,List). -maybe_set_var_names(_). - -name_for_var_vn(V,N=V):- name_for_var(V,N). - -name_for_var(V,N):- var(V),!,get_global_varnames(VNs),member(N=VV,VNs),VV==V,!. -name_for_var(N=_,N):- !. -name_for_var(V,N):- term_to_atom(V,N),!. - - - %call_for_term_variables5(Term,[],as_tf(Term,TF),[],TF):- atom(Term),!. -call_for_term_variables5(Term,[],[],[],as_tf(Term,TF),[],TF):- ground(Term),!. -call_for_term_variables5(Term,DC,[],[],call_nth(Term,TF),DC,TF):- ground(Term),!. -call_for_term_variables5(Term,_,[],[_=Var],call_nth(Term,Count),['Count'=Count],Var). -call_for_term_variables5(Term,_,[_=Var],[],call_nth(Term,Count),['Count'=Count],Var). -call_for_term_variables5(Term,_,Vars,[_=Var],Term,Vars,Var). -call_for_term_variables5(Term,_,[_=Var],Vars,Term,Vars,Var). -call_for_term_variables5(Term,_,SVars,Vars,call_nth(Term,Count),[Vars,SVars],Count). - - - -is_interactive(From):- notrace(is_interactive0(From)). -is_interactive0(From):- From==false,!,fail. -is_interactive0(From):- atomic(From),is_stream(From),!, \+ stream_property(From,filename(_)). -is_interactive0(From):- From = repl_true,!. -is_interactive0(From):- From = true,!. - - -:- set_prolog_flag(history, 20). - -inside_assert(Var,Var):- \+ compound(Var),!. -inside_assert([H,IA,_],IA):- atom(H),atom_concat('assert',_,H),!. -inside_assert(Conz,Conz):- is_conz(Conz),!. -inside_assert(call(I),O):- !, inside_assert(I,O). -inside_assert( ?-(I), O):- !, inside_assert(I,O). -inside_assert( :-(I), O):- !, inside_assert(I,O). -inside_assert(exec(I),O):- !, inside_assert(I,O). -inside_assert(eval_H(A,B,I,C),eval_H(A,B,O,C)):- !, inside_assert(I,O). -inside_assert(eval_H(I,C),eval_H(O,C)):- !, inside_assert(I,O). -inside_assert(Eval,O):- functor(Eval,F,A), atom_concat('eval',_,F), A1 is A-1, arg(A1,Eval,I),!, inside_assert(I,O). -inside_assert(I,O):- I=..[_,F|_],!,compound(F),inside_assert(F,O). -inside_assert(Var,Var). - -current_space(Self):- ((nb_current(self_space,Self),Self\==[])->true;Self='&self'). - -eval(all(Form)):- nonvar(Form), !, forall(eval(Form,_),true). -eval(Form):- - current_space(Self), - do_metta(true,exec,Self,Form,_Out). - -eval(Self,Form):- - current_space(SelfS),SelfS==Self,!, - do_metta(true,exec,Self,Form,_Out). -eval(Form,Out):- - current_space(Self), - eval(Self,Form,Out). - - -eval(Self,Form,Out):- - do_metta(prolog,exec,Self,Form,Out). - -name_vars(X='$VAR'(X)). - -interactively_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut):- - notrace(( - Result = res(FOut), - inside_assert(Term,BaseEval), - option_else(answer,Leap,each), - Control = contrl(Leap), - Skipping = _, - % Initialize Control as a compound term with 'each' as its argument. - %GG = interact(['Result'=X|NamedVarsList],Term,trace_off), - (((From = file(_Filename), option_value('exec',skip), \+ always_exec(BaseEval))) - -> (GG = (skip(Term),deterministic(Complete)), - %Output = - %FOut = "Skipped", - Skipping = 1,!, - %color_g_mesg('#da70d6', (write('% SKIPPING: '), writeq(eval_H(100,Self,BaseEval,X)),writeln('.'))), - % color_g_mesg('#fa90f6', (writeln('; SKIPPING'), with_indents(true,write_src(exec(BaseEval))))), - % if_t(is_list(BaseEval),add_history_src(exec(TermV))), - true - ) - ; GG = locally(set_prolog_flag(gc,false), - ( (dcall(Term),deterministic(Complete)), nb_setarg(1,Result,Output))), - - !, % metta_toplevel - flag(result_num,_,0), - PL=eval(Self,BaseEval,X), - ( % with_indents(true, - \+ \+ ( - maplist(name_vars,NamedVarsList), - name_vars('OUT'=X), - % add_history_src(exec(BaseEval)), - write_exec(TermV), - if_t(Skipping==1,writeln(' ; SKIPPING')), - if_t(TermV\=BaseEval,color_g_mesg('#fa90f6', (write('; '), with_indents(false,write_src(exec(BaseEval)))))), - if_t((is_interactive(From);Skipping==1), - ( - if_t( \+ option_value(doing_repl,true), - if_t( \+ option_value(repl,true), - if_t( option_value(prolog,true), add_history_pl(PL)))), - if_t(option_value(repl,true), add_history_src(exec(BaseEval))))), - - color_g_mesg('#da70d6', (write('% DEBUG: '), writeq(PL),writeln('.'))), - true))))), - - (forall_interactive( - From, WasInteractive,Complete,may_rtrace(GG), - ((Complete==true->!;true), - %repeat, - set_option_value(interactive,WasInteractive), - nb_setarg(1,Result,Output), - read_pending_codes(user_input,_,[]), - flag(result_num,R,R+1), - flag(result_num,ResNum,ResNum), - (((ResNum==1,Complete==true)->(format('~NDeterministic: ', []), !); %or Nondet - ( Complete==true -> (format('~NLast Result(~w): ',[ResNum]),! ); - format('~NNDet Result(~w): ',[ResNum])))), - color_g_mesg(yellow, ignore((( if_t( \+ atomic(Output), nl), write_src(Output), nl)))), - color_g_mesg(green, - ignore((NamedVarsList \=@= Was ->( maplist(print_var,NamedVarsList), nl) ; true))), - ((Complete\==true, WasInteractive, Control \== contrl(leap))-> - (write("More Solutions? "),get_single_char_key(C), writeq(key=C),nl, - (C=='b' -> (once(repl),fail) ; - (C=='m' -> make ; - (C=='t' -> (nop(set_debug(eval,true)),rtrace) ; - (C=='T' -> (set_debug(eval,true)); - (C==';' -> true ; - (C==esc('[A',[27,91,65]) -> nb_setarg(1, Control, leap) ; - (C=='l' -> nb_setarg(1, Control, leap) ; - (((C=='\n');(C=='\r')) -> (!,fail); - (!,fail))))))))))); - (Complete\==true, \+ WasInteractive, Control == contrl(leap)) -> true ; - (((Complete==true ->! ; true))))) - *-> (ignore(Result = res(FOut)),ignore(Output = (FOut))) - ; (flag(result_num,ResNum,ResNum),(ResNum==0->(format('~N~n~n'),!,fail);true))), - ignore(Result = res(FOut)). - - -get_single_char_key(O):- get_single_char(C),get_single_char_key(C,O). -get_single_char_key(27,esc(A,[27|O])):- !,read_pending_codes(user_input,O,[]),name(A,O). -get_single_char_key(C,A):- name(A,[C]). - -forall_interactive(file(_),false,Complete,Goal,After):- !, Goal, (Complete==true -> ( After,!) ; ( \+ After )). -forall_interactive(prolog,false,Complete,Goal,After):- !, Goal, (Complete == true -> ! ; true), quietly(After). -forall_interactive(From,WasInteractive,Complete,Goal,After):- - (is_interactive(From) -> WasInteractive = true ; WasInteractive = false),!, - Goal, (Complete==true -> ( quietly(After),!) ; ( quietly( \+ After) )). - -print_var(Name=Var) :- print_var(Name,Var). -print_var(Name,Var):- write('$'),write(Name), write(' = '), write_src(Var), nl. - -% Entry point for the user to call with tracing enabled -toplevel_goal(Goal) :- - term_variables(Goal,Vars), - trace_goal(Vars, Goal, trace_off). - -% Entry point for the user to call with tracing enabled -trace_goal(Goal) :- - trace_goal(Goal, trace_on). - -% Handle tracing -trace_goal(Goal, Tracing) :- - (Tracing == trace_on -> writeln('Entering goal:'), writeln(Goal) ; true), - term_variables(Goal, Variables), - ( call(Goal) -> - (Tracing == trace_on -> writeln('Goal succeeded with:'), writeln(Variables) ; true), - interact(Variables, Goal, Tracing) - ; (Tracing == trace_on -> writeln('Goal failed.') ; true), - false - ). - -% Interaction with the user -interact(Variables, Goal, Tracing) :- - call(Goal),write('Solution: '), write_src(Variables), - write(' [;next]?'), - get_single_char(Code), - (command(Code, Command) -> - handle_command(Command, Variables, Goal, Tracing) - ; writeln('Unknown command.'), interact(Variables, Goal, Tracing) % handle unknown commands - ). - -install_readline(Input):- - add_history_string("!(pfb3)"), - add_history_string("!(load-flybase-full)"), - add_history_string("!(obo-alt-id $X BS:00063)"), - add_history_string("!(and (total-rows $T TR$) (unique-values $T2 $Col $TR))"), - ignore(editline:el_wrap), - ignore(editline:add_prolog_commands(Input)). - - - - -% Command descriptions -command(59, retry). % ';' to retry -command(115, skip). % 's' to skip to the next solution -command(108, leap). % 'l' to leap (end the debugging session) -command(103, goals). % 'g' to show current goals -command(102, fail). % 'f' to force fail -command(116, trace). % 't' to toggle tracing -command(117, up). % 'u' to continue without interruption -command(101, exit). % 'e' to exit the debugger -command(97, abort). % 'a' to abort -command(98, break). % 'b' to set a breakpoint -command(99, creep). % 'c' to proceed step by step -command(104, help). % 'h' for help -command(65, alternatives). % 'A' for alternatives -command(109, make). % 'm' for make (recompile) -command(67, compile). % 'C' for Compile (compile new executable) - -:- style_check(-singleton). - -% Command implementations -handle_command(make, Variables, Goal, Tracing) :- - writeln('Recompiling...'), - % Insert the logic to recompile the code. - % This might involve calling `make/0` or similar. - make, % This is assuming your Prolog environment has a `make` predicate. - fail. % interact(Variables, Goal, Tracing). - -handle_command(compile, Variables, Goal, Tracing) :- - writeln('Compiling new executable...'), - % Insert the logic to compile a new executable. - % This will depend on how you compile Prolog programs in your environment. - % For example, you might use `qsave_program/2` to create an executable. - % Pseudocode: compile_executable(ExecutableName) - fail. % interact(Variables, Goal, Tracing). -handle_command(alternatives, Variables, Goal, Tracing) :- - writeln('Showing alternatives...'), - % Here you would include the logic for displaying the alternatives. - % For example, showing other clauses that could be tried for the current goal. - writeln('Alternatives for current goal:'), - writeln(Goal), - % Pseudocode: find_alternatives(Goal, Alternatives) - % Pseudocode: print_alternatives(Alternatives) - fail. % interact(Variables, Goal, Tracing). -% Extend the command handling with the 'help' command implementation -handle_command(help, Variables, Goal, Tracing) :- - print_help, - fail. % interact(Variables, Goal, Tracing). -handle_command(abort, _, _, _) :- - writeln('Aborting...'), abort. -handle_command(break, Variables, Goal, Tracing) :- - writeln('Breakpoint set.'), % Here you should define what 'setting a breakpoint' means in your context - fail. % interact(Variables, Goal, Tracing). -handle_command(creep, Variables, Goal, Tracing) :- - writeln('Creeping...'), % Here you should define how to 'creep' (step by step execution) through the code - trace. % interact(Variables, Goal, Tracing). -handle_command(retry, Variables, Goal, Tracing) :- - writeln('Continuing...'),!. - %trace_goal(Goal, Tracing). -handle_command(skip, Variables, Goal, Tracing) :- - writeln('Skipping...'). -handle_command(leap, _, _, _) :- - writeln('Leaping...'), nontrace. % Cut to ensure we stop the debugger -handle_command(goals, Variables, Goal, Tracing) :- - writeln('Current goal:'), writeln(Goal), - writeln('Current variables:'), writeln(Variables), - bt,fail. % interact(Variables, Goal, Tracing). -handle_command(fail, _, _, _) :- - writeln('Forcing failure...'), fail. -handle_command(trace, Variables, Goal, Tracing) :- - (Tracing == trace_on -> - NewTracing = trace_off, writeln('Tracing disabled.') - ; NewTracing = trace_on, writeln('Tracing enabled.') - ), - interact(Variables, Goal, NewTracing). -handle_command(up, Variables, Goal, Tracing) :- - writeln('Continuing up...'), - repeat, - ( trace_goal(Goal, Tracing) -> true ; !, fail ). -handle_command(exit, _, _, _) :- - writeln('Exiting debugger...'), !. % Cut to ensure we exit the debugger - -:- style_check(+singleton). - - -% Help description -print_help :- - writeln('Debugger commands:'), - writeln('(;) next - Retry with next solution.'), - writeln('(g) goal - Show the current goal.'), - writeln('(u) up - Finish this goal without interruption.'), - writeln('(s) skip - Skip to the next solution.'), - writeln('(c) creep or - Proceed step by step.'), - writeln('(l) leap - Leap over (the debugging).'), - writeln('(f) fail - Force the current goal to fail.'), - writeln('(B) back - Go back to the previous step.'), - writeln('(t) trace - Toggle tracing on or off.'), - writeln('(e) exit - Exit the debugger.'), - writeln('(a) abort - Abort the current operation.'), - writeln('(b) break - Break to a new sub-REPL.'), - writeln('(h) help - Display this help message.'), - writeln('(A) alternatives - Show alternative solutions.'), - writeln('(m) make - Recompile/Update the current running code.'), - writeln('(C) compile - Compile a fresh executable (based on the running state).'), - writeln('(E) error msg - Show the latest error messages.'), - writeln('(r) retry - Retry the previous command.'), - writeln('(I) info - Show information about the current state.'), - !. - - - - -really_trace:- once(option_value('exec',rtrace);option_value('eval',rtrace);is_debugging((exec));is_debugging((eval))). -% !(pragma! exec rtrace) -may_rtrace(Goal):- really_trace,!, really_rtrace(Goal). -may_rtrace(Goal):- rtrace_on_existence_error(time_eval(dcall(Goal)))*->true;really_rtrace(Goal). -really_rtrace(Goal):- use_metta_compiler,!,rtrace(call(Goal)). -really_rtrace(Goal):- with_debug((eval),with_debug((exec),Goal)). - -rtrace_on_existence_error(G):- !, catch(G,E,(wdmsg(E),rtrace(G))). -%rtrace_on_existence_error(G):- catch(G,error(existence_error(procedure,W),Where),rtrace(G)). - - - -write_compiled_exec(Exec,Goal):- -% ignore(Res = '$VAR'('ExecRes')), - compile_for_exec(Res,Exec,Goal), - notrace((color_g_mesg('#114411',portray_clause(exec(Res):-Goal)))). - -verbose_unify(Term):- verbose_unify(trace,Term). -verbose_unify(What,Term):- term_variables(Term,Vars),maplist(verbose_unify0(What),Vars),!. -verbose_unify0(What,Var):- put_attr(Var,verbose_unify,What). -verbose_unify:attr_unify_hook(Attr, Value) :- - format('~N~q~n',[verbose_unify:attr_unify_hook(Attr, Value)]), - vu(Attr,Value). -vu(_Attr,Value):- is_ftVar(Value),!. -vu(fail,_Value):- !, fail. -vu(true,_Value):- !. -vu(trace,_Value):- trace. -:- nodebug(metta(eval)). -:- nodebug(metta(exec)). -% Measures the execution time of a Prolog goal and displays the duration in seconds, -% milliseconds, or microseconds, depending on the execution time. -% -% Args: -% - Goal: The Prolog goal to be executed and timed. -% -% The predicate uses the `statistics/2` predicate to measure the CPU time before -% and after executing the provided goal. It calculates the elapsed time in seconds -% and converts it to milliseconds and microseconds. The output is formatted to -% provide clear timing information: -% -% - If the execution takes more than 2 seconds, it displays the time in seconds. -% - If the execution takes between 1 millisecond and 2 seconds, it displays the time -% in milliseconds. -% - If the execution takes less than 1 millisecond, it displays the time in microseconds. -% -% Example usage: -% ?- time_eval(my_goal(X)). -% -% ?- time_eval(sleep(0.95)). -% -% Output examples: -% ; Evaluation took 2.34 seconds. -% ; Evaluation took 123.45 ms. -% ; Evaluation took 0.012 ms. (12.33 microseconds) -% -time_eval(Goal):- - time_eval('Evaluation',Goal). -time_eval(What,Goal) :- - statistics(cputime, Start), - call(Goal), - statistics(cputime, End), - Seconds is End - Start, - Milliseconds is Seconds * 1_000, - (Seconds > 2 - -> format('; ~w took ~2f seconds.~n', [What, Seconds]) - ; (Milliseconds >= 1 - -> format('; ~w took ~3f secs. (~2f milliseconds) ~n', [What, Seconds, Milliseconds]) - ;( Micro is Milliseconds * 1_000, - format('; ~w took ~6f secs. (~2f microseconds) ~n', [What, Seconds, Micro])))). - -example0(_):- fail. -example1(a). example1(_):- fail. -example2(a). example2(b). example2(_):- fail. -example3(a). example3(b). example3(c). example3(_):- fail. -%eval_H(100,'&self',['change-state!','&var',[+,1,['get-state','&var']]],OUT) -%dcall(X):- (call(X),deterministic(YN)),trace,((YN==true)->!;true). -dcall(XX):- !, call(XX). -dcall(XX):- - USol = sol(dead), - copy_term(XX,X), - call_nth(USol,X,Nth,Det,Prev), - %wdmsg(call_nth(USol,X,Nth,Det,Prev)), - XX=Prev, - (Det==yes -> (!, (XX=Prev;XX=X)) ; - (((var(Nth) -> ( ! , Prev\==dead) ; - true), - (Nth==1 -> ! ; true)))). - -call_nth(USol,XX,Nth,Det,Prev):- - repeat, - ((call_nth(XX,Nth),deterministic(Det),arg(1,USol,Prev))*-> - ( nb_setarg(1,USol,XX)) - ; (!, arg(1,USol,Prev))). - -catch_red(Term):- catch(Term,E,pp_m(red,in(Term,E))). - -s2p(I,O):- sexpr_s2p(I,O),!. - -discover_head(Self,Load,Head):- - ignore(([Fn|PredDecl]=Head, - nop(( arg_types(PredDecl,[],EachArg), - metta_anew1(Load,metta_head(Self,Fn,EachArg)))))). - -discover_body(Self,Load,Body):- - nop(( [Fn|PredDecl] = Body, arg_types(PredDecl,[],EachArg), - metta_anew1(Load,metta_body(Self,Fn,EachArg)))). - -decl_length(TypeDecL,Len):- is_list(TypeDecL),!,length(TypeDecL,Len). -decl_length(_TypeDecL,1). - -arg_types([['->'|L]],R,LR):-!, arg_types(L,R,LR). -arg_types(['->'|L],R,LR):-!, arg_types(L,R,LR). -arg_types(L,R,LR):- append(L,R,LR). - -%:- ensure_loaded('../../examples/factorial'). -%:- ensure_loaded('../../examples/fibonacci'). - -%print_preds_to_functs:-preds_to_functs_src(factorial_tail_basic) - -:- dynamic(began_loon/1). -loon:- loon(typein). - -catch_red_ignore(G):- catch_red(G)*->true;true. - -:- export(loon/1). -:- public(loon/1). - -%loon(Why):- began_loon(Why),!,wdmsg(begun_loon(Why)). -loon(Why):- is_compiling,!,wdmsg(compiling_loon(Why)),!. -%loon( _Y):- current_prolog_flag(os_argv,ArgV),member('-s',ArgV),!. -loon(Why):- is_compiled, Why\==toplevel,Why\==default, Why\==program,!,wdmsg(compiled_loon(Why)),!. -loon(Why):- began_loon(_),!,wdmsg(skip_loon(Why)). -loon(Why):- wdmsg(began_loon(Why)), assert(began_loon(Why)), - do_loon. - -do_loon:- - ignore(( - \+ prolog_load_context(reloading,true), - maplist(catch_red_ignore,[ - - metta_final, - load_history, - update_changed_files, - run_cmd_args, - pre_halt, - maybe_halt(7)]))),!. - - - -pre_halt:- option_value('prolog',true),!,call_cleanup(prolog,(set_option_value('prolog',false),pre_halt)). -pre_halt:- option_value('repl',true),!,call_cleanup(repl,(set_option_value('repl',false),pre_halt)). -pre_halt:- loonit_report. -%loon:- time(loon_metta('./examples/compat/test_scripts/*.metta')),fail. -%loon:- repl, (option_value('halt',false)->true;halt(7)). -%maybe_halt(Seven):- option_value('prolog',true),!,call_cleanup(prolog,(set_option_value('prolog',false),maybe_halt(Seven))). -%maybe_halt(Seven):- option_value('repl',true),!,call_cleanup(repl,(set_option_value('repl',false),maybe_halt(Seven))). -%maybe_halt(Seven):- option_value('repl',true),!,halt(Seven). -maybe_halt(_):- once(pre_halt), fail. -maybe_halt(Seven):- option_value('halt',true),!,halt(Seven). -maybe_halt(Seven):- wdmsg(maybe_halt(Seven)). - -is_compiling:- current_prolog_flag(os_argv,ArgV),member(E,ArgV), - (E==qcompile_mettalog;E==qsave_program),!. -is_compiled:- current_prolog_flag(os_argv,ArgV),\+ member('swipl',ArgV),!. -is_converting:- nb_current('convert','True'),!. -is_converting:- current_prolog_flag(os_argv,ArgV), member('--convert',ArgV),!. -show_os_argv:- current_prolog_flag(os_argv,ArgV),write('; libswipl: '),writeln(ArgV). -is_pyswip:- current_prolog_flag(os_argv,ArgV),member( './',ArgV). -% libswipl: ['./','-q',--home=/usr/local/lib/swipl] - -:- initialization(show_os_argv). - -:- initialization(loon(program),program). -:- initialization(loon(default)). - -ensure_mettalog_system:- - abolish(began_loon/1), - dynamic(began_loon/1), - system:use_module(library(quasi_quotations)), - system:use_module(library(hashtable)), - system:use_module(library(gensym)), - system:use_module(library(sort)), - system:use_module(library(writef)), - system:use_module(library(rbtrees)), - system:use_module(library(dicts)), - system:use_module(library(shell)), - system:use_module(library(edinburgh)), - % system:use_module(library(lists)), - system:use_module(library(statistics)), - system:use_module(library(nb_set)), - system:use_module(library(assoc)), - system:use_module(library(pairs)), - user:use_module(library(swi_ide)), - user:use_module(library(prolog_profile)), - ensure_loaded('./src/main/flybase_convert'), - ensure_loaded('./src/main/flybase_main'), - autoload_all, - make, - autoload_all, - %pack_install(predicate_streams, [upgrade(true),global(true)]), - %pack_install(logicmoo_utils, [upgrade(true),global(true)]), - %pack_install(dictoo, [upgrade(true),global(true)]), - !. - -file_save_name(E,_):- \+ atom(E),!,fail. -file_save_name(E,Name):- file_base_name(E,BN),BN\==E,!,file_save_name(BN,Name). -file_save_name(E,E):- atom_concat('Sav.',_,E),!. -file_save_name(E,E):- atom_concat('Bin.',_,E),!. -before_underscore(E,N):-atomic_list_concat([N|_],'_',E),!. -save_name(Name):- current_prolog_flag(os_argv,ArgV),member(E,ArgV),file_save_name(E,Name),!. -next_save_name(Name):- save_name(E), - before_underscore(E,N), - atom_concat(N,'_',Stem), - gensym(Stem,Name), - \+ exists_file(Name), - Name\==E,!. -next_save_name('Sav.MeTTaLog'). -qcompile_mettalog:- - ensure_mettalog_system, - catch(qsave_program('Sav.MeTTaLog', - [class(development),autoload(true),goal(loon(goal)), toplevel(loon(toplevel)), stand_alone(true)]),E,writeln(E)), - halt(0). -qsave_program:- ensure_mettalog_system, next_save_name(Name), - catch(qsave_program(Name, - [class(development),autoload(true),goal(loon(goal)), toplevel(loon(toplevel)), stand_alone(false)]),E,writeln(E)), - !. - - -:- initialization(update_changed_files,restore). - -:- ignore((( - \+ prolog_load_context(reloading,true), - initialization(loon(restore),restore), - metta_final -))). -:- set_prolog_flag(metta_interp,ready). diff --git a/.Attic/metta_lang/metta_ontology.pl.pfc b/.Attic/metta_lang/metta_ontology.pl.pfc deleted file mode 100755 index aa50e924f46..00000000000 --- a/.Attic/metta_lang/metta_ontology.pl.pfc +++ /dev/null @@ -1,35 +0,0 @@ - - -% enforce the relation between functions snf predicates -p_arity('NullaryPredicate', 0). -p_arity('UnaryPredicate', 1). -p_arity('BinaryPredicate', 2). -p_arity('TernaryPredicate', 3). -p_arity('QuaternaryPredicate', 4). -p_arity('QuinaryPredicate', 5). -p_arity('SenaryPredicate', 6). -p_arity('SeptenaryPredicate', 7). -p_arity('OctaryPredicate', 8). -p_arity('NonaryPredicate', 9). -p_arity('DenaryPredicate', 10). - -f_arity('NullaryFunction', 0). -f_arity('UnaryFunction', 1). -f_arity('BinaryFunction', 2). -f_arity('TernaryFunction', 3). -f_arity('QuaternaryFunction', 4). -f_arity('QuinaryFunction', 5). -f_arity('SenaryFunction', 6). -f_arity('SeptenaryFunction', 7). -f_arity('OctaryFunction', 8). -f_arity('NonaryFunction', 9). - -% Equivalent Types use this rule to spedifiy and enforce that they have the same instances as the other -(equivalentTypes(PredType,FunctType) ==> - (in(FunctorObject,PredType) - <==> - in(FunctorObject,FunctType))). - -% generate some equivalency rules -((p_arity(PredType,PA), plus(FA,1,PA), f_arity(FunctType,FA))) - ==> equivalentTypes(PredType,FunctType). diff --git a/.Attic/metta_lang/metta_ontology.pl.pfc2 b/.Attic/metta_lang/metta_ontology.pl.pfc2 deleted file mode 100755 index c272a58bedd..00000000000 --- a/.Attic/metta_lang/metta_ontology.pl.pfc2 +++ /dev/null @@ -1,684 +0,0 @@ -% Predicate and Function Arity Definitions: -% Specifies the number of arguments (arity) for predicates and functions, which is fundamental -% for understanding the complexity and capabilities of various logical constructs. Predicates are defined -% from Nullary (no arguments) up to Denary (ten arguments), reflecting a range of logical conditions or assertions. -% Functions are similarly defined but focus on operations that return a value, extending up to Nonary (nine arguments). -p_arity('NullaryPredicate', 0). % No arguments. -p_arity('UnaryPredicate', 1). % One argument. -p_arity('BinaryPredicate', 2). % Two arguments. -p_arity('TernaryPredicate', 3). % Three arguments, and so on. -p_arity('QuaternaryPredicate', 4). -p_arity('QuinaryPredicate', 5). -p_arity('SenaryPredicate', 6). -p_arity('SeptenaryPredicate', 7). -p_arity('OctaryPredicate', 8). -p_arity('NonaryPredicate', 9). -p_arity('DenaryPredicate', 10). - -f_arity('NullaryFunction', 0). % No return value, essentially a procedure. -f_arity('UnaryFunction', 1). % Returns a single value, and so on. -f_arity('BinaryFunction', 2). -f_arity('TernaryFunction', 3). -f_arity('QuaternaryFunction', 4). -f_arity('QuinaryFunction', 5). -f_arity('SenaryFunction', 6). -f_arity('SeptenaryFunction', 7). -f_arity('OctaryFunction', 8). -f_arity('NonaryFunction', 9). - -% Enforcing Equivalency Between Predicates and Functions: -% Establishes a logical framework to equate the conceptual roles of predicates and functions based on arity. -% This equivalence bridges the functional programming and logical (declarative) paradigms within Prolog, -% allowing a unified approach to defining operations and assertions. -(equivalentTypes(PredType,FunctType) ==> - (in(FunctorObject,PredType) - <==> - in(FunctorObject,FunctType))). - -% Automatically generating equivalency rules based on the arity of predicates and functions. -% This facilitates a dynamic and flexible understanding of function and predicate equivalences, -% enhancing Prolog's expressive power and semantic richness. -((p_arity(PredType,PA), plus(FA,1,PA), f_arity(FunctType,FA))) - ==> equivalentTypes(PredType,FunctType). - -% Detailed Property Associations: -% These associations define and categorize the functionalities and capabilities of various programming constructs. -% The categorization aids in the intuitive understanding and systematic analysis of different programming elements, -% making the logical structure and execution flow of programs more comprehensible. - -% Flow Control Structures: -% Control structures are essential for directing the execution flow of a program. They enable conditional execution, -% looping, and choice between different paths of execution based on logical conditions or external inputs. -property('if', flow_control). % Conditional execution based on a boolean expression. -property('case', flow_control). % Choice between multiple paths. -property('let', flow_control). % Variable binding in a local scope. -property('let*', flow_control). % Sequential variable binding with dependency. -property('do', flow_control). % Executes a block of code. -property('limit', flow_control_modification). % Limits the number of solutions. -property('offset', flow_control_modification). % Skips a number of solutions. -property('max-time', execution_time_control). % Limits execution time. - -% Inferring backtracking behavior in flow control structures. This indicates that certain paths -% of execution might lead to backtracking, a core concept in Prolog for exploring alternative solutions. -property(P, flow_control) ==> property(P, 'OnFailBacktrack'). - -% Assertions and Testing Mechanisms: -% Assertions provide a powerful tool for validating expected conditions or outcomes within a program. -% They are critical for debugging and verifying the correctness of logic under various conditions. -property('assertTrue', assertions_testing). % Asserts a condition is true. -property('assertFalse', assertions_testing). % Asserts a condition is false. -property('assertEqual', assertions_testing). % Asserts equality between two values. -property('assertNotEqual', assertions_testing). % Asserts inequality. -property('assertEqualToResult', assertions_testing). % Asserts a value equals an expected result. - -% Asserting deterministic outcomes for testing mechanisms. These properties ensure that assertions -% yield predictable, binary outcomes (pass or fail) based on the conditions they test. -property(P, assertions_testing) ==> property(P, 'Deterministic'). - -% Special Operators and System Interaction: -% Special operators and functionalities enhance Prolog's interaction with its execution environment and system, -% enabling dynamic control flows, system-level operations, and interaction with external processes or data. -property('!', special_operators). % Cut operator, controls backtracking. -property('call!', special_operators). % Dynamically calls a predicate. -property('call-fn!', special_operators). % Calls a function dynamically. -property('repl!', system_interaction). % Interactive read-eval-print loop. -property('pyr!', special_operators). % Example of an extension or plugin call. -property('call-cleanup!', resource_management). % Ensures cleanup after execution. -property('setup-call-cleanup!', resource_management). % Setup, call, and cleanup pattern. -property('with-output-to!', output_redirection). % Redirects output to a different stream. - -% Deterministic behavior is noted for operations that have predictable outcomes, -% while nondeterministic behavior is acknowledged for operations whose results may vary. -property('call!', 'Deterministic'). -property('call-fn!', 'Nondeterministic'). -property('!', 'Deterministic'). - -% Data Structures and Manipulation: -% The definition, organization, and manipulation of data structures are foundational aspects of programming. -% These operations facilitate the storage, retrieval, and modification of data in structured forms. -property('Cons', data_structures). % Constructs a pair or list. -property('collapse', data_manipulation). % Flattens nested structures. -property('superpose', data_manipulation). % Overlays data structures. -property('sequential', data_manipulation). % Ensures sequential execution. -property('TupleConcat', data_structures). % Concatenates tuples. - -% Operations on data structures are generally deterministic, yielding predictable outcomes based on the inputs and operations. -property(P, data_manipulation) ==> property(P, 'Deterministic'). - -% This comprehensive reorganization and enhancement of comments provide a deeper, structured insight into the -% properties and functionalities within a Prolog-like environment, aiming for clarity and enriched understanding. - -% Associating properties with atoms for detailed understanding and querying -% --- Flow Control Structures --- -% These properties define the various control flow mechanisms used in programming, -% including conditionals, loops, and explicit control statements. They are fundamental -% to directing the execution flow of programs. -property('if', flow_control). -property('case', flow_control). -property('let', flow_control). -property('let*', flow_control). -property('do', flow_control). -property('limit', flow_control_modification). -property('offset', flow_control_modification). -property('max-time', execution_time_control). -% Flow control structures might involve backtracking on failure, providing multiple paths for execution. -property(P, flow_control) ==> property(P, 'OnFailBacktrack'). - -% --- Assertions and Testing Mechanisms --- -% Assertions are used to validate conditions at runtime. They are essential for testing, -% allowing developers to ensure that their code behaves as expected under various conditions. -property('assertTrue', assertions_testing). -property('assertFalse', assertions_testing). -property('assertEqual', assertions_testing). -property('assertNotEqual', assertions_testing). -property('assertEqualToResult', assertions_testing). -% By nature, assertions yield a deterministic outcome (true or false) based on the given condition. -property(P, assertions_testing) ==> property(P, 'Deterministic'). - -% --- Special Operators and System Interaction --- -% This category encompasses operators and functions that provide unique or enhanced -% functionalities, including system interactions and resource management. -property('!', special_operators). -property('call!', special_operators). -property('call-fn!', special_operators). -property('repl!', system_interaction). -property('pyr!', special_operators). -property('call-cleanup!', resource_management). -property('setup-call-cleanup!', resource_management). -property('with-output-to!', output_redirection). -% Certain operators like 'call!' exhibit deterministic behavior by executing a given goal. -property('call!', 'Deterministic'). -% Others, like 'call-fn!', might produce different results under different conditions, hence considered nondeterministic. -property('call-fn!', 'Nondeterministic'). -% The cut operator '!' is deterministic as it decisively affects control flow by preventing backtracking beyond its point of execution. -property('!', 'Deterministic'). - -% --- Data Structures and Manipulation --- -% Data structures such as lists, trees, and graphs are crucial for organizing and storing data. -% Manipulation includes operations like constructing, modifying, or querying these structures. -property('Cons', data_structures). -property('collapse', data_manipulation). -property('superpose', data_manipulation). -property('sequential', data_manipulation). -property('TupleConcat', data_structures). -% Operations on data structures typically result in deterministic outcomes, producing predictable modifications or constructions. -property(P, data_manipulation) ==> property(P, 'Deterministic'). - -% --- Evaluation and Execution --- -% Evaluation and execution properties pertain to how expressions, commands, or functions are processed and run. -% This includes interpreting code, printing output, and compiling expressions. -property('eval', evaluation_execution). -property('eval-for', evaluation_execution). -property('echo', evaluation_execution). -property('print', evaluation_execution). -property('println!', evaluation_execution). -property('compile-easy!', evaluation_execution). -property('time!', evaluation_execution). -% The 'eval' operation could lead to different outcomes based on the input, thus considered nondeterministic. -property('eval', 'Nondeterministic'). -% Conversely, 'echo' simply reflects its input without alteration, making it deterministic. -property('echo', 'Deterministic'). - -% --- Logic and Comparison --- -% Logical and comparison operations are fundamental in programming, enabling decision making -% and data comparison. This includes basic logical operations and comparisons between values. -property('and', logic_comparison). -property('or', logic_comparison). -property('not', logic_comparison). -% Logical operations result in deterministic outcomes, directly derived from their input values. -property(P, logic_comparison) ==> property(P, 'Deterministic'). - -% --- Additional and Miscellaneous --- -% This section covers a variety of functionalities not classified under the previous categories. -% It includes system interaction, functional programming utilities, arithmetic operations, -% and more, providing a wide range of capabilities. -property('atom-replace', data_manipulation). -property('fb-member', list_operations). -property('nop', control_structure). -property('empty', data_validation). -property('function', functional_programming). -property('return', functional_programming). -property('number-of', quantitative_analysis). -property('new-space', system_interaction). -property('bind!', system_interaction). -property('pragma!', system_interaction). -property('transfer!', system_interaction). -property('registered-python-function', interlanguage_integration). -property('S', symbolic_arithmetic). -property('Z', symbolic_arithmetic). -property('bc-base', recursion_control). -property('bc-base-ground', recursion_control). -property('bc-rec', recursion_control). - -% --- Rules for Automatic Property Inference --- -% These rules allow for automatic inference of certain properties based on categories, -% simplifying the property assignment process and ensuring consistency. -property('function', 'VariableArity'). -property('return', 'Deterministic'). -property(P, system_interaction) ==> property(P, 'Deterministic'). -property('fb-member', 'Nondeterministic'). -property(P, symbolic_arithmetic) ==> property(P, 'Deterministic'). -property(P, recursion_control) ==> property(P, 'Deterministic'). -property('bc-rec', 'Nondeterministic'). - -% This detailed commenting approach provides insights into the rationale behind each property assignment, -% facilitating a better understanding of their roles within the system and their implications on program behavior. - - - - -% Flow control structures indicate branching and looping mechanisms -property('!', special_operators). -property('if', flow_control). -property('case', flow_control). -property('let', flow_control). -property('let*', flow_control). -% 'if' can lead to different execution paths and might be considered nondeterministic -property('if', 'Nondeterministic'). - -property(X, flow_control) ==> property(X, 'OnFailBacktrack'). - -% Assertions and testing mechanisms for validating conditions or values -property('assertTrue', assertions_testing). -property('assertFalse', assertions_testing). -property('assertEqual', assertions_testing). -% Assertions typically produce a deterministic outcome based on their condition -property('assertTrue', 'Deterministic'). -property('assertFalse', 'Deterministic'). -property('assertEqual', 'Deterministic'). -% Mapping success/failure in Prolog to True/False for assertions -property('assertTrue', 'BooleanFunction'). -property('assertFalse', 'BooleanFunction'). - -% Special operators offer unique or enhanced functionality -property('pyr!', special_operators). -property('call!', special_operators). -property('call-fn!', special_operators). -% 'call!' has a deterministic behavior, executing a given goal -property('call!', 'Deterministic'). -% 'call-fn!' may produce different results, hence nondeterministic -property('call-fn!', 'Nondeterministic'). -% '!' (cut) decisively affects the control flow by preventing backtracking -property('!', 'Deterministic'). - -% Data structures and manipulation involve creating and working with compound data -property('Cons', data_structures). -% These operations are typically deterministic, producing a predictable structure -property('Cons', 'Deterministic'). - -property('collapse', 'Deterministic'). -property('collapse', flow_control). - -% Evaluation and execution concern the processing and running of code or expressions -property('eval', evaluation_execution). -property('echo', evaluation_execution). -% 'eval' might evaluate to different outcomes based on its input, thus nondeterministic -property('eval', 'Nondeterministic'). -% 'echo', simply reflecting its input, is deterministic -property('echo', 'Deterministic'). - -% Logic and comparison for logical operations and value comparisons -property('and', logic_comparison). -property('or', logic_comparison). -property('not', logic_comparison). -% Logical operations are deterministic, with outcomes directly derived from their inputs -% however they may be consuming a set of nondeterimiistic values so they might "appear" as nondeterministic -property('and', 'Deterministic'). -property('or', 'Deterministic'). -property('not', 'Deterministic'). - -% General properties provide additional characteristics and behaviors -% 'eval' is interpreted, running without prior compilation -property('eval', 'Interpreted'). -% 'eval-for' also is interpreted due to its dynamic nature -property('eval-for', 'Interpreted'). -% 'echo' might be considered compiled for efficiency in this hypothetical scenario -property('echo', 'Compiled'). -% 'let' directly transpiles into another form without modification -property('let', 'DirectTranspilation'). -% Arity specifics for 'let' and 'call!' -property('let', 'PredicateArity', 3). -property('call!', 'FunctionArity', 2). -% Demonstrating variable arity for 'echo' -property('echo', 'VariableArity', 1, 3). -% 'coerce' forces argument types, ensuring compatibility -property('coerce', 'CoerceArgsToTypes'). -% 'coerce' has a predictable outcome, thus deterministic -property('coerce', 'Deterministic'). -% 'quote' prevents evaluation, returning the input as is -property('quote', 'EvalNoArgs'). -% 'quote' acts as a data functor, encapsulating values -property('quote', 'DataFunctor'). -% Default behavior for 'eval' to return self on failure, ensuring robustness -property('eval', 'OnFailBacktrack'). -% 'let*' supports typed predicates, enhancing type safety -property('let*', 'TypedPred'). -% Expanding to all mentioned properties and their hypothetical applications -% 'quote' represents nondeterminism in this context -property('quote', 'Nondeterministic'). -% 'echo' involves direct transpilation for simplicity -property('echo', 'DirectTranspilation'). -% Assuming 'coerce' is compiled for performance reasons -property('coerce', 'Compiled'). -% 'eval-for' returns the Nth argument, demonstrating specific argument selection -property('eval-for', 'ReturnNthArg'). -% Skipping evaluation for 'quote', focusing on raw data handling -property('quote', 'EvalNoArgs'). -% The cut operator '!' is interpreted, directly influencing the Prolog execution flow -property('!', 'FunInterpreted'). -% 'call!' is compiled, optimizing its execution -property('call!', 'FunCompiled'). -% 'let*' undergoes idiomatic transpilation, preserving the original logic's essence -property('let*', 'IdiomaticTranspilation'). -% Introducing 'case' with the behavior to backtrack on failure, facilitating alternative solutions -property('case', 'OnFailBacktrack'). - -% --- Evaluation and Execution Enhancements --- -% These properties are related to advanced evaluation and execution features, such as dynamic evaluation -% of expressions and runtime execution control. They enable more flexible and powerful programming patterns. -property('car-atom', evaluation_execution_enhancements). -property('cdr-atom', evaluation_execution_enhancements). -% 'car-atom' and 'cdr-atom' allow for manipulation of list structures at runtime, typically in a deterministic manner. -property(P, evaluation_execution_enhancements) ==> property(P, 'Deterministic'). - -% --- Functional Programming Constructs and Utilities --- -% Functional programming is characterized by the use of functions as first-class citizens, -% promoting a declarative programming style and higher-order functions. -property('maplist!', functional_programming). -property('concurrent-maplist!', functional_programming). -% 'maplist!' applies a function to each element in a list deterministically, whereas -% 'concurrent-maplist!' might introduce nondeterminism due to concurrent execution. -property('maplist!', 'Deterministic'). -property('concurrent-maplist!', 'Nondeterministic'). - -% --- Arithmetic and Logical Operations --- -% Arithmetic operations form the basis of mathematical computations in programming, -% including basic operations like addition, subtraction, multiplication, and division. -property('+', arithmetic_operations). -property('-', arithmetic_operations). -property('*', arithmetic_operations). -property('mod', arithmetic_operations). -% These operations are deterministic, yielding specific results from given numeric inputs. -property(P, arithmetic_operations) ==> property(P, 'Deterministic'). - -% --- Error Handling and Advanced Control Flow Mechanisms --- -% Proper error handling is crucial for robust programs, allowing for graceful recovery -% from unexpected states or inputs. Advanced control flow mechanisms provide more complex -% patterns of execution beyond simple conditional checks and loops. -property('catch', error_handling_advanced). -property('throw', error_handling_advanced). -% Error handling operations like 'catch' and 'throw' can influence the control flow based on runtime conditions, -% potentially introducing nondeterminism if the error states or exceptions are not predictable. -property('catch', 'Nondeterministic'). -property('throw', 'Nondeterministic'). - -% --- System Interaction and Interlanguage Integration --- -% Interacting with the system or integrating with other programming languages extends the capabilities -% of Prolog programs, enabling them to leverage external libraries, systems, or frameworks. -property('call-string!', system_interaction). -% 'call-string!' allows for dynamic execution of Prolog code provided as a string, -% which might be nondeterministic depending on the runtime environment and the code being executed. -property('call-string!', 'Nondeterministic'). -property('registered-python-function', interlanguage_integration). -% Registering and invoking Python functions from Prolog illustrates interlanguage integration, -% enabling deterministic interoperability with Python codebases. -property('registered-python-function', 'Deterministic'). - -% --- Symbolic Arithmetic and Recursion Control --- -% Symbolic arithmetic involves the representation and manipulation of mathematical expressions in symbolic form. -% Recursion control is crucial for defining and managing recursive operations, ensuring termination and efficiency. -property('S', symbolic_arithmetic). -property('Z', symbolic_arithmetic). -property('bc-base', recursion_control). -property('bc-base-ground', recursion_control). -property('bc-rec', recursion_control). -% Symbolic arithmetic operations are deterministic, as they follow defined mathematical properties. -property(P, symbolic_arithmetic) ==> property(P, 'Deterministic'). -% Base cases in recursion are deterministic, ensuring predictable behavior and termination of recursive calls. -property('bc-base', 'Deterministic'). -property('bc-base-ground', 'Deterministic'). -% Recursive operations may introduce nondeterminism, especially when dealing with complex or dynamic data structures. -property('bc-rec', 'Nondeterministic'). - -% This continued explanation and categorization provide a deeper understanding of the properties, -% emphasizing the relationship between programming constructs and their expected behaviors in a logical or functional programming context. -% --- List Operations and Data Validation --- -% Operations on lists and validation of data are fundamental in many programming tasks, -% allowing for the manipulation, examination, and assurance of data integrity. -property('fb-member', list_operations). -property('nop', control_structure). -property('empty', data_validation). -% 'fb-member' checks for membership in a list, which could have nondeterministic outcomes based on list contents. -property('fb-member', 'Nondeterministic'). -% 'nop' represents a no-operation, effectively serving as a placeholder or for timing. -property('nop', 'Deterministic'). -% 'empty' checks for or represents an empty structure or condition, a deterministic operation. -property('empty', 'Deterministic'). - -% --- Resource Management and Output Redirection --- -% Managing resources effectively and redirecting output are crucial for creating efficient, -% responsive programs and for controlling how and where information is displayed or logged. -property('call-cleanup!', resource_management). -property('setup-call-cleanup!', resource_management). -property('with-output-to!', output_redirection). -% These operations ensure deterministic management of resources and output, -% following precise specifications for behavior. -property('call-cleanup!', 'Deterministic'). -property('setup-call-cleanup!', 'Deterministic'). -property('with-output-to!', 'Deterministic'). - -% --- Quantitative Analysis and Symbolic Representation --- -% Quantitative analysis involves operations that measure or quantify aspects of data, -% while symbolic representation deals with abstract symbols rather than explicit values. -property('number-of', quantitative_analysis). -property('S', symbolic_arithmetic). -property('Z', symbolic_arithmetic). -% 'number-of' provides a count or measure, yielding deterministic results. -property('number-of', 'Deterministic'). -% 'S' (successor) and 'Z' (zero) are used in Peano arithmetic, representing numbers symbolically. -property('S', 'Deterministic'). -property('Z', 'Deterministic'). - -% --- Recursion Control and Interlanguage Integration --- -% Recursion control is essential for managing recursive algorithms, while interlanguage integration -% allows Prolog to interact with and leverage capabilities from other programming languages. -property('bc-base', recursion_control). -property('bc-base-ground', recursion_control). -property('bc-rec', recursion_control). -property('registered-python-function', interlanguage_integration). -% Base cases in recursion ('bc-base', 'bc-base-ground') ensure predictable termination of recursive calls. -property('bc-base', 'Deterministic'). -property('bc-base-ground', 'Deterministic'). -% Recursive operations ('bc-rec') may introduce complexity, affecting determinism based on data structure and depth. -property('bc-rec', 'Nondeterministic'). -% Integration with Python ('registered-python-function') demonstrates deterministic interoperability. -property('registered-python-function', 'Deterministic'). - -% --- Enhanced System Interaction and Dynamic Execution --- -% Dynamic execution features and enhanced system interaction capabilities extend Prolog's utility, -% enabling runtime evaluation of code and interaction with the system or external environments. -property('call-string!', system_interaction). -% 'call-string!' executes Prolog code provided as a string, potentially introducing nondeterminism -% based on the dynamic nature of the executed code and external state. -property('call-string!', 'Nondeterministic'). - -% This further continuation not only enriches the documentation with detailed explanations of each property and its implications but also -% fosters a deeper understanding of the sophisticated capabilities within a Prolog environment. Through these verbose commentaries, -% the nuanced behaviors and functionalities of programming constructs are elucidated, offering insights into their practical applications and theoretical foundations. -% --- Dynamic Code Evaluation and Modification --- -% Dynamic code evaluation and modification allow for runtime interpretation and alteration of code, -% offering flexibility for adaptive or responsive programming patterns. -property('eval', dynamic_evaluation). -% 'eval' allows for the execution of dynamically constructed code, which could lead to nondeterministic outcomes -% depending on the runtime environment and input data. -property('eval', 'Nondeterministic'). - -% --- Interactivity and Debugging Tools --- -% Tools and functionalities that facilitate interactivity with the user or debugging capabilities -% enhance the development experience by providing insights into program execution and allowing for real-time interaction. -property('trace!', debugging_tools). -property('notrace!', debugging_tools). -property('rtrace!', debugging_tools). -% Debugging commands like 'trace!', 'notrace!', and 'rtrace!' offer deterministic control over tracing and debugging states, -% allowing developers to enable or disable debugging modes as needed. -property(P, debugging_tools) ==> property(P, 'Deterministic'). - -% --- Advanced List Operations and Utilities --- -% Advanced operations on lists and utility functions provide powerful mechanisms for data manipulation and analysis, -% extending the core capabilities for handling lists and collections. -property('dedup!', list_utilities). -% 'dedup!' removes duplicate elements from a list, providing a deterministic way to ensure unique elements. -property('dedup!', 'Deterministic'). - -% --- Arithmetic and Logic Enhancements --- -% Enhancements to arithmetic and logic functionalities support more complex mathematical operations and logical reasoning, -% broadening the scope of computational tasks that can be addressed. -property('hyperpose', arithmetic_enhancements). -% 'hyperpose' could be involved in advanced arithmetic or matrix operations, assumed to be deterministic -% for well-defined mathematical transformations. -property('hyperpose', 'Deterministic'). - -% --- Functional Programming Enhancements --- -% Enhancements and utilities for functional programming emphasize the use of functions as first-class citizens, -% promoting immutability, statelessness, and higher-order functions for more declarative programming approaches. -property('maplist!', functional_enhancements). -% 'maplist!' applies a function to each element of a list in a deterministic manner, preserving list structure. -property('maplist!', 'Deterministic'). - -% --- System and External Integration --- -% System integration and functionalities that enable external integrations extend the capabilities of Prolog -% to interact with operating systems, external libraries, or other programming languages. -property('call-string!', external_integration). -% 'call-string!' dynamically evaluates a string of Prolog code, potentially incorporating external state or data, -% which may introduce nondeterminism depending on the specific usage and external dependencies. -property('call-string!', 'Nondeterministic'). - -property('!', 'FunInterpreted'). -property('!', special_operators). -property('!', special_operators). % Cut operator, controls backtracking. -property('*', arithmetic_operations). -property('+', arithmetic_operations). -property('-', arithmetic_operations). -property('Cons', 'Deterministic'). -property('Cons', data_structures). -property('Cons', data_structures). % Constructs a pair or list. -property('S', 'Deterministic'). -property('S', symbolic_arithmetic). -property('TupleConcat', data_structures). -property('TupleConcat', data_structures). % Concatenates tuples. -property('Z', 'Deterministic'). -property('Z', symbolic_arithmetic). -property('and', 'Deterministic'). -property('and', logic_comparison). -property('assertEqual', 'Deterministic'). -property('assertEqual', assertions_testing). -property('assertEqual', assertions_testing). % Asserts equality between two values. -property('assertEqualToResult', assertions_testing). -property('assertEqualToResult', assertions_testing). % Asserts a value equals an expected result. -property('assertFalse', 'BooleanFunction'). -property('assertFalse', 'Deterministic'). -property('assertFalse', assertions_testing). -property('assertFalse', assertions_testing). % Asserts a condition is false. -property('assertNotEqual', assertions_testing). -property('assertNotEqual', assertions_testing). % Asserts inequality. -property('assertTrue', 'BooleanFunction'). -property('assertTrue', 'Deterministic'). -property('assertTrue', assertions_testing). -property('assertTrue', assertions_testing). % Asserts a condition is true. -property('atom-replace', data_manipulation). -property('bc-base', 'Deterministic'). -property('bc-base', recursion_control). -property('bc-base-ground', 'Deterministic'). -property('bc-base-ground', recursion_control). -property('bc-rec', 'Nondeterministic'). -property('bc-rec', recursion_control). -property('bind!', system_interaction). -property('call!', 'Deterministic'). -property('call!', 'FunCompiled'). -property('call!', 'FunctionArity', 2). -property('call!', special_operators). -property('call!', special_operators). % Dynamically calls a predicate. -property('call-cleanup!', 'Deterministic'). -property('call-cleanup!', resource_management). -property('call-cleanup!', resource_management). % Ensures cleanup after execution. -property('call-fn!', 'Nondeterministic'). -property('call-fn!', special_operators). -property('call-fn!', special_operators). % Calls a function dynamically. -property('call-string!', 'Nondeterministic'). -property('call-string!', external_integration). -property('call-string!', system_interaction). -property('car-atom', evaluation_execution_enhancements). -property('case', 'OnFailBacktrack'). -property('case', flow_control). -property('case', flow_control). % Choice between multiple paths. -property('catch', 'Nondeterministic'). -property('catch', error_handling_advanced). -property('cdr-atom', evaluation_execution_enhancements). -property('coerce', 'CoerceArgsToTypes'). -property('coerce', 'Compiled'). -property('coerce', 'Deterministic'). -property('collapse', 'Deterministic'). -property('collapse', data_manipulation). -property('collapse', data_manipulation). % Flattens nested structures. -property('collapse', flow_control). -property('compile-easy!', evaluation_execution). -property('concurrent-maplist!', 'Nondeterministic'). -property('concurrent-maplist!', functional_programming). -property('dedup!', 'Deterministic'). -property('dedup!', list_utilities). -property('do', flow_control). -property('do', flow_control). % Executes a block of code. -property('echo', 'Compiled'). -property('echo', 'Deterministic'). -property('echo', 'DirectTranspilation'). -property('echo', 'VariableArity', 1, 3). -property('echo', evaluation_execution). -property('empty', 'Deterministic'). -property('empty', data_validation). -property('eval', 'Interpreted'). -property('eval', 'Nondeterministic'). -property('eval', 'OnFailBacktrack'). -property('eval', dynamic_evaluation). -property('eval', evaluation_execution). -property('eval-for', 'Interpreted'). -property('eval-for', 'ReturnNthArg'). -property('eval-for', evaluation_execution). -property('fb-member', 'Nondeterministic'). -property('fb-member', list_operations). -property('function', 'VariableArity'). -property('function', functional_programming). -property('hyperpose', 'Deterministic'). -property('hyperpose', arithmetic_enhancements). -property('if', 'Nondeterministic'). -property('if', flow_control). -property('if', flow_control). % Conditional execution based on a boolean expression. -property('let', 'DirectTranspilation'). -property('let', 'PredicateArity', 3). -property('let', flow_control). -property('let', flow_control). % Variable binding in a local scope. -property('let*', 'IdiomaticTranspilation'). -property('let*', 'TypedPred'). -property('let*', flow_control). -property('let*', flow_control). % Sequential variable binding with dependency. -property('limit', flow_control_modification). -property('limit', flow_control_modification). % Limits the number of solutions. -property('maplist!', 'Deterministic'). -property('maplist!', functional_enhancements). -property('maplist!', functional_programming). -property('max-time', execution_time_control). -property('max-time', execution_time_control). % Limits execution time. -property('mod', arithmetic_operations). -property('new-space', system_interaction). -property('nop', 'Deterministic'). -property('nop', control_structure). -property('not', 'Deterministic'). -property('not', logic_comparison). -property('notrace!', debugging_tools). -property('number-of', 'Deterministic'). -property('number-of', quantitative_analysis). -property('offset', flow_control_modification). -property('offset', flow_control_modification). % Skips a number of solutions. -property('or', 'Deterministic'). -property('or', logic_comparison). -property('pragma!', system_interaction). -property('print', evaluation_execution). -property('println!', evaluation_execution). -property('pyr!', special_operators). -property('pyr!', special_operators). % Example of an extension or plugin call. -property('quote', 'DataFunctor'). -property('quote', 'EvalNoArgs'). -property('quote', 'Nondeterministic'). -property('registered-python-function', 'Deterministic'). -property('registered-python-function', interlanguage_integration). -property('repl!', system_interaction). -property('repl!', system_interaction). % Interactive read-eval-print loop. -property('return', 'Deterministic'). -property('return', functional_programming). -property('rtrace!', debugging_tools). -property('sequential', data_manipulation). -property('sequential', data_manipulation). % Ensures sequential execution. -property('setup-call-cleanup!', 'Deterministic'). -property('setup-call-cleanup!', resource_management). -property('setup-call-cleanup!', resource_management). % Setup, call, and cleanup pattern. -property('superpose', data_manipulation). -property('superpose', data_manipulation). % Overlays data structures. -property('throw', 'Nondeterministic'). -property('throw', error_handling_advanced). -property('time!', evaluation_execution). -property('trace!', debugging_tools). -property('transfer!', system_interaction). -property('with-output-to!', 'Deterministic'). -property('with-output-to!', output_redirection). -property('with-output-to!', output_redirection). % Redirects output to a different stream. -property(P, arithmetic_operations) ==> property(P, 'Deterministic'). -property(P, assertions_testing) ==> property(P, 'Deterministic'). -property(P, data_manipulation) ==> property(P, 'Deterministic'). -property(P, debugging_tools) ==> property(P, 'Deterministic'). -property(P, evaluation_execution_enhancements) ==> property(P, 'Deterministic'). -property(P, flow_control) ==> property(P, 'OnFailBacktrack'). -property(P, logic_comparison) ==> property(P, 'Deterministic'). -property(P, recursion_control) ==> property(P, 'Deterministic'). -property(P, symbolic_arithmetic) ==> property(P, 'Deterministic'). -property(P, system_interaction) ==> property(P, 'Deterministic'). -property(X, flow_control) ==> property(X, 'OnFailBacktrack'). - diff --git a/.Attic/metta_lang/metta_ontology.pl.pfc3 b/.Attic/metta_lang/metta_ontology.pl.pfc3 deleted file mode 100755 index 4f78029649c..00000000000 --- a/.Attic/metta_lang/metta_ontology.pl.pfc3 +++ /dev/null @@ -1,117 +0,0 @@ - -% --- Core Logical and Arithmetic Operators --- -property('!', special_operators). % Cut operator, prevents backtracking beyond its point. -property('\\=', logic_comparison). % Inequality test. -property('=', logic_comparison). % Equality/unification operator. -property('==', logic_comparison). % Strict equality test. -property('=<', logic_comparison). % Less than or equal to. -property('<', logic_comparison). % Less than. -property('>=', logic_comparison). % Greater than or equal to. -property('>', logic_comparison). % Greater than. -property('->', control_flow). % If-then construct. -property(';', control_flow). % Disjunction; or. -property(',', control_flow). // Conjunction; and. -property('+', arithmetic_operations). % Addition. -property('-', arithmetic_operations). // Subtraction. -property('*', arithmetic_operations). % Multiplication. -property('mod', arithmetic_operations). % Modulus operation. - -% --- Data Structures, Manipulation, and List Operations --- -property('collapse', data_manipulation). % Collapses a structure. -property('sequential', data_manipulation). % Sequentially applies operations. -property('car-atom', list_operations). % Retrieves the head of a list. -property('cdr-atom', list_operations). % Retrieves the tail of a list. - -property('Cons', data_structures). % Constructs a list. -property('TupleConcat', data_structures). % Concatenates tuples. -property('make_list', list_creation). % Creates a list with specified elements. - - -% --- Evaluation, Execution, and Functionality --- -property('eval', evaluation_execution). % Evaluates an expression. -property('time!', evaluation_execution). % Execution timing. - -% --- System and External Integration --- -property('call-string!', code_inclusion). % Evaluates a string of Prolog code. -property('registered-python-function', code_inclusion). % Interacts with Python functions. - -% --- Assertions, Testing, and Debugging --- -property('assertTrue', assertions_testing). % Asserts a condition is true. -property('assertFalse', assertions_testing). % Asserts a condition is false. -property('assertEqual', assertions_testing). % Asserts two values are equal. -property('assertNotEqual', assertions_testing). % Asserts two values are not equal. -property('assertEqualToResult', assertions_testing). % Asserts equality to a result. - -property('trace!', debugging_tools). % Prints some debug - -property('no-rtrace!', debugging_tools). % Disables tracing for debugging. -property('rtrace!', debugging_tools). % Enables tracing for debugging. - -% --- Error Handling, Control Flow, and Conditional Execution --- -property('if', flow_control). % Conditional execution. -property('case', flow_control). % Case selection. -property('let', flow_control). % Variable assignment. -property('let*', flow_control). % Sequential variable assignment. -property('do', flow_control). % Looping construct. -property('catch', error_handling_advanced). % Catches exceptions. -property('throw', error_handling_advanced). % Throws exceptions. -property('function', flow_control). % a Function block. -property('return', flow_control). % return value of a function block - -property('dedup!', iteration_limit). % Removes duplicate elements from iteration -property('nth!', iteration_limit). % Allows only the Nth1 Iterator -property('limit!', iteration_limit). % Allows only the Nth1 Iterator -property('time-limit!', iteration_limit). -property(offset!', iteration_limit). - -property('pragma!', compiler_directive). % Compiler directive for optimizations/settings. -property('include!', code_inclusion). % Includes code from another file or context. -property('load-ascii', code_inclusion). % Loads ASCII file content. -property('extend-py!', code_inclusion). % Extends integration with Python. -property('pyr', code_inclusion). % Calls Python code directly. -property('import!', code_inclusion). % Imports an external module or file. -property('transfer!', state_transfer). % Transfers space content to another space - - -% --- Symbolic Arithmetic, Enhancements, and Miscellaneous --- -property('S', symbolic_arithmetic). % Successor in Peano arithmetic. -property('Z', symbolic_arithmetic). % Zero in Peano arithmetic. -property('fromNumber', type_conversion). % Converts from a numeric type. - - -property('quote', data_manipulation). % Prevents evaluation, treating input as literal. -property('coerce', type_conversion). % Forces argument types for compatibility. -property('enforce', logic_enforcement). % Enforces a logical rule. - -% --- Newly Included and Miscellaneous Properties --- -property('change-state!', system_interaction). % Changes the state of a system component. -property('set-state', state_management). % Sets the state of a component or system. -property('get-state', state_management). % Gets the state of a component or system. - - -property('remove-atom', data_manipulation). % Removes an atom from a structure. -property('replace-atom', data_manipulation). % Replaces an atom within a structure. -property(',', control_flow). % Conjunction; and. -property('match', pattern_matching). % Matches patterns within structures or data. -property('get-atoms', data_retrieval). % Retrieves atoms from a structure. -property('new-space', memory_management). % Allocates new space or memory region. - -property('or', logic_comparison). % Logical OR. -property('and', logic_comparison). % Logical OR. -property('not', logic_comparison). % Logical OR. - -property('range', arithmetic_operations). % Generates a range of numbers. -property('current-arity', property_definition). % Defines the arity of predicates/functions. -property('countElement', list_operations). % Counts occurrences of an element. -property('collapseCardinality', data_manipulation). % Collapses structures with cardinality consideration. -property('Error', error_handling). % Defines or triggers an error. -property('length', list_operations). % Determines the length of a list. -property('nop', control_structure). % No-operation placeholder. -property('number-of', quantitative_analysis). % Quantifies occurrences. -property('print', output_operations). % Prints text to output. -property('println!', output_operations). % Prints text with newline to output. -property('remove-atom', data_manipulation). % Removes an atom from structures. -property('replace-atom', data_manipulation). % Replaces atoms within structures. -property('superpose', data_manipulation). % Superposes data structures. -property('tuple-count', data_manipulation). % Counts tuples within a structure. -property('with-output-to!', output_redirection). % Redirects output to a specified target. diff --git a/.Attic/metta_lang/metta_ontology_level_1.pfc.pl b/.Attic/metta_lang/metta_ontology_level_1.pfc.pl deleted file mode 100755 index 83e12e977ee..00000000000 --- a/.Attic/metta_lang/metta_ontology_level_1.pfc.pl +++ /dev/null @@ -1,388 +0,0 @@ - - - - - - - - -%:- multifile(baseKB:agent_action_queue/3). -%:- dynamic(baseKB:agent_action_queue/3). - -:- set_prolog_flag(gc,true). - -:- thread_local(t_l:disable_px/0). -:- retractall(t_l:disable_px). - -:- must(\+ t_l:disable_px). - -:- op(500,fx,'~'). -:- op(1050,xfx,('=>')). -:- op(1050,xfx,'<==>'). -:- op(1050,xfx,('<-')). -:- op(1100,fx,('==>')). -:- op(1150,xfx,('::::')). -:- - current_prolog_flag(access_level,Was), - set_prolog_flag(access_level,system), - op(1190,xfx,('::::')), - op(1180,xfx,('==>')), - op(1170,xfx,'<==>'), - op(1160,xfx,('<-')), - op(1150,xfx,'=>'), - op(1140,xfx,'<='), - op(1130,xfx,'<=>'), - op(600,yfx,'&'), - op(600,yfx,'v'), - op(350,xfx,'xor'), - op(300,fx,'~'), - op(300,fx,'-'), - op(1199,fx,('==>')), - set_prolog_flag(access_level,Was). - -:- style_check(-discontiguous). -%:- enable_mpred_expansion. -%:- expects_dialect(pfc). - -/* -:- dynamic lmcache:session_io/4, lmcache:session_agent/2, lmcache:agent_session/2, telnet_fmt_shown/3, agent_action_queue/3). -:- dynamic lmcache:session_io/4, lmcache:session_agent/2, lmcache:agent_session/2, telnet_fmt_shown/3, agent_action_queue/3). - -*/ -%:- nop('$set_source_module'( baseKB)). -:- set_prolog_flag(runtime_speed, 0). -:- set_prolog_flag(runtime_safety, 2). -:- set_prolog_flag(runtime_debug, 2). -:- set_prolog_flag(unsafe_speedups, false). - -:- set_prolog_flag(expect_pfc_file,always). - - -% Predicate and Function Arity Definitions: -% Specifies the number of arguments (arity) for predicates and functions, which is fundamental -% for understanding the complexity and capabilities of various logical constructs. Predicates are defined -% from Nullary (no arguments) up to Denary (ten arguments), reflecting a range of logical conditions or assertions. -% Functions are similarly defined but focus on operations that return a value, extending up to Nonary (nine arguments). -p_arity('NullaryPredicate', 0). % No arguments. -p_arity('UnaryPredicate', 1). % One argument. -p_arity('BinaryPredicate', 2). % Two arguments. -p_arity('TernaryPredicate', 3). % Three arguments, and so on. -p_arity('QuaternaryPredicate', 4). -p_arity('QuinaryPredicate', 5). -p_arity('SenaryPredicate', 6). -p_arity('SeptenaryPredicate', 7). -p_arity('OctaryPredicate', 8). -p_arity('NonaryPredicate', 9). -p_arity('DenaryPredicate', 10). - -f_arity('NullaryFunction', 0). % No return value, essentially a procedure. -f_arity('UnaryFunction', 1). % Returns a single value, and so on. -f_arity('BinaryFunction', 2). -f_arity('TernaryFunction', 3). -f_arity('QuaternaryFunction', 4). -f_arity('QuinaryFunction', 5). -f_arity('SenaryFunction', 6). -f_arity('SeptenaryFunction', 7). -f_arity('OctaryFunction', 8). -f_arity('NonaryFunction', 9). - -% Enforcing Equivalency Between Predicates and Functions: -% Establishes a logical framework to equate the conceptual roles of predicates and functions based on arity. -% This equivalence bridges the functional programming and logical (declarative) paradigms within Prolog, -% allowing a unified approach to defining operations and assertions. -(equivalentTypes(PredType,FunctType) ==> - (in(FunctorObject,PredType) - <==> - in(FunctorObject,FunctType))). -% Automatically generating equivalency rules based on the arity of predicates and functions. -% This facilitates a dynamic and flexible understanding of function and predicate equivalences, -% enhancing Prolog's expressive power and semantic richness. -(((p_arity(PredType,PA), {plus(FA,1,PA), FA>=0}, f_arity(FunctType,FA))) - ==> equivalentTypes(PredType,FunctType)). - - - -% Interactivity and Debugging Tools: -% Tools and functionalities that facilitate interactivity with the user or debugging capabilities -% enhance the development experience by providing insights into program execution and allowing for real-time interaction. -property('trace!', debugging_tools). -property('nortrace!', debugging_tools). -property('rtrace!', debugging_tools). -% Debugging commands like 'trace!', 'notrace!', and 'rtrace!' offer deterministic control over tracing and debugging states, -% allowing developers to enable or disable debugging modes as needed. -property(P, debugging_tools) ==> property(P, 'Deterministic'). - -% --- Error Handling, Control Flow, and Conditional Execution --- -% Control structures are essential for directing the execution flow of a program. They enable conditional execution, -% looping, and choice between different paths of execution based on logical conditions or external inputs. -property('if', flow_control). % Executes a block of code if a given condition is true. -property('case', flow_control). % Selects a block of code to execute from multiple options based on a condition. -property('let', flow_control). % Assigns a value to a variable within a local scope. -property('let*', flow_control). % Sequentially binds variables to values, allowing later bindings to depend on earlier ones. -property('do', flow_control). % General looping construct. -property('catch', error_handling_advanced). % Catches exceptions, allowing for custom error handling. -property('throw', error_handling_advanced). % Throws a custom exception, which can be caught by a catch block. -property('function',flow_control). % a Function block. -property('return', flow_control). % return value of a function block -% Inferring backtracking behavior in flow control structures. This indicates that certain paths -% of execution might lead to backtracking, a core concept in Prolog for exploring alternative solutions. -property(P, flow_control) ==> property(P, 'OnFailBacktrack'). - - -property('limit', flow_control_modification). % Limits the number of solutions. -property('offset', flow_control_modification). % Skips a number of solutions. -property('max-time', flow_control_modification). % Limits execution time. - - -% Assertions and Testing Mechanisms: -% Assertions provide a powerful tool for validating expected conditions or outcomes within a program. -% They are critical for debugging and verifying the correctness of logic under various conditions. -property('assertTrue', assertions_testing). % Asserts a condition is true. -property('assertFalse', assertions_testing). % Asserts a condition is false. -property('assertEqual', assertions_testing). % Asserts equality between two values. -property('assertNotEqual', assertions_testing). % Asserts inequality. -property('assertEqualToResult', assertions_testing). % Asserts a value equals an expected result. -% Asserting deterministic outcomes for testing mechanisms. These properties ensure that assertions -% yield predictable, binary outcomes (pass or fail) based on the conditions they test. -property(P, assertions_testing) ==> property(P, 'Deterministic'). - -% Special Operators and System Interaction: -% Special operators and functionalities enhance Prolog's interaction with its execution environment and system, -% enabling dynamic control flows, system-level operations, and interaction with external processes or data. -property('!', special_operators). % Cut operator, controls backtracking. -property('call!', special_operators). % Dynamically calls a predicate. -property('call-fn!', special_operators). % Calls a function dynamically. -property('repl!', system_interaction). % Interactive read-eval-print loop. -property('pyr!', special_operators). % Example of an extension or plugin call. -property('call-cleanup!', resource_management). % Ensures cleanup after execution. -property('setup-call-cleanup!', resource_management). % Setup, call, and cleanup pattern. -property('with-output-to!', output_redirection). % Redirects output to a different stream. -% Deterministic behavior is noted for operations that have predictable outcomes, -% while nondeterministic behavior is acknowledged for operations whose results may vary. -property('call!', 'Deterministic'). -property('call-fn!', 'Nondeterministic'). -property('!', 'Deterministic'). - -% Data Structures and Manipulation: -% The definition, organization, and manipulation of data structures are foundational aspects of programming. -% These operations facilitate the storage, retrieval, and modification of data in structured forms. -property('Cons', data_structures). % Constructs a pair or list. -property('collapse', data_manipulation). % Flattens nested structures. -property('superpose', data_manipulation). % Overlays data structures. -property('sequential', data_manipulation). % Ensures sequential execution. -%property('TupleConcat', data_structures). % Concatenates tuples. -% Operations on data structures are generally deterministic, yielding predictable outcomes based on the inputs and operations. -property(P, data_manipulation) ==> property(P, 'Deterministic'). - -% Logic and Comparison: -% Logical and comparison operations are fundamental in programming, enabling decision making -% and data comparison. This includes basic logical operations and comparisons between values. -property('and', logic_comparison). -property('or', logic_comparison). -property('not', logic_comparison). -% Logical operations result in deterministic outcomes, directly derived from their input values. -property(P, logic_comparison) ==> property(P, 'Deterministic'). - -% Additional and Miscellaneous: -% This section covers a variety of functionalities not classified under the previous categories. -% It includes system interaction, functional programming utilities, arithmetic operations, -% and more, providing a wide range of capabilities. -property('atom-replace', data_manipulation). -property('fb-member', list_operations). -property('nop', control_structure). -property('empty', data_validation). -property('function', functional_programming). -property('number-of', quantitative_analysis). -property('new-space', system_interaction). -property('bind!', system_interaction). -property('pragma!', system_interaction). -property('transfer!', system_interaction). -property('registered-python-function', interlanguage_integration). - - -property('S', symbolic_arithmetic). -property('Z', symbolic_arithmetic). - - -% Rules for Automatic Property Inference: -% These rules allow for automatic inference of certain properties based on categories, -% simplifying the property assignment process and ensuring consistency. -property('function', 'VariableArity'). -property('return', 'Deterministic'). -property(P, system_interaction) ==> property(P, 'Deterministic'). -property('fb-member', 'Nondeterministic'). -property(P, symbolic_arithmetic) ==> property(P, 'Deterministic'). -property(P, recursion_control) ==> property(P, 'Deterministic'). -property('bc-rec', 'Nondeterministic'). - - -% Evaluation and Execution: -% Evaluation and execution properties pertain to how expressions, commands, or functions are processed and run. -% This includes interpreting code, printing output, and compiling expressions. -% 'eval' allows for the execution of dynamically constructed code, which could lead to nondeterministic outcomes -% depending on the runtime environment and input data. -property('eval', 'Nondeterministic'). -property('eval-for', evaluation_execution). -property('echo', evaluation_execution). -property('print', evaluation_execution). -property('println!', evaluation_execution). -property('compile-easy!', evaluation_execution). -property('time!', evaluation_execution). -% The 'eval' operation could lead to different outcomes based on the input, thus considered nondeterministic. -property('eval', 'Nondeterministic'). -% Conversely, 'echo' simply reflects its input without alteration, making it deterministic. -property('echo', 'Deterministic'). - -% Enhanced System Interaction and Dynamic Execution: -% Dynamic execution features and enhanced system interaction capabilities extend Prolog's utility, -% enabling runtime evaluation of code and interaction with the system or external environments. -% 'call-string!' executes Prolog code provided as a string, potentially introducing nondeterminism -% based on the dynamic nature of the executed code and external state. -property('call-string!', external_integration). -% 'call-string!' allows for dynamic execution of Prolog code provided as a string, -% which might be nondeterministic depending on the runtime environment and the code being executed. -property('call-string!', 'Nondeterministic'). -% Registering and invoking Python functions from Prolog illustrates interlanguage integration, -% enabling deterministic interoperability with Python codebases. -property('registered-python-function', 'Deterministic'). -% Error Handling and Advanced Control Flow Mechanisms: -% Proper error handling is crucial for robust programs, allowing for graceful recovery -% from unexpected states or inputs. Advanced control flow mechanisms provide more complex -% patterns of execution beyond simple conditional checks and loops. -property('catch', error_handling_advanced). -property('throw', error_handling_advanced). -% Error handling operations like 'catch' and 'throw' can influence the control flow based on runtime conditions, -% potentially introducing nondeterminism if the error states or exceptions are not predictable. -property('catch', 'Nondeterministic'). -property('throw', 'Nondeterministic'). - -% Arithmetic and Logical Operations: -% Arithmetic operations form the basis of mathematical computations in programming, -% including basic operations like addition, subtraction, multiplication, and division. -property('+', arithmetic_operations). -property('-', arithmetic_operations). -property('*', arithmetic_operations). -property('mod', arithmetic_operations). -% These operations are deterministic, yielding specific results from given numeric inputs. -property(P, arithmetic_operations) ==> property(P, 'Deterministic'). - -% List Operations and Data Validation: -% Operations on lists and validation of data are fundamental in many programming tasks, -% allowing for the manipulation, examination, and assurance of data integrity. -property('fb-member', list_operations). -% 'fb-member' checks for membership in a list, which could have nondeterministic outcomes based on list contents. -property('fb-member', 'Nondeterministic'). -property('nop', control_structure). -% 'nop' represents a no-operation, effectively serving as a placeholder or for timing. -property('nop', 'Deterministic'). -property('empty', data_validation). -% 'empty' checks for or represents an empty structure or condition, a deterministic operation. -property('empty', 'Deterministic'). - -% Advanced List Operations and Utilities: -% Advanced operations on lists and utility functions provide powerful mechanisms for data manipulation and analysis, -% extending the core capabilities for handling lists and collections. -property('dedup!', list_utilities). -% 'dedup!' removes duplicate elements from a list, providing a deterministic way to ensure unique elements. -property('dedup!', 'Deterministic'). - -% Arithmetic and Logic Enhancements: -% Enhancements to arithmetic and logic functionalities support more complex mathematical operations and logical reasoning, -% broadening the scope of computational tasks that can be addressed. -property('hyperpose', arithmetic_enhancements). -% 'hyperpose' could be involved in advanced arithmetic or matrix operations, assumed to be deterministic -% for well-defined mathematical transformations. -property('hyperpose', 'Deterministic'). - -% Functional Programming Enhancements: -% Enhancements and utilities for functional programming emphasize the use of functions as first-class citizens, -% promoting immutability, statelessness, and higher-order functions for more declarative programming approaches. -property('maplist!', functional_enhancements). -% 'maplist!' applies a function to each element of a list in a deterministic manner, preserving list structure. -property('maplist!', 'Deterministic'). -property('concurrent-maplist!', functional_programming). -% 'concurrent-maplist!' might introduce nondeterminism due to concurrent execution. -property('concurrent-maplist!', 'Nondeterministic'). - - - -% Quantitative Analysis and Symbolic Representation: -% Quantitative analysis involves operations that measure or quantify aspects of data, -% while symbolic representation deals with abstract symbols rather than explicit values. -property('number-of', quantitative_analysis). -% 'number-of' provides a count or measure, yielding deterministic results. -property('number-of', 'Deterministic'). -property('S', symbolic_arithmetic). -property('Z', symbolic_arithmetic). -% 'S' (successor) and 'Z' (zero) are used in Peano arithmetic, representing numbers symbolically. -property('S', 'Deterministic'). -property('Z', 'Deterministic'). - - - % --- Core Logical and Arithmetic Operators --- - % These operators are fundamental in controlling logic flow and evaluating conditions within programs. - properties('!', [special_operators, 'Deterministic']). % Cut operator, prevents backtracking beyond its point. - properties('\\=', [logic_comparison, 'Deterministic']). % Inequality test. - properties('=', [logic_comparison, 'Deterministic']). % Equality/unification operator. - properties('==', [logic_comparison, 'Deterministic']). % Strict equality test. - properties('=<', [logic_comparison, 'Deterministic']). % Less than or equal to. - properties('<', [logic_comparison, 'Deterministic']). % Less than. - properties('>=', [logic_comparison, 'Deterministic']). % Greater than or equal to. - properties('>', [logic_comparison, 'Deterministic']). % Greater than. - properties('->', [control_flow, 'Deterministic']). % If-then construct. - properties(';', [control_flow, 'Nondeterministic']). % Disjunction; or. - properties(',', [control_flow, 'Deterministic']). % Conjunction; and. - properties('+', [arithmetic_operations, 'Deterministic']). % Addition. - properties('-', [arithmetic_operations, 'Deterministic']). % Subtraction. - properties('*', [arithmetic_operations, 'Deterministic']). % Multiplication. - properties('mod', [arithmetic_operations, 'Deterministic']). % Modulus operation. - - % --- Data Structures, Manipulation, and List Operations --- - % Operations that involve the creation, manipulation, and analysis of complex data structures. - properties('Cons', [data_structures, 'Deterministic']). % Constructs a list or pair. - properties('collapse', [data_manipulation, 'Deterministic']). % Collapses nested structures into a simpler form. - %properties('TupleConcat', [data_structures, 'Deterministic']). % Concatenates tuples into a single tuple. - properties('sequential', [data_manipulation, 'Deterministic']). % Applies operations in a sequential manner. - properties('dedup!', [list_utilities, 'Deterministic']). % Removes duplicate elements from a list. - properties('car-atom', [list_operations, 'Deterministic']). % Retrieves the head of a list. - properties('cdr-atom', [list_operations, 'Deterministic']). % Retrieves the tail of a list, excluding the head. - - % --- Evaluation, Execution, and Functionality --- - % Pertains to the evaluation of expressions, execution of blocks, and general functionality enhancements. - properties('eval', [evaluation_execution, 'Nondeterministic']). % Dynamically evaluates a given expression. - properties('echo', [evaluation_execution, 'Deterministic']). % Echoes or returns the given input. - properties('compile-easy!', [evaluation_execution, 'Deterministic']). % Simplifies the compilation process. - properties('time!', [evaluation_execution, 'Deterministic']). % Measures the execution time of a block. - - % --- System and External Integration --- - % Includes properties for integrating with external systems, files, and languages. - properties('call-string!', [external_integration, 'Nondeterministic']). % Executes Prolog code provided as a string. - properties('registered-python-function', [interlanguage_integration, 'Deterministic']). % Allows calling Python functions from Prolog. - properties('extend-py!', [interlanguage_integration, 'Deterministic']). % Extends integration capabilities with Python. - properties('get-state', [state_management, 'Deterministic']). % Retrieves the current state of a specified system component. - - % --- Assertions, Testing, and Debugging --- - % Tools and properties aimed at facilitating testing, debugging, and asserting conditions within programs. - properties('assertTrue', [assertions_testing, 'Deterministic']). % Asserts that a given condition evaluates to true. - properties('assertFalse', [assertions_testing, 'Deterministic']). % Asserts that a given condition evaluates to false. - properties('assertEqual', [assertions_testing, 'Deterministic']). % Asserts the equality of two expressions. - properties('assertNotEqual', [assertions_testing, 'Deterministic']). % Asserts the inequality of two expressions. - properties('assertEqualToResult', [assertions_testing, 'Deterministic']). % Asserts that an expression equals an expected result. - properties('trace!', [debugging_tools, 'Deterministic']). % Enables tracing for debugging purposes. - properties('notrace!', [debugging_tools, 'Deterministic']). % Disables tracing. - properties('rtrace!', [debugging_tools, 'Deterministic']). % Reversible tracing for debugging, allows toggling on/off. - - - % --- Symbolic Arithmetic, Enhancements, and Miscellaneous --- - % Additional properties that provide enhancements, symbolic arithmetic operations, and miscellaneous functionality. - properties('S', [symbolic_arithmetic, 'Deterministic']). % Represents the successor function in Peano arithmetic. - properties('Z', [symbolic_arithmetic, 'Deterministic']). % Represents zero in Peano arithmetic. - properties('quote', [data_manipulation, 'Nondeterministic']). % Treats the given input as a literal, preventing its evaluation. - properties('coerce', [type_conversion, 'Deterministic']). % Forces the arguments to match expected types, ensuring compatibility. - - - -:- all_source_file_predicates_are_transparent. - -:- fixup_exports. - diff --git a/.Attic/metta_lang/metta_ontology_level_2.pfc.pl b/.Attic/metta_lang/metta_ontology_level_2.pfc.pl deleted file mode 100755 index 4069d286fb3..00000000000 --- a/.Attic/metta_lang/metta_ontology_level_2.pfc.pl +++ /dev/null @@ -1,251 +0,0 @@ -% Predicate and Function Arity Definitions: -% Specifies the number of arguments (arity) for predicates and functions, which is fundamental -% for understanding the complexity and capabilities of various logical constructs. Predicates are defined -% from Nullary (no arguments) up to Denary (ten arguments), reflecting a range of logical conditions or assertions. -% Functions are similarly defined but focus on operations that return a value, extending up to Nonary (nine arguments). -p_arity('NullaryPredicate', 0). % No arguments. -p_arity('UnaryPredicate', 1). % One argument. -p_arity('BinaryPredicate', 2). % Two arguments. -p_arity('TernaryPredicate', 3). % Three arguments, and so on. -p_arity('QuaternaryPredicate', 4). -p_arity('QuinaryPredicate', 5). -p_arity('SenaryPredicate', 6). -p_arity('SeptenaryPredicate', 7). -p_arity('OctaryPredicate', 8). -p_arity('NonaryPredicate', 9). -p_arity('DenaryPredicate', 10). - -f_arity('NullaryFunction', 0). % No return value, essentially a procedure. -f_arity('UnaryFunction', 1). % Returns a single value, and so on. -f_arity('BinaryFunction', 2). -f_arity('TernaryFunction', 3). -f_arity('QuaternaryFunction', 4). -f_arity('QuinaryFunction', 5). -f_arity('SenaryFunction', 6). -f_arity('SeptenaryFunction', 7). -f_arity('OctaryFunction', 8). -f_arity('NonaryFunction', 9). - -% Enforcing Equivalency Between Predicates and Functions: -% Establishes a logical framework to equate the conceptual roles of predicates and functions based on arity. -% This equivalence bridges the functional programming and logical (declarative) paradigms within Prolog, -% allowing a unified approach to defining operations and assertions. -(equivalentTypes(PredType,FunctType) ==> - (in(FunctorObject,PredType) - <==> - in(FunctorObject,FunctType))). -% Automatically generating equivalency rules based on the arity of predicates and functions. -% This facilitates a dynamic and flexible understanding of function and predicate equivalences, -% enhancing Prolog's expressive power and semantic richness. -((p_arity(PredType,PA), plus(FA,1,PA), f_arity(FunctType,FA))) - ==> equivalentTypes(PredType,FunctType)). - -% Flow Control Structures: -% Control structures are essential for directing the execution flow of a program. They enable conditional execution, -% looping, and choice between different paths of execution based on logical conditions or external inputs. -property('if', flow_control). % Conditional execution based on a boolean expression. -property('case', flow_control). % Choice between multiple paths. -property('let', flow_control). % Variable binding in a local scope. -property('let*', flow_control). % Sequential variable binding with dependency. -property('do', flow_control). % Executes a block of code. -property('limit', flow_control_modification). % Limits the number of solutions. -property('offset', flow_control_modification). % Skips a number of solutions. -property('max-time', execution_time_control). % Limits execution time. -% Inferring backtracking behavior in flow control structures. This indicates that certain paths -% of execution might lead to backtracking, a core concept in Prolog for exploring alternative solutions. -property(P, flow_control) ==> property(P, 'OnFailBacktrack'). - -% Assertions and Testing Mechanisms: -% Assertions provide a powerful tool for validating expected conditions or outcomes within a program. -% They are critical for debugging and verifying the correctness of logic under various conditions. -property('assertTrue', assertions_testing). % Asserts a condition is true. -property('assertFalse', assertions_testing). % Asserts a condition is false. -property('assertEqual', assertions_testing). % Asserts equality between two values. -property('assertNotEqual', assertions_testing). % Asserts inequality. -property('assertEqualToResult', assertions_testing). % Asserts a value equals an expected result. -% Asserting deterministic outcomes for testing mechanisms. These properties ensure that assertions -% yield predictable, binary outcomes (pass or fail) based on the conditions they test. -property(P, assertions_testing) ==> property(P, 'Deterministic'). - -% Special Operators and System Interaction: -% Special operators and functionalities enhance Prolog's interaction with its execution environment and system, -% enabling dynamic control flows, system-level operations, and interaction with external processes or data. -property('!', special_operators). % Cut operator, controls backtracking. -property('call!', special_operators). % Dynamically calls a predicate. -property('call-fn!', special_operators). % Calls a function dynamically. -property('repl!', system_interaction). % Interactive read-eval-print loop. -property('pyr!', special_operators). % Example of an extension or plugin call. -property('call-cleanup!', resource_management). % Ensures cleanup after execution. -property('setup-call-cleanup!', resource_management). % Setup, call, and cleanup pattern. -property('with-output-to!', output_redirection). % Redirects output to a different stream. -% Deterministic behavior is noted for operations that have predictable outcomes, -% while nondeterministic behavior is acknowledged for operations whose results may vary. -property('call!', 'Deterministic'). -property('call-fn!', 'Nondeterministic'). -property('!', 'Deterministic'). - -% Data Structures and Manipulation: -% The definition, organization, and manipulation of data structures are foundational aspects of programming. -% These operations facilitate the storage, retrieval, and modification of data in structured forms. -property('Cons', data_structures). % Constructs a pair or list. -property('collapse', data_manipulation). % Flattens nested structures. -property('superpose', data_manipulation). % Overlays data structures. -property('sequential', data_manipulation). % Ensures sequential execution. -property('TupleConcat', data_structures). % Concatenates tuples. -% Operations on data structures are generally deterministic, yielding predictable outcomes based on the inputs and operations. -property(P, data_manipulation) ==> property(P, 'Deterministic'). - -% Logic and Comparison: -% Logical and comparison operations are fundamental in programming, enabling decision making -% and data comparison. This includes basic logical operations and comparisons between values. -property('and', logic_comparison). -property('or', logic_comparison). -property('not', logic_comparison). -% Logical operations result in deterministic outcomes, directly derived from their input values. -property(P, logic_comparison) ==> property(P, 'Deterministic'). - -% Additional and Miscellaneous: -% This section covers a variety of functionalities not classified under the previous categories. -% It includes system interaction, functional programming utilities, arithmetic operations, -% and more, providing a wide range of capabilities. -property('atom-replace', data_manipulation). -property('fb-member', list_operations). -property('nop', control_structure). -property('empty', data_validation). -property('function', functional_programming). -property('return', functional_programming). -property('number-of', quantitative_analysis). -property('new-space', system_interaction). -property('bind!', system_interaction). -property('pragma!', system_interaction). -property('transfer!', system_interaction). -property('registered-python-function', interlanguage_integration). -property('S', symbolic_arithmetic). -property('Z', symbolic_arithmetic). -property('bc-base', recursion_control). -property('bc-base-ground', recursion_control). -property('bc-rec', recursion_control). - -% Rules for Automatic Property Inference: -% These rules allow for automatic inference of certain properties based on categories, -% simplifying the property assignment process and ensuring consistency. -property('function', 'VariableArity'). -property('return', 'Deterministic'). -property(P, system_interaction) ==> property(P, 'Deterministic'). -property('fb-member', 'Nondeterministic'). -property(P, symbolic_arithmetic) ==> property(P, 'Deterministic'). -property(P, recursion_control) ==> property(P, 'Deterministic'). -property('bc-rec', 'Nondeterministic'). - - -% Evaluation and Execution: -% Evaluation and execution properties pertain to how expressions, commands, or functions are processed and run. -% This includes interpreting code, printing output, and compiling expressions. -% 'eval' allows for the execution of dynamically constructed code, which could lead to nondeterministic outcomes -% depending on the runtime environment and input data. -property('eval', 'Nondeterministic'). -property('eval-for', evaluation_execution). -property('echo', evaluation_execution). -property('print', evaluation_execution). -property('println!', evaluation_execution). -property('compile-easy!', evaluation_execution). -property('time!', evaluation_execution). -% The 'eval' operation could lead to different outcomes based on the input, thus considered nondeterministic. -property('eval', 'Nondeterministic'). -% Conversely, 'echo' simply reflects its input without alteration, making it deterministic. -property('echo', 'Deterministic'). - -% Enhanced System Interaction and Dynamic Execution: -% Dynamic execution features and enhanced system interaction capabilities extend Prolog's utility, -% enabling runtime evaluation of code and interaction with the system or external environments. -% 'call-string!' executes Prolog code provided as a string, potentially introducing nondeterminism -% based on the dynamic nature of the executed code and external state. -property('call-string!', external_integration). -% 'call-string!' allows for dynamic execution of Prolog code provided as a string, -% which might be nondeterministic depending on the runtime environment and the code being executed. -property('call-string!', 'Nondeterministic'). -% Registering and invoking Python functions from Prolog illustrates interlanguage integration, -% enabling deterministic interoperability with Python codebases. -property('registered-python-function', 'Deterministic'). -% Error Handling and Advanced Control Flow Mechanisms: -% Proper error handling is crucial for robust programs, allowing for graceful recovery -% from unexpected states or inputs. Advanced control flow mechanisms provide more complex -% patterns of execution beyond simple conditional checks and loops. -property('catch', error_handling_advanced). -property('throw', error_handling_advanced). -% Error handling operations like 'catch' and 'throw' can influence the control flow based on runtime conditions, -% potentially introducing nondeterminism if the error states or exceptions are not predictable. -property('catch', 'Nondeterministic'). -property('throw', 'Nondeterministic'). - -% Arithmetic and Logical Operations: -% Arithmetic operations form the basis of mathematical computations in programming, -% including basic operations like addition, subtraction, multiplication, and division. -property('+', arithmetic_operations). -property('-', arithmetic_operations). -property('*', arithmetic_operations). -property('mod', arithmetic_operations). -% These operations are deterministic, yielding specific results from given numeric inputs. -property(P, arithmetic_operations) ==> property(P, 'Deterministic'). - -% List Operations and Data Validation: -% Operations on lists and validation of data are fundamental in many programming tasks, -% allowing for the manipulation, examination, and assurance of data integrity. -property('fb-member', list_operations). -% 'fb-member' checks for membership in a list, which could have nondeterministic outcomes based on list contents. -property('fb-member', 'Nondeterministic'). -property('nop', control_structure). -% 'nop' represents a no-operation, effectively serving as a placeholder or for timing. -property('nop', 'Deterministic'). -property('empty', data_validation). -% 'empty' checks for or represents an empty structure or condition, a deterministic operation. -property('empty', 'Deterministic'). - -% Advanced List Operations and Utilities: -% Advanced operations on lists and utility functions provide powerful mechanisms for data manipulation and analysis, -% extending the core capabilities for handling lists and collections. -property('dedup!', list_utilities). -% 'dedup!' removes duplicate elements from a list, providing a deterministic way to ensure unique elements. -property('dedup!', 'Deterministic'). - -% Arithmetic and Logic Enhancements: -% Enhancements to arithmetic and logic functionalities support more complex mathematical operations and logical reasoning, -% broadening the scope of computational tasks that can be addressed. -property('hyperpose', arithmetic_enhancements). -% 'hyperpose' could be involved in advanced arithmetic or matrix operations, assumed to be deterministic -% for well-defined mathematical transformations. -property('hyperpose', 'Deterministic'). - -% Functional Programming Enhancements: -% Enhancements and utilities for functional programming emphasize the use of functions as first-class citizens, -% promoting immutability, statelessness, and higher-order functions for more declarative programming approaches. -property('maplist!', functional_enhancements). -% 'maplist!' applies a function to each element of a list in a deterministic manner, preserving list structure. -property('maplist!', 'Deterministic'). -property('concurrent-maplist!', functional_programming). -% 'concurrent-maplist!' might introduce nondeterminism due to concurrent execution. -property('concurrent-maplist!', 'Nondeterministic'). - - -% Interactivity and Debugging Tools: -% Tools and functionalities that facilitate interactivity with the user or debugging capabilities -% enhance the development experience by providing insights into program execution and allowing for real-time interaction. -property('trace!', debugging_tools). -property('notrace!', debugging_tools). -property('rtrace!', debugging_tools). -% Debugging commands like 'trace!', 'notrace!', and 'rtrace!' offer deterministic control over tracing and debugging states, -% allowing developers to enable or disable debugging modes as needed. -property(P, debugging_tools) ==> property(P, 'Deterministic'). - -% Quantitative Analysis and Symbolic Representation: -% Quantitative analysis involves operations that measure or quantify aspects of data, -% while symbolic representation deals with abstract symbols rather than explicit values. -property('number-of', quantitative_analysis). -% 'number-of' provides a count or measure, yielding deterministic results. -property('number-of', 'Deterministic'). -property('S', symbolic_arithmetic). -property('Z', symbolic_arithmetic). -% 'S' (successor) and 'Z' (zero) are used in Peano arithmetic, representing numbers symbolically. -property('S', 'Deterministic'). -property('Z', 'Deterministic'). - diff --git a/.Attic/metta_lang/metta_reader.new b/.Attic/metta_lang/metta_reader.new deleted file mode 100755 index a232a417a83..00000000000 --- a/.Attic/metta_lang/metta_reader.new +++ /dev/null @@ -1,1618 +0,0 @@ -/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Parsing -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ -%:- encoding(iso_latin_1). -:- if(flush_output). :- endif. -:- if(setenv('RUST_BACKTRACE',full)). :- endif. -%:- if(\+ current_module(sxpr_reader)). -:- if( (false, \+ current_prolog_flag(wamcl_modules,false))). -:- module(s3xpr,[ - parse_sexpr/2, - codelist_to_forms/2, - svar_fixvarname/2, - parse_sexpr_untyped/2, - with_kifvars/1, - current_input_to_forms/2, - input_to_forms/2, - input_to_forms/3, - input_to_forms_debug/1, - input_to_forms_debug/2, - sexpr_sterm_to_pterm_list/3, - sexpr//1, - fixvars/4, - txt_to_codes/2, - quietly_sreader/1, - file_sexpr_with_comments//1, - with_lisp_translation/2, - to_untyped/2, - ok_var_name/1, - with_all_rest_info/1, - svar_fixvarname/2, - sexpr_sterm_to_pterm/2, - lisp_read/2, - phrase_from_stream_nd/2, - write_trans/4, - parse_sexpr/2]). -:- endif. - -:- ensure_loaded(swi_support). -:- ensure_loaded(metta_utils). -:- ensure_loaded(metta_testing). -:- set_prolog_flag(encoding,iso_latin_1). -is_wam_cl:- fail. - -:- use_module(library(backcomp)). -:- use_module(library(rbtrees)). - - -:- use_module(library(logicmoo/dcg_must)). -:- use_module(library(logicmoo/dcg_meta)). - - -%:- meta_predicate always_b(//,?,?). -%:- meta_predicate bx(0). -:- meta_predicate call_proc(1,?). -:- meta_predicate dcg_and2(//,//,?,?). -:- meta_predicate dcg_each_call_cleanup(0,//,0,?,?). -:- meta_predicate dcg_not(//,?,?). -:- meta_predicate dcg_phrase(//,?,?). -:- meta_predicate dcg_xor(//,//,?,?). -%:- meta_predicate expr_with_text(*,2,*,*,*). - -:- meta_predicate remove_optional_char(//,?,?). - -:- meta_predicate sexpr_vector0(*,//,?,?). -:- meta_predicate with_all_rest_info(1). -:- meta_predicate with_lisp_translation_stream(*,1). -:- meta_predicate write_trans(+,*,2,?). - -%:- assert((s3xpr:'$exported_op'(_,_,_):- fail)). -%:- assert((xlisting:'$exported_op'(_,_,_):- fail)). -:- assert((user:'$exported_op'(_,_,_):- fail)). -:- abolish((system:'$exported_op'/3)). -:- assert((system:'$exported_op'(_,_,_):- fail)). - -def_is_characterp(CH):- current_predicate(is_characterp/1),!,call(call,is_characterp,CH). -def_is_characterp_def('#\\'(_)). - -def_to_prolog_string(I,O):- current_predicate(to_prolog_string/2),!,call(call,to_prolog_string,I,O). -def_to_prolog_string(I,O):- any_to_string(I,O). - - -def_compile_all(I,O):- current_predicate(compile_all/2),!,call(call,compile_all,I,O). -def_compile_all(I,O):- wdmsg(undefined_compile_all(I)),I=O. - - -zalwayzz(G):- call(G)*->true;throw(fail_zalwayzz(G)). -zalwayzz(G,I,O):- phrase(G,I,O)*->true;ignore(((ignore((append(I,[],Txt),name(Str,Txt))),throw(fail_zalwayzz(Str,G))))). - - -% DCG rules for S-expressions metta_with metta_whitespace and comments -s_expr_metta(List) --> metta_wspace,!, s_expr_metta(List). -s_expr_metta(List) --> `(`, !, items_metta(List, `)`). -s_expr_metta(['[...]',List]) --> `[`, !, items_metta(List, `]`). -s_expr_metta(['{...}',List]) --> `{`, !, items_metta(List, `}`). - - -items_metta([], Until) --> Until,!. -items_metta([Item|Rest], Until) --> s_item_metta(Item, dcg_peek(Until)), !, items_metta(Rest, Until). - -%s_line_metta(end_of_file) --> file_eof,!. -s_line_metta(Expr) --> metta_wspace, !, s_line_metta(Expr). -s_line_metta(exec(Expr)) --> `!`, !, s_item_metta(Expr, e_o_s). -s_line_metta(Expr) --> s_item_metta(Expr, e_o_s). - -%s_item_metta(end_of_file, _) --> file_eof,!. -s_item_metta(Expr, Until) --> metta_wspace, !, s_item_metta(Expr, Until). -%s_item_metta('Expr', Until) --> Until,!. -s_item_metta(List,_Until) --> s_expr_metta(List),!. -s_item_metta(String,_Until) --> string_metta(String),!. -s_item_metta(Symbol, Until) --> symbol_metta(Symbol, Until). - -:- encoding(iso_latin_1). -%string_metta(S) --> `"`, !, string_until_metta(S, `"`), {atomics_to_string_metta(A,S)}. -%string_metta(Text) --> `"`, !, zalmetta_wayzz_metta(string_until_metta(Text,`"`)),!. -%string_metta(Text) --> `“`, !, zalmetta_wayzz_metta(string_until_metta(Text,(`”`;`“`))),!. -string_metta(Text) --> (`"`), string_until_metta(L,(`"`)), {atomics_to_string(L,Text)}, !. -string_metta(Text) --> (`”`;`“`;`"`), !, string_until_metta(L,(`“`;`”`;`"`)), {atomics_to_string(L,Text)}. -:- encoding(utf8). -%string_metta(Text) --> `#|`, !, zalmetta_wayzz_metta(string_until_metta(Text,`|#`)),!. - -% string_until_metta([], _) --> e_o_s, !. -%string_until_metta([], _) --> file_eof,!. -string_until_metta([], Until) --> Until, !. -string_until_metta([C|Cs], Until) --> escape_sequence_metta(C), !, string_until_metta(Cs, Until). -string_until_metta([C|Cs], Until) --> [R], { name(C, [R]) }, string_until_metta(Cs, Until). - -escape_sequence_metta(Char) --> `\\`,[Esc], { escape_char_metta([Esc], Char) }. -escape_char_metta(`"`, "\""). -escape_char_metta(`\\`, "\\"). -escape_char_metta(`n`, "\n"). -escape_char_metta(`r`, "\r"). -escape_char_metta(`t`,"\t"). -escape_char_metta(C,S):- sformat(S,'~s',[[C]]). - -symbol_metta(S, Until) --> metta_wspace,!,symbol_metta(S, Until). -symbol_metta(S, Until) --> string_until_metta(SChars,(dcg_peek(metta_white); Until)), { atomic_list_concat(SChars, S) }. - -%comment --> `;`,!,comment_chars_metta(S). -comment_chars_metta(S) --> string_until_metta(SChars,`\n`), { atomic_list_concat(SChars, S) }. - -%e_o_s --> file_eof,!. -e_o_s --> \+ [_|_]. - -%metta_ws --> e_o_s,!. -metta_ws --> metta_wspace, !, metta_ws. -metta_ws --> []. -metta_wspace --> `;`,!, comment_chars_metta(S), {assert(comment_metta(S))}. -metta_wspace --> metta_white. -metta_white --> [W], { char_type(W, white) }, !. - - - -%:- meta_predicate(always(0)). -%always(G):- must(G). - -:- use_module(library(logicmoo/filestreams)). -%:- use_module(library(bugger)). - -:- if(exists_file('./header')). -% :- include('./header'). -:- endif. -%:- use_module(eightball). - -:- thread_local(t_l:sreader_options/2). -kif_ok:- t_l:sreader_options(logicmoo_read_kif,TF),!,TF==true. - -with_kif_ok(G):- - locally(t_l:sreader_options(logicmoo_read_kif,true),G). - -with_kif_not_ok(G):- - locally(t_l:sreader_options(logicmoo_read_kif,false),G). - - -:- meta_predicate((with_lisp_translation(+,1),input_to_forms_debug(+,:))). -:- meta_predicate sexpr_vector(*,//, - ?,?). - - -:- dynamic user:file_search_path/2. -:- multifile user:file_search_path/2. - -:- thread_local(t_l:s_reader_info/1). - -:- meta_predicate(quietly_sreader(0)). -%quietly_sreader(G):- quietly(G). -quietly_sreader(G):- !, call(G). - -%% with_lisp_translation( +FileOrStream, :Pred1) is det. -% -% With File or Stream read all S-expressions submitting each to Pred1 -% -with_lisp_translation(In,Pred1):- - is_stream(In),!,with_lisp_translation_stream(In,Pred1). -with_lisp_translation(Other,Pred1):- - setup_call_cleanup(l_open_input(Other,In), - with_lisp_translation_stream(In,Pred1), - ignore(notrace_catch_fail(close(In)))),!. - -with_lisp_translation_stream(In,Pred1):- - repeat, - once((lisp_read(In,O))), - (O== end_of_file - -> (with_all_rest_info(Pred1),!) ; - (((once((zalwayzz(call_proc(Pred1,O))))),fail))). - -call_proc(Pred1,O):- call(Pred1,O),!,with_all_rest_info(Pred1),!. - -with_all_rest_info(Pred1):- - forall(clause(t_l:s_reader_info(O2),_,Ref), - (zalwayzz(once(call(Pred1,O2))),erase(Ref))),!. - -parse_sexpr_untyped(I,O):- quietly_sreader((parse_sexpr(I,M))), - quietly_sreader((to_untyped(M,O))). - -read_pending_whitespace(In):- repeat, peek_char(In,Code), - (( \+ char_type(Code,space), \+ char_type(Code,white))-> ! ; (get_char(In,_),fail)). - - -make_tmpfile_name(Name,Temp):- - atomic_list_concat(List1,'/',Name),atomic_list_concat(List1,'_',Temp1), - atomic_list_concat(List2,'.',Temp1),atomic_list_concat(List2,'_',Temp2), - atomic_list_concat(List3,'\\',Temp2),atomic_list_concat(List3,'_',Temp3), - atom_concat_or_rtrace(Temp3,'.tmp',Temp),!. - - - - -:- meta_predicate(with_lisp_translation_cached(:,2,1)). -:- meta_predicate(maybe_cache_lisp_translation(+,+,2)). - -with_lisp_translation_cached(M:LFile,WithPart2,WithPart1):- - absolute_file_name(LFile,File), - make_tmpfile_name(LFile,Temp), - maybe_cache_lisp_translation(File,Temp,WithPart2),!, - finish_lisp_translation_cached(M,File,Temp,WithPart1). - -finish_lisp_translation_cached(M,File,Temp,WithPart1):- - multifile(M:lisp_trans/2), - dynamic(M:lisp_trans/2), - file_base_name(File,BaseName), - M:load_files([Temp],[qcompile(auto)]), - forall(M:lisp_trans(Part2,BaseName:Line), - once((b_setval('$lisp_translation_line',Line), - zalwayzz(M:call(WithPart1,Part2))))). - -maybe_cache_lisp_translation(File,Temp,_):- \+ file_needs_rebuilt(Temp,File),!. -maybe_cache_lisp_translation(File,Temp,WithPart2):- - file_base_name(File,BaseName), - setup_call_cleanup(open(Temp,write,Outs,[encoding(utf8)]), - must_det((format(Outs,'~N~q.~n',[:- multifile(lisp_trans/2)]), - format(Outs,'~N~q.~n',[:- dynamic(lisp_trans/2)]), - format(Outs,'~N~q.~n',[:- style_check(-singleton)]), - format(Outs,'~N~q.~n',[lisp_trans(translated(File,Temp,BaseName),BaseName:( -1))]), - with_lisp_translation(File,write_trans(Outs,BaseName,WithPart2)), - format(Outs,'~N~q.~n',[end_of_file]))), - ((ignore(notrace_catch_fail(flush_output(Outs),_,true)),ignore(notrace_catch_fail(close(Outs),_,true))))),!. - - -write_trans(Outs,File,WithPart2,Lisp):- - zalwayzz((call(WithPart2,Lisp,Part), - nb_current('$lisp_translation_line',Line), - format(Outs,'~N~q.~n',[lisp_trans(Part,File:Line)]))),!. - -/* alternate method*/ -phrase_from_stream_partial(Grammar, In):- - phrase_from_stream((Grammar,!,lazy_forgotten(In)), In). - -lazy_forgotten(In,UnUsed,UnUsed):- - (is_list(UnUsed)-> true ; append(UnUsed,[],UnUsed)), - length(UnUsed,PlzUnread), - seek(In, -PlzUnread, current, _). - - -% :- use_module(library(yall)). -% :- rtrace. -% tstl(I):- with_lisp_translation(I,([O]>>(writeq(O),nl))). -tstl(I):- with_kifvars(with_lisp_translation(I,writeqnl)). - -with_kifvars(Goal):- - locally(t_l:sreader_options(logicmoo_read_kif,true),Goal). - - - -%:- thread_local(t_l:fake_buffer_codes/2). - - -%% parse_sexpr( :TermS, -Expr) is det. -% -% Parse S-expression. -% - -parse_sexpr(S, Expr) :- quietly_sreader(parse_meta_term( - file_sexpr_with_comments, S, Expr)). - -%% parse_sexpr_ascii( +Codes, -Expr) is det. -% -% Parse S-expression Codes. -% -parse_sexpr_ascii(S, Expr) :- quietly_sreader(parse_meta_ascii(file_sexpr_with_comments, S,Expr)),!. - - -parse_sexpr_ascii_as_list(Text, Expr) :- txt_to_codes(Text,DCodes), - clean_fromt_ws(DCodes,Codes),!,append([`(`,Codes,`)`],NCodes),!, - phrase(sexpr_rest(Expr), NCodes, []). - - -%% parse_sexpr_string( +Codes, -Expr) is det. -% -% Parse S-expression That maybe sees string from Codes. -% -parse_sexpr_string(S,Expr):- - locally_setval('$maybe_string',t,parse_sexpr(string(S), Expr)),!. - -%% parse_sexpr_stream( +Stream, -Expr) is det. -% -% Parse S-expression from a Stream -% -parse_sexpr_stream(S,Expr):- quietly_sreader(parse_meta_stream(file_sexpr_with_comments,S,Expr)),!. - -:- export('//'(file_sexpr,1)). -:- export('//'(sexpr,1)). - -% for offline use of this lisp reader -intern_and_eval(UTC,V):- current_predicate(lisp_compiled_eval/2),!, - call(call,(reader_intern_symbols(UTC,M),!,lisp_compiled_eval(M,V))). -intern_and_eval(UTC,'$intern_and_eval'(UTC)). - -% Use DCG for parser. - -%file_sexpr_with_comments(O) --> [], {clause(t_l:s_reader_info(O),_,Ref),erase(Ref)},!. - - -file_sexpr_with_comments(end_of_file) --> file_eof,!. -file_sexpr_with_comments(O) --> one_blank,!,file_sexpr_with_comments(O),!. % WANT? -file_sexpr_with_comments(end_of_file) --> `:EOF`,!. -file_sexpr_with_comments(C) --> dcg_peek(`#|`),!,zalwayzz(comment_expr(C)),swhite,!. -file_sexpr_with_comments(C) --> dcg_peek(`;`),!, zalwayzz(comment_expr(C)),swhite,!. - - -file_sexpr_with_comments(Out) --> {kif_ok}, prolog_expr_next, prolog_readable_term(Out), !. -file_sexpr_with_comments(Out,S,E):- \+ t_l:sreader_options(with_text,true),!,phrase(file_sexpr(Out),S,E),!. -file_sexpr_with_comments(Out,S,E):- expr_with_text(Out,file_sexpr(O),O,S,E),!. - -prolog_expr_next--> dcg_peek(`:-`). -prolog_expr_next--> dcg_peek(read_string_until(S,(eol;`.`))),{atom_contains(S,':-')}. -prolog_expr_next--> dcg_peek(`.{`). - -prolog_readable_term(Expr) --> `.`,prolog_readable_term(Read), {arg(1,Read,Expr),!}. -prolog_readable_term(Expr,S,E):- - notrace(catch((read_term_from_codes(S,Expr,[subterm_positions(FromTo),cycles(true), module( baseKB), - double_quotes(string), - comments(CMT), variable_names(Vars)]),implode_threse_vars(Vars), - arg(2,FromTo,To), length(TermCodes,To), - append(TermCodes,Remaining,S), - `.`=[Dot],(Remaining=[Dot|E]/*;Remaining=E*/),!, - must(record_plterm_comments(CMT))),_,fail)). -record_plterm_comments(L):- is_list(L),!,maplist(record_plterm_comments,L). -record_plterm_comments(_-CMT):- assert(t_l:s_reader_info(CMT)). - - -% in Cyc there was a fitness heuristic that every time an logical axiom had a generated a unique consequent it was considered to have utility as it would expand the breadth of a search .. the problem often was those consequents would feed a another axiom's antecedant where that -:- asserta((system:'$and'(X,Y):- (X,Y))). - -%expr_with_text(Out,DCG,O,S,E):- -% call(DCG,S,E) -> append(S,Some,E) -> get_sexpr_with_comments(O,Some,Out,S,E),!. - -get_sexpr_with_comments(O,_,O,_,_):- compound(O),functor(O,'$COMMENT',_),!. -get_sexpr_with_comments(O,Txt,with_text(O,Str),S,_E):-append(Txt,_,S),!,text_to_string(Txt,Str). -%file_sexpr_with_comments(O,with_text(O,Txt),S,E):- copy_until_tail(S,Copy),text_to_string_safe(Copy,Txt),!. - - -file_sexpr(end_of_file) --> file_eof,!. -% WANT? -file_sexpr(O) --> sblank,!,file_sexpr(O),!. -% file_sexpr(planStepLPG(Name,Expr,Value)) --> swhite,sym_or_num(Name),`:`,swhite, sexpr(Expr),swhite, `[`,sym_or_num(Value),`]`,swhite. % 0.0003: (PICK-UP ANDY IBM-R30 CS-LOUNGE) [0.1000] -% file_sexpr(Term,Left,Right):- eoln(EOL),append(LLeft,[46,EOL|Right],Left),read_term_from_codes(LLeft,Term,[double_quotes(string)]),!. -% file_sexpr(Term,Left,Right):- append(LLeft,[46|Right],Left), ( \+ member(46,Right)),read_term_from_codes(LLeft,Term,[double_quotes(string)]),!. - -%file_sexpr(C) --> !, s_line_metta(C), !. -file_sexpr(Expr) --> sexpr(Expr),!. -% file_sexpr(Expr,H,T):- lisp_dump_break,rtrace(phrase(file_sexpr(Expr), H,T)). -/* -file_sexpr(Expr) --> {fail}, - sexpr_lazy_list_character_count(Location,Stream), - {break, - seek(Stream,Location,bof,_), - read_clause(Stream,Expr,[cycles(true),double_quotes(string),variable_names(Vars)]), - implode_threse_vars(Vars)},!. - -file_sexpr(Expr) --> sexpr(Expr),!. - -file_sexpr(end_of_file) --> []. -*/ -% file_sexpr('$ERROR'(S_EOF)) --> read_until_eof_e(Unitl_EOF),!,{sformat(S_EOF,'~s',[Unitl_EOF])}. -% read_until_eof_e(Unitl_EOF,S,E):- append(S,E,Unitl_EOF),break,is_list(Unitl_EOF),!. - -%read_dispatch(E,[Disp,Char|In],Out):- read_dispatch_char([Disp,Char],E,In,Out). -read_dispatch(E,[DispatCH|In],Out):- read_dispatch_char([DispatCH],E,In,Out). - -read_dispatch_char(DispatCH,Form,In,Out):- sread_dyn:plugin_read_dispatch_char(DispatCH,Form,In,Out),!. -% read_dispatch_char(`@`,Form,In,Out):- phrase(sexpr(Form), In, Out),!. - -read_dispatch_error(Form,In,Out):- trace, dumpST,trace_or_throw((read_dispatch_error(Form,In,Out))). - - - - -:- multifile(sread_dyn:plugin_read_dispatch_char/4). -:- dynamic(sread_dyn:plugin_read_dispatch_char/4). - -:- use_module(library(dcg/basics)). - -% #x Hex -sread_dyn:plugin_read_dispatch_char([DispatCH],Form,In,Out):- - member(DispatCH,`Xx`),(phrase((`-`,dcg_basics:xinteger(FormP)), In, Out)),!,Form is -FormP. - -sread_dyn:plugin_read_dispatch_char([DispatCH],Form,In,Out):- - member(DispatCH,`Xx`),!,zalwayzz(phrase(dcg_basics:xinteger(Form), In, Out)),!. - -% #B Binary -sread_dyn:plugin_read_dispatch_char([DispatCH],Form,In,Out):- - member(DispatCH,`Bb`),!,phrase(signed_radix_2(2,Form), In, Out),!. - -% #O Octal -sread_dyn:plugin_read_dispatch_char([DispatCH],Form,In,Out):- - member(DispatCH,`Oo`),!,phrase(signed_radix_2(8,Form), In, Out),!. - -signed_radix_2(W,V)--> signed_radix_2_noext(W,Number),extend_radix(W,Number,V). - -signed_radix_2_noext(W,Number) --> `-`,!,unsigned_radix_2(W,NumberP),{Number is - NumberP },!. -signed_radix_2_noext(W,Number) --> `+`,!,unsigned_radix_2(W,Number). -signed_radix_2_noext(W,Number) --> unsigned_radix_2(W,Number). - -unsigned_radix_2(W,Number) --> radix_digits(W,Xs),!,{mkvar_w(Xs,W,Number)},!. - - -radix(Radix)-->`#`,integer(Radix),ci(`r`). -radix(16)-->`#`,ci(`X`). -radix(8)-->`#`,ci(`O`). -radix(2)-->`#`,ci(`B`). - -signed_radix_number(V)--> radix(Radix),!,signed_radix_2(Radix,V). -unsigned_radix_number(V)--> radix(Radix),!,unsigned_radix_2(Radix,V). - -extend_radix(Radix,Number0,'$RATIO'(Number0,Number1)) --> `/`,unsigned_radix_2(Radix,Number1). -%extend_radix(Radix,Number0,'/'(NumberB,Number1)) --> `.`,radix_number(Radix,Number1),{NumberB is (Number0*Number1)+1},!. -%extend_radix(Radix,Number0,'/'(NumberB,NumberR)) --> `.`,radix_number(Radix,Number1),{NumberR is Number1 * Radix, NumberB is (Number0*Number1)+1},!. -extend_radix(_Radix,Number,Number) --> []. - -radix_digits(OF,[X|Xs]) --> xdigit(X),{X alpha_to_lower(C),{X is C - 87,X []. - - - -mkvar_w([W0|Weights], Base, Val) :- - mkvar_w(Weights, Base, W0, Val). - -mkvar_w([], _, W, W). -mkvar_w([H|T], Base, W0, W) :- - W1 is W0*Base+(H), - mkvar_w(T, Base, W1, W). - - -ci([])--> !, []. -ci([U|Xs]) --> {to_lower(U,X)},!,alpha_to_lower(X),ci(Xs). - - -remove_optional_char(S)--> S,!. -remove_optional_char(_)-->[]. - -implode_threse_vars([N='$VAR'(N)|Vars]):-!, implode_threse_vars(Vars). -implode_threse_vars([]). - -ugly_sexpr_cont('$OBJ'([S|V])) --> rsymbol_maybe(``,S), sexpr_vector(V,`>`),swhite,!. -ugly_sexpr_cont('$OBJ'(V)) --> sexpr_vector(V,`>`),swhite,!. -ugly_sexpr_cont('$OBJ'(V)) --> sexpr_vector(V,`>`),swhite,!. -ugly_sexpr_cont('$OBJ'(V)) --> read_string_until_pairs(VS,`>`), swhite,{parse_sexpr_ascii_as_list(VS,V)},!. -ugly_sexpr_cont('$OBJ'(sugly,S)) --> read_string_until(S,`>`), swhite,!. - -%% sexpr(L)// is det. -% - -%sexpr(L) --> sblank,!,sexpr(L),!. -%sexpr(_) --> `)`,!,{trace,break,throw_reader_error(": an object cannot start with #\\)")}. -sexpr(X,H,T):- zalwayzz(sexpr0(X),H,M),zalwayzz(swhite,M,T), nop(if_debugging(sreader,(wdmsg(sexpr(X))))),!. -%sexpr(X,H,T):- zalwayzz(sexpr0(X,H,T)),!,swhite. -is_common_lisp:- fail. - -sexpr0(L) --> sblank,!,sexpr(L),!. -sexpr0(L) --> `(`, !, swhite, zalwayzz(sexpr_list(L)),!, swhite. -sexpr0((Expr)) --> `.{`, read_string_until(S,`}.`), swhite, - {prolog_readable_term(Expr,S,_)}. - - -sexpr0(['#'(quote),E]) --> `'`, !, sexpr(E). -sexpr0(['#'(hbackquote),E]) --> {is_scm}, `#```, !, sexpr(E). -sexpr0(['#'(backquote),E]) --> ````, !, sexpr(E). -sexpr0(['#BQ-COMMA-ELIPSE',E]) --> `,@`, !, sexpr(E). -sexpr0(['#COMMA',E]) --> { is_common_lisp }, `,`, !, sexpr(E). -sexpr0(['#HCOMMA',E]) --> {is_scm}, `#,`, !, sexpr(E). -sexpr0('$OBJ'(claz_bracket_vector,V)) --> `[`, sexpr_vector(V,`]`),!, swhite. - -% MeTTA/NARS % sexpr0('#'(A)) --> `|`, !, read_string_until(S,`|`), swhite,{quietly_sreader(((atom_string(A,S))))}. - -% maybe this is KIF -sexpr0('?'(E)) --> {kif_ok}, `?`, dcg_peek(([C],{sym_char(C)})),!, rsymbol(``,E), swhite. -% @TODO if KIF sexpr('#'(E)) --> `&%`, !, rsymbol(`#$`,E), swhite. - -sexpr0('$STRING'(S)) --> s_string(S),!. - -/******** BEGIN HASH ************/ - -sexpr0('#') --> `#`, swhite,!. -sexpr0('#\\'(35)) --> `#\\#`,!, swhite. -sexpr0(E) --> `#`,read_dispatch(E),!. - - -%sexpr('#\\'(C)) --> `#\\`,ci(`u`),!,remove_optional_char(`+`),dcg_basics:xinteger(C),!. -%sexpr('#\\'(C)) --> `#\\`,dcg_basics:digit(S0), swhite,!,{atom_codes(C,[S0])}. -sexpr0('#\\'(32)) --> `#\\ `,!. -sexpr0('#\\'(C)) --> `#\\`,!,zalwayzz(rsymbol(``,C)), swhite. - -%sexpr(['#-',K,Out]) --> `#-`,!,sexpr(C),swhite,expr_with_text(Out,sexpr(O),O),!,{as_keyword(C,K)}. -%sexpr(['#+',K,Out]) --> `#+`,!,sexpr(C),swhite,expr_with_text(Out,sexpr(O),O),!,{as_keyword(C,K)}. - -sexpr0(['#-',K,O]) --> `#-`,!,sexpr(C),swhite,sexpr(O),!,{as_keyword(C,K)},!. -sexpr0(['#+',K,O]) --> `#+`,!,sexpr(C),swhite,sexpr(O),!,{as_keyword(C,K)},!. - -:- if(is_wam_cl). - sexpr0(P) --> `#`,ci(`p`),!,zalwayzz((sexpr(C),{f_pathname(C,P)})),!. -:- endif. -sexpr0('$S'(C)) --> (`#`, ci(`s`),`(`),!,zalwayzz(sexpr_list(C)),swhite,!. -%sexpr('$COMPLEX'(R,I)) --> `#`,ci(`c`),`(`,!, lnumber(R),lnumber(I),`)`. -sexpr0('$COMPLEX'(R,I)) --> (`#`, ci(`c`),`(`),!,zalwayzz(sexpr_list([R,I])),swhite,!. -sexpr0('$OBJ'(claz_bitvector,C)) --> `#*`,radix_digits(2,C),swhite,!. - -sexpr0(function(E)) --> `#\'`, sexpr(E), !. %, swhite. -sexpr0('$OBJ'(claz_vector,V)) --> `#(`, !, zalwayzz(sexpr_vector(V,`)`)),!, swhite,!. - -sexpr0(Number) --> `#`,integer(Radix),ci(`r`),!,zalwayzz((signed_radix_2(Radix,Number0),extend_radix(Radix,Number0,Number))),!. -sexpr0('$ARRAY'(Dims,V)) --> `#`,integer(Dims),ci(`a`),!,sexpr(V). -sexpr0(V) --> `#.`, !,sexpr(C),{to_untyped(C,UTC),!,intern_and_eval(UTC,V)},!. -sexpr0('#'(E)) --> `#:`, !,zalwayzz(rsymbol(`#:`,E)), swhite. - -sexpr0(OBJ)--> `#<`,!,zalwayzz(ugly_sexpr_cont(OBJ)),!. - -% @TODO if CYC sexpr('#'(E)) --> `#$`, !, rsymbol(`#$`,E), swhite. -% @TODO if scheme sexpr('#'(t)) --> `#t`, !, swhite. -% @TODO if schemesexpr('#'(f)) --> `#f`, !, swhite. - -% sexpr(E) --> `#`,read_dispatch_error(E). - -/*********END HASH ***********/ - -sexpr0(E) --> sym_or_num(E), swhite,!. -sexpr0(Sym) --> `#`,integer(N123), swhite,!, {atom_concat('#',N123,Sym)}. -sexpr0(C) --> s_line_metta(C) , !. %s_line_metta(C), !. -sexpr0(C) --> s_item_metta(C, e_o_s). %s_line_metta(C), !. -sexpr0(E) --> !,zalwayzz(sym_or_num(E)), swhite,!. - -is_scm:- fail. - -% c:/opt/logicmoo_workspace/packs_sys/logicmoo_opencog/guile/module/ice-9/and-let-star.scm - -priority_symbol((`|-`)). -priority_symbol((`#=`)). -priority_symbol((`#+`)). -priority_symbol((`#-`)). -priority_symbol((`#false`)). -priority_symbol((`#true`)). -priority_symbol((`#nil`)). -priority_symbol((`#null`)). -priority_symbol((`#f`)). -priority_symbol((`#;`)):- is_scm. -priority_symbol((`#t`)). -priority_symbol((`+1+`)). -priority_symbol((`+1-`)). -priority_symbol((`-#+`)). -priority_symbol((`-1+`)). -priority_symbol((`-1-`)). -priority_symbol((`1+`)). -priority_symbol((`1-`)). - -sym_or_num('$COMPLEX'(L)) --> `#C(`,!, swhite, sexpr_list(L), swhite. -%sym_or_num((E)) --> unsigned_number(S),{number_string(E,S)}. -%sym_or_num((E)) --> unsigned_number(S),{number_string(E,S)}. - -sym_or_num((E)) --> lnumber(E),swhite,!. -sym_or_num(E) --> rsymbol_maybe(``,E),!. -%sym_or_num('#'(E)) --> [C],{atom_codes(E,[C])}. - -sym_or_num(E) --> dcg_xor(rsymbol(``,E),lnumber(E)),!. - - -sym_or_num(E) --> dcg_xor(rsymbol(``,E),lnumber(E)),!. -% sym_or_num('#'(E)) --> [C],{atom_codes(E,[C])}. - - -dcg_xor(DCG1,DCG2,S,E):- copy_term(DCG1,DCG1C),phrase(DCG1C,S,E),!, - (phrase(DCG2,S,[])->true;zalwayzz(DCG1C=DCG1)),!. -dcg_xor(_,DCG2,S,E):- phrase(DCG2,S,E),!. -%sblank --> [C], {var(C)},!. - -% sblank --> comment_expr(S,I,CP),!,{assert(t_l:s_reader_info('$COMMENT'(S,I,CP)))},!,swhite. -sblank --> comment_expr(CMT),!,{assert(t_l:s_reader_info(CMT))},!,swhite. -sblank --> [C], {nonvar(C),charvar(C),!,bx(C =< 32)},!,swhite. - -sblank_line --> eoln,!. -sblank_line --> [C],{bx(C =< 32)},!, sblank_line. - -s_string(Text) --> sexpr_string(Text). -s_string(Text) --> {kif_ok},`'`, !, zalwayzz(read_string_until(Text,`'`)),!. - - - -swhite --> sblank,!. -swhite --> []. - - -sexpr_lazy_list_character_count(Location, Stream, Here, Here) :- - sexpr_lazy_list_character_count(Here, Location, Stream). - -sexpr_lazy_list_character_count(Here, CharNo, Stream) :- - '$skip_list'(Skipped, Here, Tail), - ( attvar(Tail) - -> frozen(Tail, - pure_input:read_to_input_stream(Stream, _PrevPos, Pos, _List)), - stream_position_data(char_count, Pos, EndRecordCharNo), - CharNo is EndRecordCharNo - Skipped - ; Tail == [] - -> CharNo = end_of_file-Skipped - ; type_error(lazy_list, Here) - ). - - - -comment_expr('$COMMENT'(Expr,I,CP)) --> comment_expr_3(Expr,I,CP),!. - -comment_expr_3(T,N,CharPOS) --> {\+ kif_ok}, `#|`, !, my_lazy_list_location(file(_,_,N,CharPOS)),!, zalwayzz(read_string_until_no_esc(S,`|#`)),!, - {text_to_string_safe(S,T)},!. -comment_expr_3(T,N,CharPOS) --> `;`,!, my_lazy_list_location(file(_,_,N,CharPOS)),!,zalwayzz(read_string_until_no_esc(S,eoln)),!, - {text_to_string_safe(S,T)},!. -comment_expr_3(T,N,CharPOS) --> {kif_ok}, `#!`,!, my_lazy_list_location(file(_,_,N,CharPOS)),!,zalwayzz(read_string_until_no_esc(S,eoln)),!, - {text_to_string_safe(S,T)},!. -% For Scheme -comment_expr_3(T,N,CharPOS) --> `#!`,!, my_lazy_list_location(file(_,_,N,CharPOS)),!,zalwayzz(read_string_until_no_esc(S,`!#`)),!, - {text_to_string_safe(S,T)},!. - - -sexprs([H|T]) --> sexpr(H), !, sexprs(T). -sexprs([]) --> []. - - -:- export('//'(sexpr_list,1)). - - -peek_symbol_breaker_or_number --> dcg_peek([C]),{\+ sym_char(C),\+ char_type(C,digit)}. -peek_symbol_breaker --> dcg_peek([C]),{\+ sym_char(C)}. -peek_symbol_breaker --> one_blank. - -sexpr_list(X) --> one_blank,!,sexpr_list(X). -sexpr_list([]) --> `)`, !. -%sexpr_list(_) --> `.`, [C], {\+ sym_char(C)}, {fail}. -sexpr_list([Car|Cdr]) --> sexpr(Car), !, sexpr_rest(Cdr),!. - -sexpr_rest([]) --> `)`, !. -sexpr_rest(E) --> `.`, [C], {\+ sym_char(C)}, !, sexpr(E,C), !, `)`. -sexpr_rest(E) --> {kif_ok}, `@`, rsymbol(`?`,E), `)`. -sexpr_rest([Car|Cdr]) --> sexpr(Car), !, sexpr_rest(Cdr),!. - -sexpr_vector(O,End) --> zalwayzz(sexpr_vector0(IO,End)),!,{zalwayzz(O=IO)}. - -sexpr_vector0(X) --> one_blank,!,sexpr_vector0(X). -sexpr_vector0([],End) --> End, !. -sexpr_vector0([First|Rest],End) --> sexpr(First), !, sexpr_vector0(Rest,End). - -%s_string_cont(Until,"") --> Until,!, swhite. -:- encoding(iso_latin_1). -sexpr_string(Text) --> `"`, !, zalwayzz(read_string_until(Text,`"`)),!. -sexpr_string(Text) --> `“`, !, zalwayzz(read_string_until(Text,(`”`;`“`))),!. -sexpr_string(Text) --> (`”`;`“`), !, zalwayzz(read_string_until(Text,(`”`;`“`))),!. -sexpr_string(Text) --> `#|`, !, zalwayzz(read_string_until(Text,`|#`)),!. -:- encoding(utf8). -%sexpr_string([C|S],End) --> `\\`,!, zalwayzz(escaped_char(C)),!, sexpr_string(S,End). -%sexpr_string([],End) --> End, !. -% sexpr_string([32|S]) --> [C],{eoln(C)}, sexpr_string(S). -%sexpr_string([C|S],End) --> [C],!,sexpr_string(S,End). - -rsymbol_chars([C1,C2|Rest]) --> [C1,C2], {priority_symbol([C1,C2|Rest])},Rest,!. -rsymbol_chars([C|S])--> [C], {sym_char(C)},!, sym_continue(S),!. -%rsymbol_cont(Prepend,E) --> sym_continue(S), {append(Prepend,S,AChars),string_to_atom(AChars,E)},!. - -rsymbol(Chars,E) --> rsymbol_chars(List), {append(Chars,List,AChars),string_to_atom(AChars,E)},!. - -rsymbol_maybe(Prepend,ES) --> rsymbol(Prepend,E),{maybe_string(E,ES)},!. - -maybe_string(E,ES):- nb_current('$maybe_string',t),!,text_to_string_safe(E,ES),!. -maybe_string(E,E). - -sym_continue([H|T]) --> [H], {sym_char(H)},!, sym_continue(T). -sym_continue([39]) --> `'`, peek_symbol_breaker,!. -sym_continue([]) --> peek_symbol_breaker,!. -sym_continue([]) --> []. - -string_vector([First|Rest]) --> sexpr(First), !, string_vector(Rest),!. -string_vector([]) --> [], !. - -% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . - -lnumber(_)--> [C],{code_type(C,alpha)},!,{fail}. -lnumber(N)--> lnumber0(N),!. % (peek_symbol_breaker;[]). - -oneof_ci(OneOf,[C])--> {member(C,OneOf)},ci([C]). -dcg_and2(DCG1,DCG2,S,E) :- dcg_phrase(DCG1,S,E),!,dcg_phrase(DCG2,S,E),!. -dcg_each_call_cleanup(Setup,DCG,Cleanup,S,E) :- each_call_cleanup(Setup,dcg_phrase(DCG,S,E),Cleanup). -dcg_phrase(\+ DCG1,S,E):- !, \+ phrase(DCG1,S,E). -dcg_phrase(DCG1,S,E):- phrase(DCG1,S,E),!. - -dcg_not(DCG1,S,E) :- \+ dcg_phrase(DCG1,S,E). - -enumber(N)--> lnumber(L),!,{to_untyped(L,N)},!. - -/* -Format Minimum Precision Minimum Exponent Size -Short 13 bits 5 bits -Single 24 bits 8 bits -Double 50 bits 8 bits -Long 50 bits 8 bits -*/ - -float_e_type(`E`,claz_single_float). -float_e_type(`f`,claz_single_float). -float_e_type(`d`,claz_double_float). -float_e_type(`L`,claz_long_float). -float_e_type(`s`,claz_short_float). - -lnumber_exp('$EXP'(N,T,E))-->snumber_no_exp(N),!,oneof_ci(`EsfdL`,TC),dcg_basics:integer(E),{exp:float_e_type(TC,T)},!. -lnumber_exp('$EXP'(N,T,E))-->dcg_basics:integer(N),!,oneof_ci(`EsfdL`,TC),dcg_basics:integer(E),!,{float_e_type(TC,T)},!. - - -lnumber0(N) --> lnumber_exp(N),!. -lnumber0('$RATIO'(N,D)) --> sint(N),`/`,uint(D),!. -lnumber0(N) --> snumber_no_exp(N),!. -%lnumber0(N) --> dcg_basics:number(N),!. - - -snumber_no_exp(N)--> `-`,!,unumber_no_exp(S),{N is -S},!. -snumber_no_exp(N)--> `+`,!,unumber_no_exp(N),!. -snumber_no_exp(N)--> unumber_no_exp(N),!. -%snumber_no_exp(N)--> sint(N),!. - - -sint(N) --> signed_radix_number(N),!. -sint(N)--> `-`,!,uint(S),{N is -S},!. -sint(N)--> `+`,!,uint(N),!. -sint(N)--> uint(N),!. - -natural_int(_) --> dcg_not(dcg_basics:digit(_)),!,{fail}. -natural_int(N) --> dcg_basics:integer(N),!. - -digits_dot_digits --> natural_int(_),!,`.`,!,natural_int(_),!. - -unumber_no_exp(N) --> dcg_and2(digits_dot_digits,dcg_basics:float(N)),!. -unumber_no_exp(N) --> `.`,!,dcg_basics:digit(S0),!,dcg_basics:digits(S),{(notrace_catch_fail(number_codes(N,[48,46,S0|S])))},!. -unumber_no_exp(N)--> natural_int(E),`.`,natural_int(S),{(notrace_catch_fail(number_codes(ND,[48,46|S]))),N is ND + E},!. -unumber_no_exp(N) --> natural_int(N),!,remove_optional_char(`.`),!. - -uint(N) --> unsigned_radix_number(N),!. -uint(N) --> natural_int(N),!,remove_optional_char(`.`),!. - - -% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . - - -%= - -%% sexpr( ?E, ?C, ?X, ?Z) is det. -% -% S-Expression. -% -sexpr(E,C,X,Z) :- swhite([C|X],Y), sexpr(E,Y,Z),!. - -% dquote semicolon parens hash qquote comma backquote - -%= - -%% sym_char( ?C) is det. -% -% Sym Char. (not ";()#',` -% ) -% - -sym_char(C):- bx(C =< 32),!,fail. -%sym_char(44). % allow comma in middle of symbol -sym_char(C):- memberchk(C,`"()```),!,fail. % maybe 44 ? comma maybe not # or ; ? ' -%sym_char(C):- nb_current('$maybe_string',t),memberchk(C,`,.:;!%`),!,fail. -sym_char(_):- !. - -sym_char_start(C):- C\==44,C\==59,sym_char(C). - - - -:- thread_initialization(nb_setval('$maybe_string',[])). - -:- thread_local(t_l:s2p/1). -:- thread_local(t_l:each_file_term/1). - - - -%= - -%% to_unbackquote( ?I, ?O) is det. -% -% Converted To Unbackquote. -% -to_unbackquote(I,O):-to_untyped(I,O),!. - -:- export(to_untyped/2). - - -%atom_or_string(X):- (atom(X);string(X)),!. -as_keyword(C,K):- atom(C),!,(atom_concat_or_rtrace(':',_,C)->K=C;atom_concat_or_rtrace(':',C,K)),!. -as_keyword(C,C):- \+compound(C),!. -as_keyword([A|B],[AK|BK]):- !, as_keyword(A,AK),as_keyword(B,BK),!. -as_keyword(C,C). - - -%% to_untyped( :TermVar, :TermName) is det. -% -% Converted To Untyped. -% -to_untyped(S,S):- var(S),!. -to_untyped(S,S):- is_dict(S),!. -to_untyped([],[]):-!. -to_untyped('#-'(C,I),'#-'(K,O)):- as_keyword(C,K),!,to_untyped(I,O),!. -to_untyped('#+'(C,I),'#+'(K,O)):- as_keyword(C,K),!,to_untyped(I,O),!. -to_untyped('?'(S),_):- S=='??',!. -% to_untyped('?'(S),'$VAR'('_')):- S=='??',!. -% to_untyped(VAR,NameU):-atom(VAR),atom_concat_or_rtrace('#$',NameU,VAR),!. -to_untyped(VAR,NameU):-atom(VAR),(atom_concat_or_rtrace(N,'.',VAR)->true;N=VAR),(notrace_catch_fail(atom_number(N,NameU))),!. -%to_untyped(S,s(L)):- string(S),atom_contains(S,' '),atomic_list_concat(['(',S,')'],O),parse_sexpr_string(O,L),!. -to_untyped(S,S):- string(S),!. -to_untyped(S,S):- number(S),!. -%to_untyped(S,O):- atom(S),notrace_catch_fail(atom_number(S,O)),!. -to_untyped(Var,'$VAR'(Name)):-svar(Var,Name),!. -to_untyped('?'(Var),'$VAR'(Name)):-svar_fixvarname(Var,Name),!. -to_untyped(Atom,Atom):- \+ compound(Atom),!. -to_untyped('@'(Var),'$VAR'(Name)):-svar_fixvarname(Var,Name),!. -to_untyped('#'(S),O):- !, (nonvar(S)->to_untyped(S,O) ; O='#'(S)). -to_untyped('$CHAR'(S),C):-!,to_untyped('#\\'(S),C),!. -to_untyped('#\\'(S),C):-to_char(S,C),!. -to_untyped('#\\'(S),'#\\'(S)):-!. -to_untyped('$OBJ'([FUN, F]),O):- atom(FUN),!,to_untyped('$OBJ'(FUN, F),O). -to_untyped('$OBJ'([FUN| F]),O):- atom(FUN),!,to_untyped('$OBJ'(FUN, F),O). -to_untyped('$OBJ'(S),'$OBJ'(O)):-to_untyped(S,O),!. -to_untyped('$OBJ'(Ungly,S),'$OBJ'(Type,O)):- text_to_string_safe(Ungly,Str),string_to_atom(Str,Type),to_untyped(S,O),!. -to_untyped('$OBJ'(Ungly,S),'$OBJ'(Ungly,O)):-to_untyped(S,O),!. -to_untyped('$OBJ'(Ungly,S),O):-to_untyped(S,SO),!,O=..[Ungly,SO]. -to_untyped('$COMPLEX'(N0,D0),N):- to_untyped(D0,D), notrace_catch_fail(( 0 =:= D)),to_untyped(N0,N). -to_untyped('$RATIO'(N0,D0),V):- to_untyped(N0,N),to_untyped(D0,D), notrace_catch_fail(( 0 is N mod D, V is N div D)). -to_untyped('$NUMBER'(S),O):-nonvar(S),to_number(S,O),to_untyped(S,O),!. -to_untyped('$NUMBER'(S),'$NUMBER'(claz_short_float,S)):- float(S),!. -to_untyped('$NUMBER'(S),'$NUMBER'(claz_bignum,S)). -to_untyped('$EXP'(I,'E',E),N):- (notrace_catch_fail(N is 0.0 + ((I * 10^E)))),!. -to_untyped('$EXP'(I,claz_single_float,E),N):- (notrace_catch_fail(N is 0.0 + ((I * 10^E)))),!. -to_untyped('$EXP'(I,T,E),'$NUMBER'(T,N)):- (notrace_catch_fail(N is (I * 10^E))),!. -to_untyped('$EXP'(I,T,E),'$EXP'(I,T,E)):-!. - -to_untyped(with_text(I,_Txt),O):-to_untyped(I,O),!. -to_untyped(with_text(I,Txt),with_text(O,Txt)):-to_untyped(I,O),!. - -% to_untyped([[]],[]):-!. -to_untyped('$STR'(Expr),Forms):- (text_to_string_safe(Expr,Forms);to_untyped(Expr,Forms)),!. -to_untyped('$STRING'(Expr),'$STRING'(Forms)):- (text_to_string_safe(Expr,Forms);to_untyped(Expr,Forms)),!. -to_untyped(['#'(Backquote),Rest],Out):- is_common_lisp, Backquote == backquote, !,to_untyped(['#'('#BQ'),Rest],Out). -to_untyped(['#'(S)|Rest],OOut):- nonvar(S), is_list(Rest),must_maplist(to_untyped,[S|Rest],[F|Mid]), - ((atom(F),t_l:s2p(F))-> Out=..[F|Mid];Out=[F|Mid]), - to_untyped(Out,OOut). -to_untyped(ExprI,ExprO):- ExprI=..[F|Expr],atom_concat_or_rtrace('$',_,F),!,must_maplist(to_untyped,Expr,TT),ExprO=..[F|TT]. - -% to_untyped([H|T],Forms):-is_list([H|T]),zalwayzz(text_to_string_safe([H|T],Forms);maplist(to_untyped,[H|T],Forms)). -to_untyped([H|T],[HH|TT]):-!,zalwayzz((to_untyped(H,HH),!,to_untyped(T,TT))). -to_untyped(ExprI,ExprO):- zalwayzz(ExprI=..Expr), - must_maplist(to_untyped,Expr,[HH|TT]),(atom(HH)-> ExprO=..[HH|TT] ; ExprO=[HH|TT]),!. -% to_untyped(Expr,Forms):-def_compile_all(Expr,Forms),!. - -to_number(S,S):-number(S),!. -to_number(S,N):- text_to_string_safe(S,Str),number_string(N,Str),!. - - -to_char(S,'#\\'(S)):- var(S),!. -to_char('#'(S),C):- !, to_char(S,C). -to_char('#\\'(S),C):- !, to_char(S,C). -to_char(S,C):- atom(S),atom_concat('^',SS,S),upcase_atom(SS,SU),atom_codes(SU,[N64]),N is N64-64,N>=0,!,to_char(N,C). -to_char(S,C):- atom(S),atom_codes(S,[N]),!,to_char(N,C). -to_char(N,C):- text_to_string_safe(N,Str),name_to_charcode(Str,Code),to_char(Code,C),!. -%to_char(N,'#\\'(S)):- to_number(N,NC),!,char_code_to_char(NC,S),!. -to_char(N,'#\\'(S)):- integer(N),!,char_code_to_char(N,S),!. -to_char(N,'#\\'(N)). - -char_code_int(Char,Code):- notrace_catch_fail(char_code(Char,Code)),!. -char_code_int(Char,Code):- notrace_catch_fail(atom_codes(Char,[Code])),!. -char_code_int(Char,Code):- atom(Char),name_to_charcode(Char,Code),!. -char_code_int(Char,Code):- var(Char),!,wdmsg(char_code_int(Char,Code)), only_debug(break). -char_code_int(Char,Code):- wdmsg(char_code_int(Char,Code)),only_debug(break). - -char_code_to_char(N,S):- atom(N),atom_codes(N,[_]),!,S=N. -char_code_to_char(N,S):- atom(N),!,S=N. -%char_code_to_char(N,S):- code_type(N,graph),atom_codes(S,[N]),atom(S),!. -%char_code_to_char(N,O):- \+ integer(N),char_type(N,_),!,N=O. -%char_code_to_char(32,' '):-!. -%char_code_to_char(N,N):- \+ code_type(N,graph),!. -%char_code_to_char(N,N):- code_type(N,white),!. -char_code_to_char(N,S):- notrace_catch_fail(atom_codes(S,[N])),!. - - - -name_to_charcode(Str,Code):-find_from_name(Str,Code),!. -name_to_charcode(Str,Code):-text_upper(Str,StrU),find_from_name2(StrU,Code). -name_to_charcode(Str,Code):-string_codes(Str,[S,H1,H2,H3,H4|HEX]),memberchk(S,`Uu`),char_type(H4,xdigit(_)), - notrace_catch_fail(read_from_codes([48, 120,H1,H2,H3,H4|HEX],Code)). -name_to_charcode(Str,Code):-string_codes(Str,[S,H1|BASE10]),memberchk(S,`nd`),char_type(H1,digit), - notrace_catch_fail(read_from_codes([H1|BASE10],Code)). - -find_from_name(Str,Code):-string_codes(Str,Chars),lisp_code_name_extra(Code,Chars). -find_from_name(Str,Code):-lisp_code_name(Code,Str). -find_from_name(Str,Code):-string_chars(Str,Chars),lisp_code_name(Code,Chars). - -make_lisp_character(I,O):-quietly(to_char(I,O)). - -f_code_char(CH,CC):- zalwayzz(to_char(CH,CC)),!. -f_name_char(Name,CC):- zalwayzz((def_to_prolog_string(Name,CH),name_to_charcode(CH,Code),to_char(Code,CC))). -f_char_name(CH,CC):- zalwayzz(def_is_characterp(CH)),zalwayzz(code_to_name(CH,CC)). -f_char_int(CH,CC):- zalwayzz(def_is_characterp(CH)),zalwayzz('#\\'(C)=CH),(integer(C)->CC=C;char_code_int(C,CC)). -f_char_code(CH,CC):- f_char_int(CH,CC). - -to_prolog_char('#\\'(X),O):-!,to_prolog_char(X,O). -to_prolog_char(Code,Char):- number(Code),!,zalwayzz(char_code_int(Char,Code)),!. -%to_prolog_char(S,S):- atom(S),char_type(S,_),!. -to_prolog_char(Atom,Char):- name(Atom,[C|Odes]),!, - ((Odes==[] -> char_code_int(Char,C); - zalwayzz((text_to_string(Atom,String),name_to_charcode(String,Code),char_code_int(Char,Code))))). - -code_to_name(Char,Str):- number(Char),Char=Code,!,zalwayzz((code_to_name0(Code,Name),!,text_to_string(Name,Str))). -code_to_name(Char,Str):- zalwayzz((to_prolog_char(Char,PC),char_code_int(PC,Code),code_to_name0(Code,Name),!,text_to_string(Name,Str))). - -code_to_name0(Code,Name):-lisp_code_name_extra(Code,Name). -code_to_name0(Code,Name):-lisp_code_name(Code,Name). -code_to_name0(Code,Name):- Code<32, Ascii is Code+64,atom_codes(Name,[94,Ascii]). -code_to_name0(Code,Name):- code_type(Code,graph),!,atom_codes(Name,[Code]). - - -find_from_name2(Str,Code):-find_from_name(Str,Code). -find_from_name2(Str,Code):-lisp_code_name(Code,Chars),text_upper(Chars,Str). -find_from_name2(Str,Code):-lisp_code_name_extra(Code,Chars),text_upper(Chars,Str). - -text_upper(T,U):-text_to_string_safe(T,S),string_upper(S,U). - -lisp_code_name_extra(0,`Null`). -lisp_code_name_extra(1,`Soh`). -lisp_code_name_extra(2,`^B`). -lisp_code_name_extra(7,`Bell`). -lisp_code_name_extra(7,`bell`). -lisp_code_name_extra(8,`BCKSPC`). -lisp_code_name_extra(10,`Newline`). -lisp_code_name_extra(10,`LF`). -lisp_code_name_extra(10,`Linefeed`). -lisp_code_name_extra(11,`Vt`). -lisp_code_name_extra(27,`Escape`). -lisp_code_name_extra(27,`Esc`). -lisp_code_name_extra(32,`Space`). -lisp_code_name_extra(28,`fs`). -lisp_code_name_extra(13,`Ret`). - - -% @TODO undo this temp speedup -:- set_prolog_flag(all_lisp_char_names,false). -:- use_module('chars.data'). -/* - -(with-open-file (strm "lisp_code_names.pl" :direction :output :if-exists :supersede :if-does-not-exist :create) - (format strm ":- module(lisp_code_names,[lisp_code_name/2]).~%:- set_prolog_flag(double_quotes,chars).~%~%") - (loop for i from 0 to 655360 do (let ((cname (char-name (code-char i))) (uname4 (format () "U~4,'0X" i)) (uname8 (format () "U~8,'0X" i))) - (unless (equal cname uname4) (unless (equal cname uname8) (format strm "lisp_code_name(~A,~S).~%" i cname )))))) -*/ - - -%% remove_incompletes( :TermN, :TermCBefore) is det. -% -% Remove Incompletes. -% -remove_incompletes([],[]). -remove_incompletes([N=_|Before],CBefore):-var(N),!, - remove_incompletes(Before,CBefore). -remove_incompletes([NV|Before],[NV|CBefore]):- - remove_incompletes(Before,CBefore). - -:- export(extract_lvars/3). - -%= - -%% extract_lvars( ?A, ?B, ?After) is det. -% -% Extract Lvars. -% -extract_lvars(A,B,After):- - (get_varname_list(Before)->true;Before=[]), - remove_incompletes(Before,CBefore),!, - copy_lvars(A,CBefore,B,After),!. - -% copy_lvars( VAR,Vars,VAR,Vars):- var(VAR),!. - -%= - -%% copy_lvars( :TermVAR, ?Vars, :TermNV, ?NVars) is det. -% -% Copy Lvars. -% -copy_lvars(Term,Vars,Out,VarsO):- Term ==[],!,zalwayzz((Out=Term,VarsO=Vars)). -copy_lvars( VAR,Vars,Out,VarsO):- var(VAR),!,zalwayzz((Out=VAR,VarsO=Vars)). -copy_lvars([H|T],Vars,[NH|NT],VarsO):- !, copy_lvars(H,Vars,NH,SVars),!, copy_lvars(T,SVars,NT,VarsO). -copy_lvars('?'(Inner),Vars,Out,VarsO):- !, copy_lvars(Inner,Vars,NInner,VarsO), zalwayzz((atom(NInner) -> atom_concat_or_rtrace('?',NInner,Out) ; Out = '?'(NInner))),!. -copy_lvars( VAR,Vars,Out,VarsO):- svar(VAR,Name)->zalwayzz(atom(Name)),!,zalwayzz(register_var(Name=Out,Vars,VarsO)). -copy_lvars( VAR,Vars,Out,VarsO):- \+ compound(VAR),!,zalwayzz((Out=VAR,VarsO=Vars)). -copy_lvars(Term,Vars,NTerm,VarsO):- - Term=..[F|Args], % decompose term - (svar(F,_)-> copy_lvars( [F|Args],Vars,NTerm,VarsO); - % construct copy term - (copy_lvars(Args,Vars,NArgs,VarsO), NTerm=..[F|NArgs])),!. - - - -%= - -%% svar( ?Var, ?NameU) is det. -% -% If this is a KIF var, convert to a name for prolog -% -svar(SVAR,UP):- nonvar(UP),!,trace_or_throw(nonvar_svar(SVAR,UP)). -svar(Var,Name):- var(Var),!,zalwayzz(svar_fixvarname(Var,Name)). -svar('$VAR'(Var),Name):-number(Var),Var > -1, !, zalwayzz(format(atom(Name),'~w',['$VAR'(Var)])),!. -svar('$VAR'(Name),VarName):-!,zalwayzz(svar_fixvarname(Name,VarName)). -svar('?'(Name),NameU):-svar_fixvarname(Name,NameU),!. -svar(_,_):- \+ kif_ok,!,fail. -svar(VAR,Name):-atom(VAR),atom_concat_or_rtrace('?',A,VAR),non_empty_atom(A),svar_fixvarname(VAR,Name),!. -svar([],_):-!,fail. -svar('#'(Name),NameU):-!,svar(Name,NameU),!. -svar('@'(Name),NameU):-svar_fixvarname(Name,NameU),!. -% svar(VAR,Name):-atom(VAR),atom_concat_or_rtrace('_',_,VAR),svar_fixvarname(VAR,Name),!. -svar(VAR,Name):-atom(VAR),atom_concat_or_rtrace('@',A,VAR),non_empty_atom(A),svar_fixvarname(VAR,Name),!. - - -:- export(svar_fixvarname/2). - -%= - -%% svar_fixvarname( ?SVARIN, ?UP) is det. -% -% Svar Fixvarname. -% - -svar_fixvarname(SVAR,UP):- nonvar(UP),!,trace_or_throw(nonvar_svar_fixvarname(SVAR,UP)). -svar_fixvarname(SVAR,UP):- svar_fixname(SVAR,UP),!. -svar_fixvarname(SVAR,UP):- fail,trace_or_throw(svar_fixname(SVAR,UP)). - -svar_fixname(Var,NameO):-var(Var),!,variable_name_or_ref(Var,Name),sanity(nonvar(Name)),!,svar_fixvarname(Name,NameO). -svar_fixname('$VAR'(Name),UP):- !,svar_fixvarname(Name,UP). -svar_fixname('@'(Name),UP):- !,svar_fixvarname(Name,UP). -svar_fixname('?'(Name),UP):- !,svar_fixvarname(Name,UP). -svar_fixname('block'(Name),UP):- !,svar_fixvarname(Name,UP). -svar_fixname(SVAR,SVARO):- ok_var_name(SVAR),!,SVARO=SVAR. -svar_fixname('??','_'):-!. -svar_fixname(QA,AU):-atom_concat_or_rtrace('??',A,QA),non_empty_atom(A),!,svar_fixvarname(A,AO),atom_concat_or_rtrace('_',AO,AU). -svar_fixname(QA,AO):-atom_concat_or_rtrace('?',A,QA),non_empty_atom(A),!,svar_fixvarname(A,AO). -svar_fixname(QA,AO):-atom_concat_or_rtrace('@',A,QA),non_empty_atom(A),!,svar_fixvarname(A,AO). -svar_fixname(NameU,NameU):-atom_concat_or_rtrace('_',Name,NameU),non_empty_atom(Name),atom_number(Name,_),!. -svar_fixname(NameU,NameUO):-atom_concat_or_rtrace('_',Name,NameU),non_empty_atom(Name), - \+ atom_number(Name,_),!,svar_fixvarname(Name,NameO),atom_concat_or_rtrace('_',NameO,NameUO). -svar_fixname(I,O):- - notrace(( - notrace(catch(fix_varcase(I,M0),_,fail)), - atom_subst(M0,'@','_AT_',M1), - atom_subst(M1,'?','_Q_',M2), - atom_subst(M2,':','_C_',M3), - atom_subst(M3,'-','_',O), - ok_var_name(O))),!. - -%= - -%% fix_varcase( ?I, ?O) is det. -% -% Fix Varcase. -% -fix_varcase(Word,Word):- atom_concat_or_rtrace('_',_,Word),!. -fix_varcase(Word,WordC):- !, atom_codes(Word,[F|R]),to_upper(F,U),atom_codes(WordC,[U|R]). -% the cut above stops the rest -fix_varcase(Word,Word):-upcase_atom(Word,UC),UC=Word,!. -fix_varcase(Word,WordC):-downcase_atom(Word,UC),UC=Word,!,atom_codes(Word,[F|R]),to_upper(F,U),atom_codes(WordC,[U|R]). -fix_varcase(Word,Word). % mixed case - -:- export(ok_varname_or_int/1). - -%% ok_varname_or_int( ?Name) is det. -% -% Ok Varname. -% -ok_varname_or_int(Name):- atom(Name),!,ok_var_name(Name). -ok_varname_or_int(Name):- number(Name). - -%% ok_var_name( ?Name) is det. -% -% Ok Varname. -% -ok_var_name(Name):- - notrace(( - quietly_sreader(( atom(Name),atom_codes(Name,[C|_List]),char_type(C,prolog_var_start), - notrace(catch(read_term_from_atom(Name,Term,[variable_names(Vs)]),_,fail)), - !,var(Term),Vs=[RName=RVAR],!,RVAR==Term,RName==Name)))). - -%:- export(ok_codes_in_varname/1). -%ok_codes_in_varname([]). -%ok_codes_in_varname([C|List]):-!,ok_in_varname(C),ok_codes_in_varname(List). - -%:- export(ok_in_varname/1). -%ok_in_varname(C):-sym_char(C),\+member(C,`!@#$%^&*?()`). - - - -%= - -%% atom_upper( ?A, ?U) is det. -% -% Atom Upper. -% -atom_upper(A,U):-string_upper(A,S),quietly_sreader(((atom_string(U,S)))). - - -%= - -%% lisp_read_from_input( ?Forms) is det. -% -% Lisp Read Converted From Input. -% -lisp_read_from_input(Forms):-lisp_read(current_input,Forms),!. - -readCycL(Forms):-lisp_read(current_input,Forms). - -%% lisp_read_from_stream( ?I, ?Forms) is det. -% -% Lisp Read Converted To Simple Form. -% -lisp_read_from_stream(Input,Forms):- - lisp_read(Input,Forms). - - -%% lisp_read( ?I, ?Forms) is det. -% -% Lisp Read Converted To Simple Form. -% -lisp_read(Input,Forms):- - lisp_read_typed(Input, Forms0),!, - quietly_sreader((zalwayzz(to_untyped(Forms0,Forms)))). - - - -%% lisp_read_typed( ?I, -Expr) is det. -% -% Lisp Read, Expression models DCG -% -lisp_read_typed(In,Expr):- track_stream(In,parse_sexpr(In,Expr)),!. -/* -lisp_read_typed(In,Expr):- fail, % old_stream_read - (read_line_to_codes(current_input,AsciiCodes), - (AsciiCodes==[]-> (at_end_of_stream(In) -> (Expr=end_of_file); lisp_read_typed(In,Expr)); - once(zalwayzz(parse_sexpr(AsciiCodes,Expr);lisp_read_typed(In,Expr));read_term_from_codes(AsciiCodes,Expr,[])))). -*/ - - -%= - -%% lowcase( :TermC1, :TermC2) is det. -% -% Lowcase. -% -lowcase([],[]). -lowcase([C1|T1],[C2|T2]) :- lowercase(C1,C2), lowcase(T1,T2). - - -%= - -%% lowercase( ?C1, ?C2) is det. -% -% Lowercase. -% -lowercase(C1,C2) :- C1 >= 65, C1 =< 90, !, C2 is C1+32. -lowercase(C,C). - - -/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Interpretation - -------------- - - Declaratively, execution of a Lisp form is a relation between the - (function and variable) binding environment before its execution - and the environment after its execution. A Lisp program is a - sequence of Lisp forms, and its result is the sequence of their - results. The environment is represented as a pair of association - lists Fs-Vs, associating function names with argument names and - bodies, and variables with values. DCGs are used to implicitly - thread the environment state through. -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - - - -%= - -%% codelist_to_forms( ?AsciiCodesList, ?FormsOut) is det. -% -% Codelist Converted To Forms. -% -codelist_to_forms(AsciiCodesList,FormsOut):- - parse_sexpr(AsciiCodesList, Forms0),!, - zalwayzz(def_compile_all(Forms0, FormsOut)),!. - - -/* - -:- export(baseKB:rff/0). - -baseKB:rff:-baseKB:rff(dbginfo(n(first)),dbginfo(n(retry)),dbginfo(n(success)),dbginfo(n(failure))). - -:- export(baseKB:rff/4). -baseKB:rff(OnFirst,OnRetry,OnSuccess,OnFailure) :- CU = was(never,first), - call_cleanup(( - process_rff(CU,OnFirst,OnRetry,OnSuccess,OnFailure), - (nb_setarg(1,CU,first));((nb_setarg(1,CU,second)),!,fail)), - (nb_setarg(2,CU,second),process_rff(CU,OnFirst,OnRetry,OnSuccess,OnFailure),dbginfo(cleanup(CU)))), - once(( - process_rff(CU,OnFirst,OnRetry,OnSuccess,OnFailure), - CU \= was(second, _))). - -:- export(process_rff/5). -process_rff(CU,OnFirst,OnRetry,OnSuccess,OnFailure):- - dbginfo(next(CU)), - once(((CU==was(first,first)->OnFirst;true), - (CU==was(second,first)->OnRetry;true), - (CU==was(second,second)->OnFailure;true), - (CU==was(first,second)-e>OnSuccess;true))). - - -*/ - - -/* -:- prolog_load_context(directory,Dir), - DirFor = plarkc, - (( \+ user:file_search_path(DirFor,Dir)) ->asserta(user:file_search_path(DirFor,Dir));true), - absolute_file_name('../../../../',Y,[relative_to(Dir),file_type(directory)]), - (( \+ user:file_search_path(pack,Y)) ->asserta(user:file_search_path(pack,Y));true). -:- attach_packs. -:- initialization(attach_packs). -*/ - -% [Required] Load the Logicmoo Library Utils -% = % :- ensure_loaded(logicmoo(logicmoo_utils)). - -% % :- ensure_loaded(logicmoo(plarkc/mpred_cyc_api)). - - -:- export(fixvars/4). - -%= - -%% fixvars( ?P, ?VALUE2, :TermARG3, ?P) is det. -% -% Fixvars. -% -fixvars(P,_,[],P):-!. -fixvars(P,N,[V|VARS],PO):- - quietly_sreader((atom_string(Name,V))), - svar_fixvarname(Name,NB),Var = '$VAR'(NB), - substM(P,'$VAR'(N),Var,PM0), - substM(PM0,'$VAR'(Name),Var,PM), - % (get_varname_list(Vs)->true;Vs=[]), - % append(Vs,[Name=Var],NVs), - % nput_variable_names( NVs), - N2 is N + 1, fixvars(PM,N2,VARS,PO). - - - - -non_empty_atom(A1):- atom(A1),atom_length(A1,AL),!,AL>0. - -:- meta_predicate(sexpr_sterm_to_pterm(+,?,?)). -:- meta_predicate(sexpr_sterm_to_pterm_list(+,?,?)). - -is_relation_sexpr('=>'). -is_relation_sexpr('<=>'). -is_relation_sexpr('==>'). -is_relation_sexpr('<==>'). -is_relation_sexpr('not'). -is_relation_sexpr(typeGenls). - -is_va_relation('or'). -is_va_relation('and'). -%= - - -is_exact_symbol(N,_):- \+ atom(N),!,fail. -is_exact_symbol(N,P):- nonvar(P),!,is_exact_symbol(N,PP),zalwayzz(P=PP). -is_exact_symbol(':-',':-'). -is_exact_symbol('?-','?-'). -is_exact_symbol('??',_). - -%:- baseKB:ensure_loaded(logicmoo('plarkc/logicmoo_i_cyc_rewriting')). - -maybe_var(S,Name,'$VAR'(Name)):- S=='?',atom(Name),!. - -%% sexpr_sterm_to_pterm(?VAR, ?V) is det. -% -% S-expression Sterm Converted To Pterm. -% -sexpr_sterm_to_pterm(S,P):- sexpr_sterm_to_pterm(0,S,P). - - -sexpr_sterm_to_pterm_pre_list(_,STERM,STERM):- \+ compound(STERM), !. -sexpr_sterm_to_pterm_pre_list(_,STERM,STERM):- \+ is_list(STERM), !. -% sexpr_sterm_to_pterm_pre_list(_,[S|STERM],[S|STERM]):- STERM == [], !. -sexpr_sterm_to_pterm_pre_list(TD,[S0|STERM0],[S|STERM]):- - (is_list(S0)->sexpr_sterm_to_pterm(TD,S0,S);sexpr_sterm_to_pterm_pre_list(TD,S0,S)), - sexpr_sterm_to_pterm_pre_list(TD,STERM0,STERM). - -sexpr_sterm_to_pterm(_TD,VAR,VAR):-is_ftVar(VAR),!. -sexpr_sterm_to_pterm(_TD,S,P):- is_exact_symbol(S,P),!. -sexpr_sterm_to_pterm(_TD,'#'(S),P):- is_exact_symbol(S,P),!. -sexpr_sterm_to_pterm(_TD,VAR,'$VAR'(Name)):- atom(VAR),svar(VAR,Name),!. - -% sexpr_sterm_to_pterm(TD,List,PTERM):- append(Left,[S,Name|TERM],List),maybe_var(S,Name,Var),!,append(Left,[Var|TERM],NewList), sexpr_sterm_to_pterm(TD,NewList,PTERM). -% sexpr_sterm_to_pterm(TD,[S|TERM],dot_holds(PTERM)):- \+ (is_list(TERM)),sexpr_sterm_to_pterm_list(TD,[S|TERM],PTERM),!. -%sexpr_sterm_to_pterm(TD,[S|TERM],PTERM):- \+ atom(S),sexpr_sterm_to_pterm_list(TD,[S|TERM],PTERM),!. -/* -sexpr_sterm_to_pterm(TD,[S,Vars|TERM],PTERM):- nonvar(S), - call_if_defined(common_logic_snark:is_quantifier(S)), - zalwayzz((sexpr_sterm_to_pterm_list(TD,TERM,PLIST), - PTERM=..[S,Vars|PLIST])),!. -*/ - -sexpr_sterm_to_pterm(TD,[S|STERM0],PTERM):- var(S), TD1 is TD + 1, sexpr_sterm_to_pterm_pre_list(TD1,STERM0,STERM), sexpr_sterm_to_pterm_list(TD1,STERM,PLIST),s_univ(TD,PTERM,[S|PLIST]),!. -sexpr_sterm_to_pterm(_,[S,STERM0],PTERM):- is_quoter(S),sexpr_sterm_to_pterm_pre_list(0,STERM0,STERM), !,PTERM=..[S,STERM],!. -sexpr_sterm_to_pterm(_,[S|STERM0],PTERM):- is_quoter(S),sexpr_sterm_to_pterm_pre_list(0,STERM0,STERM), !,PTERM=..[S,STERM],!. -sexpr_sterm_to_pterm(TD,[S|STERM0],PTERM):- sexpr_sterm_to_pterm_pre_list(TD,STERM0,STERM), is_list(STERM), - next_args_are_lists_unless_string(S,NonList), - length(LEFT,NonList),append(LEFT,[List|RIGHT],STERM),is_list(List), - TD1 is TD+1, - sexpr_sterm_to_pterm_list(TD1,LEFT,PLEFTLIST), - sexpr_sterm_to_pterm_list(0,RIGHT,PRIGHTLIST), - append(PLEFTLIST,[List|PRIGHTLIST],PLIST), - s_univ(TD,PTERM,[S|PLIST]),!. - -sexpr_sterm_to_pterm(TD,STERM0,PTERM):- TD1 is TD+1,sexpr_sterm_to_pterm_pre_list(TD,STERM0,STERM), - is_list(STERM),!, sexpr_sterm_to_pterm_list(TD1,STERM,PLIST),s_univ(TD,PTERM,PLIST),!. -sexpr_sterm_to_pterm(_TD,VAR,VAR). - -is_quoter('#BQ'):- is_common_lisp. -is_quoter('#COMMA'):- is_common_lisp. -is_quoter('quote'). - -next_args_are_lists_unless_string(defmacro,1). -next_args_are_lists_unless_string(defun,1). -next_args_are_lists_unless_string(let,0). -next_args_are_lists_unless_string('let*',0). - -%sexpr_sterm_to_pterm(TD,[S|TERM],PTERM):- (number(S); (atom(S),fail,atom_concat_or_rtrace(_,'Fn',S))),sexpr_sterm_to_pterm_list(TD,[S|TERM],PTERM),!. -%sexpr_sterm_to_pterm(TD,[S],O):- is_ftVar(S),sexpr_sterm_to_pterm(TD,S,Y),!,s_univ(TD,O,[Y]),!. -%sexpr_sterm_to_pterm(TD,[S],O):- nonvar(S),sexpr_sterm_to_pterm(TD,S,Y),!,s_univ(TD,O,[Y]),!. -%sexpr_sterm_to_pterm(TD,[S|TERM],PTERM):- is_ftVar(S), sexpr_sterm_to_pterm_list(TD,TERM,PLIST),s_univ(TD,PTERM,[t,S|PLIST]),!. -%sexpr_sterm_to_pterm(TD,[S|TERM],PTERM):- \+ atom(S), sexpr_sterm_to_pterm_list(TD,TERM,PLIST),s_univ(TD,PTERM,[t,S|PLIST]),!. -%sexpr_sterm_to_pterm(TD,[S|TERM],PTERM):- S==and,!,zalwayzz((maplist(sexpr_sterm_to_pterm,TERM,PLIST),list_to_conjuncts(',',PLIST,PTERM))). -% sexpr_sterm_to_pterm(TD,[S|TERM],PTERM):- is_va_relation(S),!,zalwayzz((maplist(sexpr_sterm_to_pterm,TERM,PLIST),list_to_conjuncts(S,PLIST,PTERM))). -%sexpr_sterm_to_pterm(TD,[S|TERM],PTERM):- is_relation_sexpr(S),zalwayzz((sexpr_sterm_to_pterm_list(TD,TERM,PLIST),PTERM=..[S|PLIST])),!. -%sexpr_sterm_to_pterm(TD,STERM,PTERM):- STERM=..[S|TERM],sexpr_sterm_to_pterm_list(TD,TERM,PLIST),s_univ(TD,PTERM,[S|PLIST]),!. - -s_functor(F):- \+ atom(F), !,fail. -s_functor(F):- \+ atom_concat('?',_,F). - -s_univ(1,S,S):-!. -s_univ(_TD,P,[F|ARGS]):- s_functor(F),is_list(ARGS),length(ARGS,A),l_arity(F,A),P=..[F|ARGS]. -s_univ(0,P,[F|ARGS]):- s_functor(F),is_list(ARGS),P=..[F|ARGS]. -s_univ(_TD,P,[F|ARGS]):- s_functor(F),is_list(ARGS),P=..[F|ARGS]. -s_univ(_TD,P,S):-P=S. - -l_arity(F,A):- clause_b(arity(F,A)). -l_arity(function,1). -l_arity(quote,1). -l_arity('#BQ',1):- is_common_lisp. -l_arity(F,A):-current_predicate(F/A). -l_arity(_,1). - -%% sexpr_sterm_to_pterm_list(TD, ?VAR, ?VAR) is det. -% -% S-expression Converted To Pterm List. -% - -sexpr_sterm_to_pterm_list(TD,TERM,PTERMO):- is_list(TERM),append(BEFORE,[VAR],TERM),atom(VAR), - atom_concat_or_rtrace('@',RVAR,VAR),non_empty_atom(RVAR),svar_fixvarname(RVAR,V),!,append(BEFORE,'$VAR'(V),PTERM), - sexpr_sterm_to_pterm_list0(TD,PTERM,PTERMO). -sexpr_sterm_to_pterm_list(TD,TERM,PTERM):- sexpr_sterm_to_pterm_list0(TD,TERM,PTERM). - -sexpr_sterm_to_pterm_list0(_,VAR,VAR):-is_ftVar(VAR),!. -sexpr_sterm_to_pterm_list0(_,[],[]):-!. -sexpr_sterm_to_pterm_list0(TD,[S|STERM],[P|PTERM]):-sexpr_sterm_to_pterm(TD,S,P),sexpr_sterm_to_pterm_list0(TD,STERM,PTERM),!. -sexpr_sterm_to_pterm_list0(_,VAR,VAR). - - -/*=================================================================== -% input_to_forms/3 does less consistancy checking then conv_to_sterm - -Always a S-Expression: 'WFFOut' placing variables in 'VARSOut' - -|?-input_to_forms(`(isa a b)`,Clause,Vars). -Clause = [isa,a,b] -Vars = _h70 - -| ?- input_to_forms(`(isa a (b))`,Clause,Vars). -Clause = [isa,a,[b]] -Vars = _h70 - -|?-input_to_forms(`(list a b )`,Clause,Vars) -Clause = [list,a,b] -Vars = _h70 - -?- input_to_forms_debug("(=> (isa ?NUMBER ImaginaryNumber) (exists (?REAL) (and (isa ?REAL RealNumber) (equal ?NUMBER (MultiplicationFn ?REAL (SquareRootFn -1))))))"). - -?- input_to_forms_debug("(=> (isa ?PROCESS DualObjectProcess) (exists (?OBJ1 ?OBJ2) (and (patient ?PROCESS ?OBJ1) (patient ?PROCESS ?OBJ2) (not (equal ?OBJ1 ?OBJ2)))))"). - - -| ?- input_to_forms(`(genlMt A ?B)`,Clause,Vars). -Clause = [genlMt,'A',_h998] -Vars = [=('B',_h998)|_h1101] - -| ?- input_to_forms(` - (goals Iran (not (exists (?CITIZEN) - (and (citizens Iran ?CITIZEN) (relationExistsInstance maleficiary ViolentAction ?CITIZEN)))))` - ). - -Clause = [goals,Iran,[not,[exists,[_h2866],[and,[citizens,Iran,_h2866],[relationExistsInstance,maleficiary,ViolentAction,_h2866]]]]] -Vars = [=(CITIZEN,_h2866)|_h3347] - -| ?- input_to_forms_debug(` -(queryTemplate-Reln QuestionTemplate definitionalDisplaySentence - (NLPatternList - (NLPattern-Exact "can you") - (RequireOne - (NLPattern-Word Acquaint-TheWord Verb) - (NLPattern-Word Tell-TheWord Verb)) - (RequireOne - (NLPattern-Exact "me with") - (NLPattern-Exact "me what")) - (OptionalOne - (WordSequence "the term") "a" "an") - (NLPattern-Template NPTemplate :THING) - (OptionalOne "is" ) - (OptionalOne TemplateQuestionMarkMarker)) - (definitionalDisplaySentence :THING ?SENTENCE)) ` -). - -| ?- input_to_forms_debug(` - (#$STemplate #$bioForProposal-short - (#$NLPatternList (#$NLPattern-Template #$NPTemplate :ARG1) - (#$NLPattern-Exact "short bio for use in proposals" ) (#$NLPattern-Word #$Be-TheWord #$Verb) - (#$NLPattern-Exact "") (#$NLPattern-Template #$NPTemplate :ARG2)) (#$bioForProposal-short :ARG1 :ARG2))` - ). - -input_to_forms_debug("(=> (disjointDecomposition ?CLASS @ROW) (forall (?ITEM1 ?ITEM2) (=> (and (inList ?ITEM1 (ListFn @ROW)) (inList ?ITEM2 (ListFn @ROW)) (not (equal ?ITEM1 ?ITEM2))) (disjoint ?ITEM1 ?ITEM2))))"). - - -input_to_forms_debug( -` - (#$STemplate #$bioForProposal-short - (#$NLPatternList (#$NLPattern-Template #$NPTemplate :ARG1) - (#$NLPattern-Exact "short bio for use in proposals" ) (#$NLPattern-Word #$Be-TheWord #$Verb) - (#$NLPattern-Exact "") (#$NLPattern-Template #$NPTemplate :ARG2)) (#$bioForProposal-short :ARG1 :ARG2)) ` - ). - -% txt_to_codes("(documentation Predicate EnglishLanguage \"A &%Predicate is a sentence-forming &%Relation. Each tuple in the &%Relation is a finite, ordered sequence of objects. The fact that a particular tuple is an element of a &%Predicate is denoted by '(*predicate* arg_1 arg_2 .. arg_n)', where the arg_i are the objects so related. In the case of &%BinaryPredicates, the fact can be read as `arg_1 is *predicate* arg_2' or `a *predicate* of arg_1 is arg_2'.\")",X). -input_to_forms_debug("(documentation Predicate EnglishLanguage \"A &%Predicate is a sentence-forming &%Relation. Each tuple in the &%Relation is a finite, ordered sequence of objects. The fact that a particular tuple is an element of a &%Predicate is denoted by '(*predicate* arg_1 arg_2 .. arg_n)', where the arg_i are the objects so related. In the case of &%BinaryPredicates, the fact can be read as `arg_1 is *predicate* arg_2' or `a *predicate* of arg_1 is arg_2'.\")",X,Y). - -// ==================================================================== */ -:- export(current_input_to_forms/2). - - -%% input_to_forms( ?FormsOut, ?Vars) is det. -% -% Input Converted To Forms. -% -current_input_to_forms(FormsOut,Vars):- - current_input(In), - input_to_forms(In, FormsOut,Vars). - -show_wff_debug(Wff,Vs):- nonvar(Wff),Wff=(H=B),!,show_wff_debug((H:-B),Vs). -show_wff_debug(Wff,Vs):- fmt("\n"), - must_or_rtrace(portray_clause_w_vars(Wff,Vs,[])),!. - -% input_to_forms_debug(String):- sumo_to_pdkb(String,Wff),dbginfo(Wff),!. -input_to_forms_debug(String):- - input_to_forms_debug(String,['=']). - -input_to_forms_debug(String,M:Decoders):- - setup_call_cleanup( - fmt("% ========================\n"), - (get_varnames(Was), show_wff_debug(input=String,Was), - input_to_forms(String,Wff,Vs), - b_setval('$variable_names',Vs), - show_wff_debug(to_forms=Wff,Vs), - do_decoders(Wff,Vs,M,Decoders),!, - ignore((nonvar(Vs),Vs\==[], show_wff_debug(vars=Vs,Vs)))), - fmt("\n% ========================\n")). - -do_decoders(_,_,_,[]):-!. -do_decoders(Wff,Vs,M,[Decoder|Decoders]):- !, - ((M:call(Decoder,Wff,WffO), ignore((Wff \== WffO , show_wff_debug((M:Decoder:-WffO),Vs)))) - -> do_decoders(WffO,Vs,M,Decoders) - ; - (fmt(decoder_failed(M:Decoder)), - do_decoders(Wff,Vs,M,Decoders))). -do_decoders(Wff,Vs,M,Decoder):- do_decoders(Wff,Vs,M,[Decoder]). - -:- export(input_to_forms/2). -%% input_to_forms( ?In, ?FormsOut) is det. -% -% Get Input Converted To Forms. -% -input_to_forms(Codes,FormsOut):- - input_to_forms(Codes,FormsOut,Vars) -> - add_variable_names(Vars). - -:- export(input_to_forms/3). - -%% input_to_forms( ?In, ?FormsOut, ?Vars) is det. -% -% Get Input Converted To Forms. -% -input_to_forms(Codes,FormsOut,Vars):- - push_varnames(_) -> - quietly_sreader((input_to_forms0(Codes,FormsOut,Vars))). - -is_variable_names_safe(Vars):- var(Vars),!. -is_variable_names_safe([N=V|Vars]):- !, - is_name_variable_safe(N,V) -> - is_variable_names_safe(Vars). -is_variable_names_safe([]). - -is_name_variable_safe(N,V):- - ok_var_name(N)-> var(V). - - -get_varnames(Was):- nb_current('$variable_names',Was)->true;Was=[]. - -push_varnames(New):- - (nonvar(New)-> b_setval('$variable_names',New) - ; (get_varnames(Was), Was = New, b_setval('$variable_names',Was))). - -add_variable_names(Vars):- var(Vars),!. -add_variable_names(N=V):- !, ignore(set_varname_s(N,V)). -add_variable_names([NV|Vars]):- add_variable_names(NV),!, add_variable_names(Vars). -add_variable_names([]). - -set_varname_s(N,V):- get_varnames(Was), set_varname4(Was,N,V,New),b_setval('$variable_names',New). - -set_varname4(Was,N,V,New):- member(NV,Was),NV=(NN=VV), NN==N,!, (V=VV->true;setarg(2,NV,V)), New = Was. -set_varname4(Was,N,V,New):- member(NV,Was),NV=(NN=VV), VV==V,!, (N=NN->true;setarg(1,NV,N)), New = Was. -set_varname4(Was,N,V,[N=V|Was]). - - -set_variable_names_safe(Vars):- - is_variable_names_safe(Vars)-> - b_setval('$variable_names',Vars); true. - -input_to_forms0(Codes,FormsOut,Vars):- - % is_openable(Codes),!, - parse_sexpr(Codes, Forms0),!, - once((to_untyped(Forms0, Forms1), - extract_lvars(Forms1,FormsOut,Vars))). - -input_to_forms0(Forms,FormsOut,Vars):- - (to_untyped(Forms, Forms1) -> - extract_lvars(Forms1,FormsOut,Vars)-> true),!. - - -/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Lisprolog -- Interpreter for a simple Lisp. Written in Prolog. - Written Nov. 26th, 2006 by Markus Triska (triska@gmx.at). - Public domain code. -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - -%:- style_check(-singleton). -%:- style_check(-discontiguous). -% :- style_check(-atom). -/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Parsing -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - - -tstl:- tstl('./ontologyportal_sumo/Merge.kif'), - tstl('./ontologyportal_sumo/Translations/relations-en.txt'), - tstl('./ontologyportal_sumo/english_format.kif'), - tstl('./ontologyportal_sumo/domainEnglishFormat.kif'), - tstl('./ontologyportal_sumo/Mid-level-ontology.kif'), - !. - -writeqnl(O):- writeq(O),nl. - - - -%:- fixup_exports. -%:- endif. - diff --git a/.Attic/metta_lang/metta_rust.pl b/.Attic/metta_lang/metta_rust.pl deleted file mode 100755 index fcae66a45ba..00000000000 --- a/.Attic/metta_lang/metta_rust.pl +++ /dev/null @@ -1,5 +0,0 @@ - - -:- ensure_loaded(metta_python). -:- ensure_loaded(metta_interp). - diff --git a/.Attic/metta_lang/metta_subst.bk b/.Attic/metta_lang/metta_subst.bk deleted file mode 100755 index 55f0ca41a89..00000000000 --- a/.Attic/metta_lang/metta_subst.bk +++ /dev/null @@ -1,833 +0,0 @@ -%self_eval_l1t(X):- var(X),!. -%self_eval_l1t(X):- string(X),!. -%self_eval_l1t(X):- number(X),!. -%self_eval_l1t([]). -self_eval_l1t(X):- \+ callable(X),!. -self_eval_l1t(X):- is_valid_nb_state(X),!. -self_eval_l1t(X):- is_list(X),!,fail. -%self_eval_l1t(X):- compound(X),!. -%self_eval_l1t(X):- is_ref(X),!,fail. -self_eval_l1t(X):- atom(X),!, \+ nb_current(X,_),!. -self_eval_l1t('True'). self_eval_l1t('False'). self_eval_l1t('F'). - - -:- nb_setval(self_space, '&self'). -eval_l1ts_to(XX,Y):- Y==XX,!. -eval_l1ts_to(XX,Y):- Y=='True',!, is_True(XX),!. - -%current_self(Space):- nb_current(self_space,Space). -eval_l1t_args(A,AA):- - current_self(Space), - eval_l1t_args(11,Space,A,AA). - -%eval_l1t_args(Depth,_Self,X,_Y):- forall(between(6,Depth,_),write(' ')),writeqln(eval_l1t_args(X)),fail. - -eval_l1t_args(_Dpth,_Slf,X,Y):- nonvar(Y),X=Y,!. - -eval_l1t_args(Depth,Self,X,Y):- nonvar(Y),!,eval_l1t_args(Depth,Self,X,XX),eval_l1ts_to(XX,Y). -eval_l1t_args(_Dpth,_Slf,X,Y):- self_eval_l1t(X),!,Y=X. -eval_l1t_args(_Dpth,_Slf,[X|T],Y):- T==[], \+ callable(X),!,Y=[X]. - -eval_l1t_args(Depth,Self,[F|X],Y):- - (F=='superpose' ; ( option_value(no_repeats,false))), - mnotrace((D1 is Depth-1)),!, - eval_l1t_args0(D1,Self,[F|X],Y). - -eval_l1t_args(Depth,Self,X,Y):- - mnotrace((no_repeats_var(YY), - D1 is Depth-1)), - eval_l1t_args0(D1,Self,X,Y), - mnotrace(( \+ (Y\=YY))). - - - - - -:- nodebug(metta(eval_l1t)). - -/* -debugging_metta(G):-is_debugging((eval_l1t))->ignore(G);true. -w_indent(Depth,Goal):- - \+ \+ mnotrace(ignore((( - format('~N'), - setup_call_cleanup(forall(between(Depth,101,_),write(' ')),Goal, format('~N')))))). -indentq(Depth,Term):- - \+ \+ mnotrace(ignore((( - format('~N'), - setup_call_cleanup(forall(between(Depth,101,_),write(' ')),format('~q',[Term]), - format('~N')))))). - - -with_debug(Flag,Goal):- is_debugging(Flag),!, call(Goal). -with_debug(Flag,Goal):- flag(eval_l1t_num,_,0), - setup_call_cleanup(set_debug(Flag,true),call(Goal),set_debug(Flag,flase)). - -flag_to_var(Flag,Var):- atom(Flag), \+ atom_concat('trace-on-',_,Flag),!,atom_concat('trace-on-',Flag,Var). -flag_to_var(metta(Flag),Var):- !, nonvar(Flag), flag_to_var(Flag,Var). -flag_to_var(Flag,Var):- Flag=Var. - -set_debug(Flag,Val):- \+ atom(Flag), flag_to_var(Flag,Var), atom(Var),!,set_debug(Var,Val). -set_debug(Flag,true):- !, debug(metta(Flag)),flag_to_var(Flag,Var),set_option_value(Var,true). -set_debug(Flag,false):- nodebug(metta(Flag)),flag_to_var(Flag,Var),set_option_value(Var,false). -if_trace((Flag;true),Goal):- !, notrace(( catch_err(ignore((Goal)),E,wdmsg(E-->if_trace((Flag;true),Goal))))). -if_trace(Flag,Goal):- notrace((catch_err(ignore((is_debugging(Flag),Goal)),E,wdmsg(E-->if_trace(Flag,Goal))))). - - -%maybe_efbug(SS,G):- efbug(SS,G)*-> if_trace(eval_l1t,wdmsg(SS=G)) ; fail. -maybe_efbug(_,G):- call(G). -%efbug(P1,G):- call(P1,G). -efbug(_,G):- call(G). - - - -is_debugging(Flag):- var(Flag),!,fail. -is_debugging((A;B)):- !, (is_debugging(A) ; is_debugging(B) ). -is_debugging((A,B)):- !, (is_debugging(A) , is_debugging(B) ). -is_debugging(not(Flag)):- !, \+ is_debugging(Flag). -is_debugging(Flag):- Flag== false,!,fail. -is_debugging(Flag):- Flag== true,!. -is_debugging(Flag):- debugging(metta(Flag),TF),!,TF==true. -is_debugging(Flag):- debugging(Flag,TF),!,TF==true. -is_debugging(Flag):- flag_to_var(Flag,Var), - (option_value(Var,true)->true;(Flag\==Var -> is_debugging(Var))). - -:- nodebug(metta(overflow)). - -*/ - -eval_l1t_args0(Depth,_Slf,X,Y):- Depth<1,!,X=Y, (\+ trace_on_overflow-> true; flag(eval_l1t_num,_,0),debug(metta(eval_l1t))). -eval_l1t_args0(_Dpth,_Slf,X,Y):- self_eval_l1t(X),!,Y=X. -eval_l1t_args0(Depth,Self,X,Y):- - Depth2 is Depth-1, - eval_l1t_args11(Depth,Self,X,M), - (M\=@=X ->eval_l1t_args0(Depth2,Self,M,Y);Y=X). - - - -eval_l1t_args11(_Dpth,_Slf,X,Y):- self_eval_l1t(X),!,Y=X. -eval_l1t_args11(Depth,Self,X,Y):- \+ debugging(metta(eval_l1t)),!, eval_l1t_args1(Depth,Self,X,Y). -eval_l1t_args11(Depth,Self,X,Y):- flag(eval_l1t_num,EX,EX+1), - option_else(traclen,Max,100), - (EX>Max->(nodebug(metta(eval_l1t)),write('Switched off tracing. For a longer trace !(pragma! tracelen 101))'));true), - mnotrace((no_repeats_var(YY), D1 is Depth-1)), - DR is 99-D1, - if_trace(metta(eval_l1t),indentq(Depth,'-->'(EX,Self,X,depth(DR)))), - Ret=retval(fail), - call_cleanup(( - eval_l1t_args1(D1,Self,X,Y), - mnotrace(( \+ (Y\=YY), nb_setarg(1,Ret,Y)))), - mnotrace(ignore(((Y\=@=X,if_trace(metta(eval_l1t),indentq(Depth,'<--'(EX,Ret)))))))), - (Ret\=@=retval(fail)->true;(rtrace(eval_l1t_args0(D1,Self,X,Y)),fail)). - - -:- discontiguous eval_l1t_args1/4. -:- discontiguous eval_l1t_args2/4. - -eval_l1t_args1(_Dpth,_Slf,Name,Value):- atom(Name), nb_current(Name,Value),!. - -eval_l1t_args1(Depth,Self,[V|VI],VVO):- \+ is_list(VI),!, - eval_l1t_args(Depth,Self,VI,VM), - ( VM\==VI -> eval_l1t_args(Depth,Self,[V|VM],VVO) ; - (eval_l1t_args(Depth,Self,V,VV), (V\==VV -> eval_l1t_args(Depth,Self,[VV|VI],VVO) ; VVO = [V|VI]))). - -eval_l1t_args1(_Dpth,_Slf,X,Y):- \+ is_list(X),!,Y=X. - -eval_l1t_args1(Depth,Self,[V|VI],[V|VO]):- var(V),is_list(VI),!,maplist(eval_l1t_args(Depth,Self),VI,VO). - -eval_l1t_args1(_Dpth,_Slf,['repl!'],'True'):- !, repl. -eval_l1t_args1(Depth,Self,['!',Cond],Res):- !, call(eval_l1t_args(Depth,Self,Cond,Res)). -eval_l1t_args1(Depth,Self,['rtrace',Cond],Res):- !, rtrace(eval_l1t_args(Depth,Self,Cond,Res)). -eval_l1t_args1(Depth,Self,['time',Cond],Res):- !, time(eval_l1t_args(Depth,Self,Cond,Res)). -eval_l1t_args1(Depth,Self,['print',Cond],Res):- !, eval_l1t_args(Depth,Self,Cond,Res),format('~N'),print(Res),format('~N'). -% !(println! $1) -eval_l1t_args1(Depth,Self,['println!',Cond],Res):- !, eval_l1t_args(Depth,Self,Cond,Res),format('~N'),print(Res),format('~N'). - -eval_l1t_args1(_Dpth,_Slf,List,Y):- is_list(List),maplist(self_eval_l1t,List),List=[H|_], \+ atom(H), !,Y=List. - -eval_l1t_args1(Depth,Self,['assertTrue', X],TF):- !, eval_l1t_args(Depth,Self,['assertEqual',X,'True'],TF). -eval_l1t_args1(Depth,Self,['assertFalse',X],TF):- !, eval_l1t_args(Depth,Self,['assertEqual',X,'False'],TF). - -eval_l1t_args1(Depth,Self,['assertEqual',X0,Y0],RetVal):- !, - subst_vars(X0,X),subst_vars(Y0,Y), - l1t_loonit_assert_source_tf( - ['assertEqual',X0,Y0], - (bagof_eval_l1t(Depth,Self,X,XX), - bagof_eval_l1t(Depth,Self,Y,YY)), - equal_enough_for_test(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got,XX,expected,YY]). - -eval_l1t_args1(Depth,Self,['assertNotEqual',X0,Y0],RetVal):- !, - subst_vars(X0,X),subst_vars(Y0,Y), - l1t_loonit_assert_source_tf( - ['assertNotEqual',X0,Y0], - (setof_eval_l1t(Depth,Self,X,XX), setof_eval_l1t(Depth,Self,Y,YY)), - \+ equal_enough(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got,XX,expected,not,YY]). - -eval_l1t_args1(Depth,Self,['assertEqualToResult',X0,Y0],RetVal):- !, - subst_vars(X0,X),subst_vars(Y0,Y), - l1t_loonit_assert_source_tf( - ['assertEqualToResult',X0,Y0], - (bagof_eval_l1t(Depth,Self,X,XX), =(Y,YY)), - equal_enough_for_test(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got,XX,expected,YY]),!. - - -l1t_loonit_assert_source_tf(Src,Goal,Check,TF):- - copy_term(Goal,OrigGoal), - l1t_loonit_asserts(Src, time_eval('\n; EVAL TEST\n;',Goal), Check), - as_tf(Check,TF),!, - ignore(( - once((TF='True', is_debugging(pass));(TF='False', is_debugging(fail))), - with_debug((eval_l1t),time_eval('Trace',OrigGoal)))). - -l1t_loonit_asserts(Src,Goal,Check):- - loonit_asserts(Src,Goal,Check). - - -/* -sort_result(Res,Res):- \+ compound(Res),!. -sort_result([And|Res1],Res):- is_and(And),!,sort_result(Res1,Res). -sort_result([T,And|Res1],Res):- is_and(And),!,sort_result([T|Res1],Res). -sort_result([H|T],[HH|TT]):- !, sort_result(H,HH),sort_result(T,TT). -sort_result(Res,Res). - -unify_enough(L,L):-!. -unify_enough(L,C):- is_list(L),into_list_args(C,CC),!,unify_lists(CC,L). -unify_enough(C,L):- is_list(L),into_list_args(C,CC),!,unify_lists(CC,L). -unify_enough(C,L):- \+ compound(C),!,L=C. -unify_enough(L,C):- \+ compound(C),!,L=C. -unify_enough(L,C):- into_list_args(L,LL),into_list_args(C,CC),!,unify_lists(CC,LL). - -unify_lists(C,L):- \+ compound(C),!,L=C. -unify_lists(L,C):- \+ compound(C),!,L=C. -unify_lists([C|CC],[L|LL]):- unify_enough(L,C),!,unify_lists(CC,LL). - -equal_enough(R,V):- is_list(R),is_list(V),sort(R,RR),sort(V,VV),!,equal_enouf(RR,VV),!. -equal_enough(R,V):- copy_term(R,RR),copy_term(V,VV),equal_enouf(R,V),!,R=@=RR,V=@=VV. - -equal_enough_for_test(X,Y):- must_det_ll((subst_vars(X,XX),subst_vars(Y,YY))),!,equal_enough(XX,YY),!. - -equal_enouf(R,V):- R=@=V, !. -equal_enouf(_,V):- V=@='...',!. -equal_enouf(L,C):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). -equal_enouf(C,L):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). -%equal_enouf(R,V):- (var(R),var(V)),!, R=V. -equal_enouf(R,V):- (var(R);var(V)),!, R==V. -equal_enouf(R,V):- number(R),number(V),!, RV is abs(R-V), RV < 0.03 . -equal_enouf(R,V):- atom(R),!,atom(V), has_unicode(R),has_unicode(V). -equal_enouf(R,V):- (\+ compound(R) ; \+ compound(V)),!, R==V. -equal_enouf(L,C):- into_list_args(L,LL),into_list_args(C,CC),!,equal_enouf_l(CC,LL). - -equal_enouf_l(C,L):- \+ compound(C),!,L=@=C. -equal_enouf_l(L,C):- \+ compound(C),!,L=@=C. -equal_enouf_l([C|CC],[L|LL]):- !, equal_enouf(L,C),!,equal_enouf_l(CC,LL). - - -has_unicode(A):- atom_codes(A,Cs),member(N,Cs),N>127,!. -set_last_error(_). - -*/ - -eval_l1t_args1(Depth,Self,['match',Other,Goal,Template],Template):- into_space(Self,Other,Space),!, metta_atom_iter_l1t(Depth,Space,Goal). -eval_l1t_args1(Depth,Self,['match',Other,Goal,Template,Else],Template):- - (eval_l1t_args1(Depth,Self,['match',Other,Goal,Template],Template)*->true;Template=Else). - -% Macro: case -eval_l1t_args1(Depth,Self,X,Res):- - X= [CaseSym,A,CL],CaseSym == 'case', !, - into_case_l1t_list(CL,CASES), - findall(Key-Value, - (nth0(Nth,CASES,Case0), - (is_case_l1t(Key,Case0,Value), - if_trace((case),(format('~N'), - writeqln(c(Nth,Key)=Value))))),KVs),!, - ((eval_l1t_args(Depth,Self,A,AA), if_trace((case),writeqln(switch=AA)), - (select_case_l1t(Depth,Self,AA,KVs,Value)->true;(member(Void -Value,KVs),Void=='%void%'))) - *->true;(member(Void -Value,KVs),Void=='%void%')), - eval_l1t_args(Depth,Self,Value,Res). - - select_case_l1t(Depth,Self,AA,Cases,Value):- - (best_key_l1t(AA,Cases,Value) -> true ; - (maybe_special_key_l1ts(Depth,Self,Cases,CasES), - (best_key_l1t(AA,CasES,Value) -> true ; - (member(Void -Value,CasES),Void=='%void%')))). - - best_key_l1t(AA,Cases,Value):- - ((member(Match-Value,Cases),unify_enough(AA,Match))->true; - ((member(Match-Value,Cases),AA ==Match)->true; - ((member(Match-Value,Cases),AA=@=Match)->true; - (member(Match-Value,Cases),AA = Match)))). - - %into_case_l1t_list([[C|ASES0]],CASES):- is_list(C),!, into_case_l1t_list([C|ASES0],CASES),!. - into_case_l1t_list(CASES,CASES):- is_list(CASES),!. - is_case_l1t(AA,[AA,Value],Value):-!. - is_case_l1t(AA,[AA|Value],Value). - - maybe_special_key_l1ts(Depth,Self,[K-V|KVI],[AK-V|KVO]):- - eval_l1t_args(Depth,Self,K,AK), K\=@=AK,!, - maybe_special_key_l1ts(Depth,Self,KVI,KVO). - maybe_special_key_l1ts(Depth,Self,[_|KVI],KVO):- - maybe_special_key_l1ts(Depth,Self,KVI,KVO). - maybe_special_key_l1ts(_Depth,_Self,[],[]). - - -%[collapse,[1,2,3]] -eval_l1t_args1(Depth,Self,['collapse',List],Res):-!, bagof_eval_l1t(Depth,Self,List,Res). -%[superpose,[1,2,3]] -eval_l1t_args1(Depth,Self,['superpose',List],Res):- !, member(E,List),eval_l1t_args(Depth,Self,E,Res). -get_l1t_sa_p1(P3,E,Cmpd,SA):- compound(Cmpd), get_l1t_sa_p2(P3,E,Cmpd,SA). -get_l1t_sa_p2(P3,E,Cmpd,call(P3,N1,Cmpd)):- arg(N1,Cmpd,E). -get_l1t_sa_p2(P3,E,Cmpd,SA):- arg(_,Cmpd,Arg),get_l1t_sa_p1(P3,E,Arg,SA). -eval_l1t_args1(Depth,Self, Term, Res):- fail, - mnotrace(( get_l1t_sa_p1(setarg,ST,Term,P1), % ST\==Term, - compound(ST), ST = [F,List],F=='superpose',nonvar(List), %maplist(atomic,List), - call(P1,Var))), !, - %max_counting(F,20), - member(Var,List), - eval_l1t_args(Depth,Self, Term, Res). - -/* - -sub_sterm(Sub,Sub). -sub_sterm(Sub,Term):- sub_sterm1(Sub,Term). -sub_sterm1(_ ,List):- \+ compound(List),!,fail. -sub_sterm1(Sub,List):- is_list(List),!,member(SL,List),sub_sterm(Sub,SL). -sub_sterm1(_ ,[_|_]):-!,fail. -sub_sterm1(Sub,Term):- arg(_,Term,SL),sub_sterm(Sub,SL). -*/ - - - -eval_l1t_args1(Depth,Self, Term, Res):- - mnotrace(( get_l1t_sa_p1(setarg,ST,Term,P1), - compound(ST), ST = [F,List],F=='collapse',nonvar(List), %maplist(atomic,List), - call(P1,Var))), !, setof_eval_l1t(Depth,Self,List,Var), - eval_l1t_args(Depth,Self, Term, Res). - - -%max_counting(F,Max):- flag(F,X,X+1), X true; (flag(F,_,10),!,fail). - - -eval_l1t_args1(Depth,Self,['if',Cond,Then],Res):- !, - eval_l1t_args(Depth,Self,Cond,TF), - (is_True(TF) -> eval_l1t_args(Depth,Self,Then,Res) ; Res = []). - -eval_l1t_args1(Depth,Self,['if',Cond,Then,Else],Res):- !, - eval_l1t_args(Depth,Self,Cond,TF), - (is_True(TF) -> eval_l1t_args(Depth,Self,Then,Res);eval_l1t_args(Depth,Self,Else,Res)). - -eval_l1t_args1(_Dpth,_Slf,[_,Nothing],Nothing):- 'Nothing'==Nothing,!. - -eval_l1t_args1(Depth,Self,['let',A,A5,AA],OO):- !, - %(var(A)->true;trace), - ((eval_l1t_args(Depth,Self,A5,AE), AE=A)), - eval_l1t_args(Depth,Self,AA,OO). -%eval_l1t_args1(Depth,Self,['let',A,A5,AA],AAO):- !,eval_l1t_args(Depth,Self,A5,A),eval_l1t_args(Depth,Self,AA,AAO). -eval_l1t_args1(Depth,Self,['let*',[],Body],RetVal):- !, eval_l1t_args(Depth,Self,Body,RetVal). -eval_l1t_args1(Depth,Self,['let*',[[Var,Val]|LetRest],Body],RetVal):- !, - eval_l1t_args1(Depth,Self,['let',Var,Val,['let*',LetRest,Body]],RetVal). - -eval_l1t_args1(Depth,Self,['colapse'|List], Flat):- !, maplist(eval_l1t_args(Depth,Self),List,Res),flatten(Res,Flat). -eval_l1t_args1(Depth,Self,['get-atoms',Other],PredDecl):- !,into_space(Self,Other,Space), metta_atom_iter_l1t(Depth,Space,PredDecl). -eval_l1t_args1(_Dpth,_Slf,['car-atom',Atom],CAR):- !, Atom=[CAR|_],!. -eval_l1t_args1(_Dpth,_Slf,['cdr-atom',Atom],CDR):- !, Atom=[_|CDR],!. - -eval_l1t_args1(Depth,Self,['Cons', A, B ],['Cons', AA, BB]):- no_cons_reduce, !, - eval_l1t_args(Depth,Self,A,AA), eval_l1t_args(Depth,Self,B,BB). - -eval_l1t_args1(Depth,Self,['Cons', A, B ],[AA|BB]):- \+ no_cons_reduce, !, - eval_l1t_args(Depth,Self,A,AA), eval_l1t_args(Depth,Self,B,BB). - - -eval_l1t_args1(Depth,Self,['change-state!',StateExpr, UpdatedValue], Ret):- !, eval_l1t_args(Depth,Self,StateExpr,StateMonad), - eval_l1t_args(Depth,Self,UpdatedValue,Value), 'change-state!'(Depth,Self,StateMonad, Value, Ret). -eval_l1t_args1(Depth,Self,['new-state',UpdatedValue],StateMonad):- !, - eval_l1t_args(Depth,Self,UpdatedValue,Value), 'new-state'(Depth,Self,Value,StateMonad). -eval_l1t_args1(Depth,Self,['get-state',StateExpr],Value):- !, - eval_l1t_args(Depth,Self,StateExpr,StateMonad), 'get-state'(StateMonad,Value). - - - -% eval_l1t_args1(Depth,Self,['get-state',Expr],Value):- !, eval_l1t_args(Depth,Self,Expr,State), arg(1,State,Value). - - - -% check_type:- option_else(typecheck,TF,'False'), TF=='True'. - -:- dynamic is_registered_state/1. -:- flush_output. -:- setenv('RUST_BACKTRACE',full). - -/* -% Function to check if an value is registered as a state name -:- dynamic(is_registered_state/1). - -is_nb_state(G):- is_valid_nb_state(G) -> true ; - is_registered_state(G),nb_current(G,S),is_valid_nb_state(S). - - -:- multifile(state_type_method/3). -:- dynamic(state_type_method/3). -space_type_method(is_nb_state,new_space,init_state). -space_type_method(is_nb_state,clear_space,clear_nb_values). -space_type_method(is_nb_state,add_atom,add_nb_value). -space_type_method(is_nb_state,remove_atom,'change-state!'). -space_type_method(is_nb_state,replace_atom,replace_nb_value). -space_type_method(is_nb_state,atom_count,value_nb_count). -space_type_method(is_nb_state,get_atoms,'get-state'). -space_type_method(is_nb_state,atom_iter,value_nb_iter). - -state_type_method(is_nb_state,new_state,init_state). -state_type_method(is_nb_state,clear_state,clear_nb_values). -state_type_method(is_nb_state,add_value,add_nb_value). -state_type_method(is_nb_state,remove_value,'change-state!'). -state_type_method(is_nb_state,replace_value,replace_nb_value). -state_type_method(is_nb_state,value_count,value_nb_count). -state_type_method(is_nb_state,'get-state','get-state'). -state_type_method(is_nb_state,value_iter,value_nb_iter). -%state_type_method(is_nb_state,query,state_nb_query). - -% Clear all values from a state -clear_nb_values(StateNameOrInstance) :- - fetch_or_create_state(StateNameOrInstance, State), - nb_setarg(1, State, []). - - - -% Function to confirm if a term represents a state -is_valid_nb_state(State):- compound(State),functor(State,'State',_). - -% Find the original name of a given state -state_original_name(State, Name) :- - is_registered_state(Name), - nb_current(Name, State). - -% Register and initialize a new state -init_state(Name) :- - State = 'State'(_,_), - asserta(is_registered_state(Name)), - nb_setval(Name, State). - -% Change a value in a state -'change-state!'(Depth,Self,StateNameOrInstance, UpdatedValue, Out) :- - fetch_or_create_state(StateNameOrInstance, State), - arg(2, State, Type), - ( (check_type,\+ get_type(Depth,Self,UpdatedValue,Type)) - -> (Out = ['Error', UpdatedValue, 'BadType']) - ; (nb_setarg(1, State, UpdatedValue), Out = State) ). - -% Fetch all values from a state -'get-state'(StateNameOrInstance, Values) :- - fetch_or_create_state(StateNameOrInstance, State), - arg(1, State, Values). - -'new-state'(Depth,Self,Init,'State'(Init, Type)):- check_type->get_type(Depth,Self,Init,Type);true. - -'new-state'(Init,'State'(Init, Type)):- check_type->get_type(10,'&self',Init,Type);true. - -fetch_or_create_state(Name):- fetch_or_create_state(Name,_). -% Fetch an existing state or create a new one - -fetch_or_create_state(State, State) :- is_valid_nb_state(State),!. -fetch_or_create_state(NameOrInstance, State) :- - ( atom(NameOrInstance) - -> (is_registered_state(NameOrInstance) - -> nb_current(NameOrInstance, State) - ; init_state(NameOrInstance), - nb_current(NameOrInstance, State)) - ; is_valid_nb_state(NameOrInstance) - -> State = NameOrInstance - ; writeln('Error: Invalid input.') - ), - is_valid_nb_state(State). - -*/ - -eval_l1t_args1(Depth,Self,['get-type',Val],Type):- !, get_type(Depth,Self,Val,Type),ground(Type),Type\==[], Type\==Val,!. - -% mnotrace(G):- once(G). -/* -is_decl_type(ST):- metta_type(_,_,Type),sub_term(T,Type),T=@=ST, \+ nontype(ST). -is_type(Type):- nontype(Type),!,fail. -is_type(Type):- is_decl_type(Type). -is_type(Type):- atom(Type). - -nontype(Type):- var(Type),!. -nontype('->'). -nontype(N):- number(N). - -needs_eval_l1t(EvalMe):- is_list(EvalMe),!. - -get_type(_Dpth,_Slf,Var,'%Undefined%'):- var(Var),!. -get_type(_Dpth,_Slf,Val,'Number'):- number(Val),!. -get_type(Depth,Self,Expr,['StateMonad',Type]):- is_valid_nb_state(Expr),'get-state'(Expr,Val),!, - get_type(Depth,Self,Val,Type). - - -get_type(Depth,Self,EvalMe,Type):- needs_eval_l1t(EvalMe),eval_l1t_args(Depth,Self,EvalMe,Val), \+ needs_eval_l1t(Val),!, - get_type(Depth,Self,Val,Type). - -get_type(_Dpth,Self,[Fn|_],Type):- symbol(Fn),metta_type(Self,Fn,List),last_element(List,Type), nonvar(Type), - is_type(Type). -get_type(_Dpth,Self,List,Type):- is_list(List),metta_type(Self,List,LType),last_element(LType,Type), nonvar(Type), - is_type(Type). - -get_type(Depth,_Slf,Type,Type):- Depth<1,!. -get_type(_Dpth,Self,List,Type):- is_list(List),metta_type(Self,Type,['->'|List]). -get_type(Depth,Self,List,Types):- List\==[], is_list(List),Depth2 is Depth-1,maplist(get_type(Depth2,Self),List,Types). -get_type(_Dpth,Self,Fn,Type):- symbol(Fn),metta_type(Self,Fn,Type),!. -%get_type(Depth,Self,Fn,Type):- nonvar(Fn),metta_type(Self,Fn,Type2),Depth2 is Depth-1,get_type(Depth2,Self,Type2,Type). -%get_type(Depth,Self,Fn,Type):- Depth>0,nonvar(Fn),metta_type(Self,Type,Fn),!. %,!,last_element(List,Type). - -get_type(Depth,Self,Expr,Type):-Depth2 is Depth-1, eval_l1t_args(Depth2,Self,Expr,Val),Expr\=@=Val,get_type(Depth2,Self,Val,Type). - - -get_type(_Dpth,_Slf,Val,'String'):- string(Val),!. -get_type(_Dpth,_Slf,Val,Type):- is_decl_type(Val),Type=Val. -get_type(_Dpth,_Slf,Val,'Bool'):- (Val=='False';Val=='True'),!. -get_type(_Dpth,_Slf,Val,'Symbol'):- symbol(Val). -%get_type(Depth,Self,[T|List],['List',Type]):- Depth2 is Depth-1, is_list(List),get_type(Depth2,Self,T,Type),!, -% forall((member(Ele,List),nonvar(Ele)),get_type(Depth2,Self,Ele,Type)),!. -%get_type(Depth,_Slf,Cmpd,Type):- compound(Cmpd), functor(Cmpd,Type,1),!. -get_type(_Dpth,_Slf,Cmpd,Type):- \+ ground(Cmpd),!,Type=[]. -get_type(_Dpth,_Slf,_,'%Undefined%'):- fail. -*/ - -eval_l1t_args1(Depth,Self,['length',L],Res):- !, eval_l1t_args(Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). -eval_l1t_args1(Depth,Self,['CountElement',L],Res):- !, eval_l1t_args(Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). - -/* - -is_feo_f('Cons'). - -is_seo_f('{...}'). -is_seo_f('[...]'). -is_seo_f('{}'). -is_seo_f('[]'). -is_seo_f('StateMonad'). -is_seo_f('State'). -is_seo_f('Event'). -is_seo_f('Concept'). -is_seo_f(N):- number(N),!. - -*/ - -/* -eval_l1t_args1(Depth,Self,[F,A|Args],Res):- - \+ self_eval_l1t(A), - eval_l1t_args(Depth,Self,A,AA),AA\==A, - eval_l1t_args(Depth,Self,[F,AA|Args],Res). - - -eval_l1t_args1(Depth,Self,[F,A1|AArgs],Res):- fail, member(F,['+']), - cwdl(40,(( - append(L,[A|R],AArgs), - \+ self_eval_l1t(A), - eval_l1t_args(Depth,Self,A,AA),AA\==A,!, - append(L,[AA|R],NewArgs), eval_l1t_args(Depth,Self,[F,A1|NewArgs],Res)))). -*/ - -/* %% - -% !(assertEqualToResult ((inc) 2) (3)) -eval_l1t_args1(Depth,Self,[F|Args],Res):- is_list(F), - metta_atom_iter_l1t(Depth,Self,['=',F,R]), eval_l1t_args(Depth,Self,[R|Args],Res). - -eval_l1t_args1(Depth,Self,[F|Args],Res):- is_list(F), Args\==[], - append(F,Args,FArgs),!,eval_l1t_args(Depth,Self,FArgs,Res). -*/ -eval_l1t_args1(_Dpth,Self,['import!',Other,File],RetVal):- into_space(Self,Other,Space),!, include_metta(Space,File),!,return_empty(Space,RetVal). %RetVal=[]. -eval_l1t_args1(Depth,Self,['bind!',Other,Expr],RetVal):- - into_name(Self,Other,Name),!,eval_l1t_args(Depth,Self,Expr,Value),nb_setval(Name,Value), return_empty(Value,RetVal). -eval_l1t_args1(Depth,Self,['pragma!',Other,Expr],RetVal):- - into_name(Self,Other,Name),!,eval_l1t_args(Depth,Self,Expr,Value),set_option_value(Name,Value), return_empty(Value,RetVal). -eval_l1t_args1(_Dpth,Self,['transfer!',File],RetVal):- !, include_metta(Self,File), return_empty(Self,RetVal). - - - -eval_l1t_args1(Depth,Self,['nop',Expr],Empty):- !, eval_l1t_args(Depth,Self,Expr,_), return_empty([],Empty). - -/* -is_True(T):- T\=='False',T\=='F',T\==[]. - -is_and(S):- \+ atom(S),!,fail. -is_and('#COMMA'). is_and(','). is_and('and'). is_and('And'). -*/ -eval_l1t_args1(_Dpth,_Slf,[And],'True'):- is_and(And),!. -eval_l1t_args1(Depth,Self,['and',X,Y],TF):- !, as_tf((eval_l1t_args(Depth,Self,X,'True'),eval_l1t_args(Depth,Self,Y,'True')),TF). -eval_l1t_args1(Depth,Self,[And,X|Y],TF):- is_and(And),!,eval_l1t_args(Depth,Self,X,TF1), - is_True(TF1),eval_l1t_args1(Depth,Self,[And|Y],TF). -%eval_l1t_args2(Depth,Self,[H|T],_):- \+ is_list(T),!,fail. -eval_l1t_args1(Depth,Self,['or',X,Y],TF):- !, as_tf((eval_l1t_args(Depth,Self,X,'True');eval_l1t_args(Depth,Self,Y,'True')),TF). - - - -eval_l1t_args1(_Dpth,Self,['add-atom',Other,PredDecl],TF):- !, into_space(Self,Other,Space), as_tf(do_metta(Space,load,PredDecl),TF). -eval_l1t_args1(_Dpth,Self,['remove-atom',Other,PredDecl],TF):- !, into_space(Self,Other,Space), as_tf(do_metta(Space,unload,PredDecl),TF). -eval_l1t_args1(_Dpth,Self,['atom-count',Other],Count):- !, into_space(Self,Other,Space), findall(_,metta_defn(Expander,Other,_,_),L1),length(L1,C1),findall(_,metta_atom(Space,_),L2),length(L2,C2),Count is C1+C2. -eval_l1t_args1(_Dpth,Self,['atom-replace',Other,Rem,Add],TF):- !, into_space(Self,Other,Space), copy_term(Rem,RCopy), - as_tf((metta_atom_iter_l1t_ref(Space,RCopy,Ref), RCopy=@=Rem,erase(Ref), do_metta(Other,load,Add)),TF). - - -eval_l1t_args1(Depth,Self,['+',N1,N2],N):- number(N1),!, - eval_l1t_args(Depth,Self,N2,N2Res), catch_err(N is N1+N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail)). -eval_l1t_args1(Depth,Self,['-',N1,N2],N):- number(N1),!, - eval_l1t_args(Depth,Self,N2,N2Res), catch_err(N is N1-N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail)). - -eval_l1t_args1(Depth,Self,[V|VI],[V|VO]):- nonvar(V),is_metta_data_functor(V),is_list(VI),!,maplist(eval_l1t_args(Depth,Self),VI,VO). - -eval_l1t_args1(Depth,Self,X,Y):- - (eval_l1t_args2(Depth,Self,X,Y)*->true; - (eval_l1t_args2_failed(Depth,Self,X,Y)*->true;X=Y)). - - -eval_l1t_args2_failed(_Dpth,_Slf,T,TT):- T==[],!,TT=[]. -eval_l1t_args2_failed(_Dpth,_Slf,T,TT):- var(T),!,TT=T. -eval_l1t_args2_failed(_Dpth,_Slf,[F|LESS],Res):- once(eval_l1t_selfless([F|LESS],Res)),mnotrace([F|LESS]\==Res),!. -%eval_l1t_args2_failed(Depth,Self,[V|Nil],[O]):- Nil==[], once(eval_l1t_args(Depth,Self,V,O)),V\=@=O,!. -eval_l1t_args2_failed(Depth,Self,[H|T],[HH|TT]):- !, - eval_l1t_args(Depth,Self,H,HH), - eval_l1t_args2_failed(Depth,Self,T,TT). - -eval_l1t_args2_failed(Depth,Self,T,TT):- eval_l1t_args(Depth,Self,T,TT). - - %eval_l1t_args(Depth,Self,X,Y):- eval_l1t_args1(Depth,Self,X,Y)*->true;Y=[]. - -%eval_l1t_args1(Depth,_,_,_):- Depth<1,!,fail. -%eval_l1t_args1(Depth,_,X,Y):- Depth<3, !, ground(X), (Y=X). -%eval_l1t_args1(_Dpth,_Slf,X,Y):- self_eval_l1t(X),!,Y=X. - -% Kills zero arity functions eval_l1t_args1(Depth,Self,[X|Nil],[Y]):- Nil ==[],!,eval_l1t_args(Depth,Self,X,Y). - - -/* -into_values(List,Many):- List==[],!,Many=[]. -into_values([X|List],Many):- List==[],is_list(X),!,Many=X. -into_values(Many,Many). -eval_l1t_args2(_Dpth,_Slf,Name,Value):- atom(Name), nb_current(Name,Value),!. -*/ -% Macro Functions -%eval_l1t_args1(Depth,_,_,_):- Depth<1,!,fail. -eval_l1t_args2(Depth,_,X,Y):- Depth<3, !, fail, ground(X), (Y=X). -eval_l1t_args2(Depth,Self,[F|PredDecl],Res):- - Depth>1, - mnotrace((sub_sterm1(SSub,PredDecl), ground(SSub),SSub=[_|Sub], is_list(Sub), maplist(atomic,SSub))), - eval_l1t_args(Depth,Self,SSub,Repl), - mnotrace((SSub\=Repl, subst(PredDecl,SSub,Repl,Temp))), - eval_l1t_args(Depth,Self,[F|Temp],Res). - - - -% user defined function -eval_l1t_args2(Depth,Self,[H|PredDecl],Res):- mnotrace(is_user_defined_head(Self,H)),!, - eval_l1t_args30(Depth,Self,[H|PredDecl],Res). - -% function inherited by system -eval_l1t_args2(Depth,Self,PredDecl,Res):- eval_l1t_args40(Depth,Self,PredDecl,Res). - -/* -last_element(T,E):- \+ compound(T),!,E=T. -last_element(T,E):- is_list(T),last(T,L),last_element(L,E),!. -last_element(T,E):- compound_name_arguments(T,_,List),last_element(List,E),!. - - - - -%catch_warn(G):- notrace(catch_err(G,E,(wdmsg(catch_warn(G)-->E),fail))). -%catch_nowarn(G):- notrace(catch_err(G,error(_,_),fail)). - -%as_tf(G,TF):- catch_nowarn((call(G)*->TF='True';TF='False')). -*/ -eval_l1t_selfless(['==',X,Y],TF):- as_tf(X=:=Y,TF),!. -eval_l1t_selfless(['==',X,Y],TF):- as_tf(X=@=Y,TF),!. -eval_l1t_selfless(['=',X,Y],TF):-!,as_tf(X=Y,TF). -eval_l1t_selfless(['>',X,Y],TF):-!,as_tf(X>Y,TF). -eval_l1t_selfless(['<',X,Y],TF):-!,as_tf(X',X,Y],TF):-!,as_tf(X>=Y,TF). -eval_l1t_selfless(['<=',X,Y],TF):-!,as_tf(X= Bool Atom Atom)) -(= (ift True $then) $then) - -; For anything that is green, assert it is Green in &kb22 -!(ift (green $x) - (add-atom &kb22 (Green $x))) - -; Retrieve the inferred Green things: Fritz and Sam. -!(assertEqualToResult - (match &kb22 (Green $x) $x) - (Fritz Sam)) -*/ -:- discontiguous eval_l1t_args3/4. -%eval_l1t_args2(Depth,Self,PredDecl,Res):- eval_l1t_args3(Depth,Self,PredDecl,Res). - -%eval_l1t_args2(_Dpth,_Slf,L1,Res):- is_list(L1),maplist(self_eval_l1t,L1),!,Res=L1. -%eval_l1t_args2(_Depth,_Self,X,X). - -/* -is_user_defined_head(Other,H):- mnotrace(is_user_defined_head0(Other,H)). -is_user_defined_head0(Other,[H|_]):- !, nonvar(H),!, is_user_defined_head_f(Other,H). -is_user_defined_head0(Other,H):- callable(H),!,functor(H,F,_), is_user_defined_head_f(Other,F). -is_user_defined_head0(Other,H):- is_user_defined_head_f(Other,H). - -is_user_defined_head_f(Other,H):- is_user_defined_head_f1(Other,H). -is_user_defined_head_f(Other,H):- is_user_defined_head_f1(Other,[H|_]). - -%is_user_defined_head_f1(Other,H):- metta_type(Other,H,_). -is_user_defined_head_f1(Other,H):- metta_atom(Other,[H|_]). -is_user_defined_head_f1(Other,H):- metta_defn(Expander,Other,[H|_],_). -%is_user_defined_head_f(_,H):- is_metta_builtin(H). - - -is_special_op(F):- \+ atom(F), \+ var(F), !, fail. -is_special_op('case'). -is_special_op(':'). -is_special_op('='). -is_special_op('->'). -is_special_op('let'). -is_special_op('let*'). -is_special_op('if'). -is_special_op('rtrace'). -is_special_op('or'). -is_special_op('and'). -is_special_op('not'). -is_special_op('match'). -is_special_op('call'). -is_special_op('let'). -is_special_op('let*'). -is_special_op('nop'). -is_special_op('assertEqual'). -is_special_op('assertEqualToResult'). - -is_metta_builtin(Special):- is_special_op(Special). -is_metta_builtin('=='). -is_metta_builtin(F):- once(atom(F);var(F)), current_op(_,yfx,F). -is_metta_builtin('println!'). -is_metta_builtin('transfer!'). -is_metta_builtin('collapse'). -is_metta_builtin('superpose'). -is_metta_builtin('+'). -is_metta_builtin('-'). -is_metta_builtin('*'). -is_metta_builtin('/'). -is_metta_builtin('%'). -is_metta_builtin('=='). -is_metta_builtin('<'). -is_metta_builtin('>'). -is_metta_builtin('all'). -is_metta_builtin('import!'). -is_metta_builtin('pragma!'). -*/ - - -eval_l1t_args30(Depth,Self,H,B):- (eval_l1t_args34(Depth,Self,H,B)*->true;eval_l1t_args37(Depth,Self,H,B)). - -eval_l1t_args34(_Dpth,Self,H,B):- (metta_defn(Expander,Self,H,B);(metta_atom(Self,H),B='True')). - -% Has argument that is headed by the same function -eval_l1t_args37(Depth,Self,[H1|Args],Res):- - mnotrace((append(Left,[[H2|H2Args]|Rest],Args), H2==H1)),!, - eval_l1t_args(Depth,Self,[H2|H2Args],ArgRes), - mnotrace((ArgRes\==[H2|H2Args], append(Left,[ArgRes|Rest],NewArgs))), - eval_l1t_args30(Depth,Self,[H1|NewArgs],Res). - -eval_l1t_args37(Depth,Self,[[H|Start]|T1],Y):- - mnotrace((is_user_defined_head_f(Self,H),is_list(Start))), - metta_defn(Expander,Self,[H|Start],Left), - eval_l1t_args(Depth,Self,[Left|T1],Y). - -% Has subterm to eval_l1t -eval_l1t_args37(Depth,Self,[F|PredDecl],Res):- - Depth>1, - quietly(sub_sterm1(SSub,PredDecl)), - mnotrace((ground(SSub),SSub=[_|Sub], is_list(Sub),maplist(atomic,SSub))), - eval_l1t_args(Depth,Self,SSub,Repl), - mnotrace((SSub\=Repl,subst(PredDecl,SSub,Repl,Temp))), - eval_l1t_args30(Depth,Self,[F|Temp],Res). - -%eval_l1t_args37(Depth,Self,X,Y):- (eval_l1t_args38(Depth,Self,X,Y)*->true;metta_atom_iter_l1t(Depth,Self,[=,X,Y])). - -eval_l1t_args37(Depth,Self,PredDecl,Res):- fail, - ((term_variables(PredDecl,Vars), - (metta_atom(Self,PredDecl) *-> (Vars ==[]->Res='True';Vars=Res); - (eval_l1t_args(Depth,Self,PredDecl,Res),ignore(Vars ==[]->Res='True';Vars=Res))))), - PredDecl\=@=Res. - -eval_l1t_args38(_Dpth,Self,[H|_],_):- mnotrace( \+ is_user_defined_head_f(Self,H) ), !,fail. -eval_l1t_args38(_Dpth,Self,[H|T1],Y):- metta_defn(Expander,Self,[H|T1],Y). -eval_l1t_args38(_Dpth,Self,[H|T1],'True'):- metta_atom(Self,[H|T1]). -eval_l1t_args38(_Dpth,Self,CALL,Y):- fail,append(Left,[Y],CALL),metta_defn(Expander,Self,Left,Y). - - -%eval_l1t_args3(Depth,Self,['ift',CR,Then],RO):- fail, !, %fail, % trace, -% metta_defn(Expander,Self,['ift',R,Then],Become),eval_l1t_args(Depth,Self,CR,R),eval_l1t_args(Depth,Self,Then,_True),eval_l1t_args(Depth,Self,Become,RO). - -metta_atom_iter_l1t(_Dpth,Other,[Equal,H,B]):- '=' == Equal,!, - (metta_defn(Expander,Other,H,B)*->true;(metta_atom(Other,H),B='True')). - -metta_atom_iter_l1t(Depth,_,_):- Depth<3,!,fail. -metta_atom_iter_l1t(_Dpth,_Slf,[]):-!. -metta_atom_iter_l1t(_Dpth,Other,H):- metta_atom(Other,H). -metta_atom_iter_l1t(Depth,Other,H):- D2 is Depth -1, metta_defn(Expander,Other,H,B),metta_atom_iter_l1t(D2,Other,B). -metta_atom_iter_l1t(_Dpth,_Slf,[And]):- is_and(And),!. -metta_atom_iter_l1t(Depth,Self,[And,X|Y]):- is_and(And),!,D2 is Depth -1, metta_atom_iter_l1t(D2,Self,X),metta_atom_iter_l1t(D2,Self,[And|Y]). -/* -metta_atom_iter_l1t2(_,Self,[=,X,Y]):- metta_defn(Expander,Self,X,Y). -metta_atom_iter_l1t2(_Dpth,Other,[Equal,H,B]):- '=' == Equal,!, metta_defn(Expander,Other,H,B). -metta_atom_iter_l1t2(_Dpth,Self,X,Y):- metta_defn(Expander,Self,X,Y). %, Y\=='True'. -metta_atom_iter_l1t2(_Dpth,Self,X,Y):- metta_atom(Self,[=,X,Y]). %, Y\=='True'. - -*/ -metta_atom_iter_l1t_ref(Other,['=',H,B],Ref):-clause(metta_defn(Expander,Other,H,B),true,Ref). -metta_atom_iter_l1t_ref(Other,H,Ref):-clause(metta_atom(Other,H),true,Ref). - -%not_compound(Term):- \+ is_list(Term),!. -%eval_l1t_args2(Depth,Self,Term,Res):- maplist(not_compound,Term),!,eval_l1t_args345(Depth,Self,Term,Res). - - -% function inherited by system -eval_l1t_args40(Depth,Self,[F|X],FY):- is_function(F), \+ is_special_op(F), is_list(X), - maplist(eval_l1t_args(Depth,Self),X,Y),!,eval_l1t_args5(Depth,Self,[F|Y],FY). -eval_l1t_args40(Depth,Self,FX,FY):- eval_l1t_args5(Depth,Self,FX,FY). - -eval_l1t_args5(_Dpth,_Slf,[F|LESS],Res):- once(eval_l1t_selfless([F|LESS],Res)),mnotrace(([F|LESS]\==Res)),!. -eval_l1t_args5(Depth,Self,[AE|More],TF):- length(More,Len), - (is_syspred(AE,Len,Pred),catch_warn(as_tf(apply(Pred,More),TF)))*->true;eval_l1t_args6(Depth,Self,[AE|More],TF). -eval_l1t_args6(_Dpth,_Slf,[AE|More],TF):- length([AE|More],Len), is_syspred(AE,Len,Pred),append(More,[TF],Args),!,catch_warn(apply(Pred,Args)). - -%eval_l1t_args40(Depth,Self,[X1|[F2|X2]],[Y1|Y2]):- is_function(F2),!,eval_l1t_args(Depth,Self,[F2|X2],Y2),eval_l1t_args(Depth,Self,X1,Y1). - - -%cwdl(DL,Goal):- call_with_depth_limit(Goal,DL,R), (R==depth_limit_exceeded->(!,fail);true). -bagof_eval_l1t(Depth,Self,X,L):- !,findall(E,eval_l1t_args(Depth,Self,X,E),L). -setof_eval_l1t(Depth,Self,X,S):- !,findall(E,eval_l1t_args(Depth,Self,X,E),L),sort(L,S). -%setof_eval_l1t(Depth,Self,X,S):- setof(E,eval_l1t_args(Depth,Self,X,E),S)*->true;S=[]. - - diff --git a/.Attic/metta_lang/metta_test_nars_1.pl b/.Attic/metta_lang/metta_test_nars_1.pl deleted file mode 100755 index 9199e2d49e0..00000000000 --- a/.Attic/metta_lang/metta_test_nars_1.pl +++ /dev/null @@ -1,1752 +0,0 @@ -% (track_load_into_file "../../examples/VRUN_tests1.metta") -:-metta_eval(['extend-py!',mettalog]). - -%;; stdlib extension -metta_type('&self','If',[->,'Bool','Atom','Atom']). - -metta_defn_ES(['If','True',Then],Then). - -metta_defn_ES(['If','False',Then],[]). - -metta_type('&self','If',[->,'Bool','Atom','Atom','Atom']). - -metta_defn_ES( - ['If',Cond,Then,Else], - [if,Cond,Then,Else]). - -metta_defn_ES( - ['TupleConcat',Ev1,Ev2], - [ collapse, - [ superpose, - [ [ superpose, Ev1 ], - [ superpose, Ev2 ]]]]). - -metta_defn_ES( - [max,Num1,Num2], - [ 'If', - [>,Num1,Num2], Num1,Num2]). - -metta_defn_ES( - [min,Num1,Num2], - [ 'If', - [<,Num1,Num2], Num1,Num2]). - -metta_defn_ES( - [abs,X], - [ 'If', - [<,X,0], - [-,0,X], - X]). - -metta_type('&self',sequential,[->,'Expression','%Undefined%']). - -metta_defn_ES([sequential,Num1],[superpose,Num1]). - -metta_type('&self',do,[->,'Expression','%Undefined%']). - -metta_defn_ES([do,Num1],[case,Num1,[]]). - -metta_defn_ES(['TupleCount',[]],0). - -metta_defn_ES(['TupleCount',[1]],1). - -metta_defn_ES( - ['BuildTupleCounts',TOld,C,N], - [ let, - T, - [ collapse, - [ superpose, - [ 1, - [superpose,TOld]]]], - [ superpose, - [ [ 'add-atom', - '&self', - [ =, - ['TupleCount',T], - [+,C,2]]], - [ 'If', - [<,C,N], - [ 'BuildTupleCounts', - T, - [+,C,1], - N]]]]]). - -metta_type('&self','CountElement',[->,'Expression','Number']). - -metta_defn_ES( - ['CountElement',X], - [ case, - X, - [ [ Y,1]]]). - -%;;Build for count up to 100 (takes a few sec but it is worth it if space or generally collapse counts are often needed) -:-metta_eval(['BuildTupleCounts',[1],0,100]). - -metta_defn_ES( - [ 'BuildTupleCounts', - [1], 0,100], - [ let, - A, - [ collapse, - [ superpose, - [ 1, - [ superpose, - [1]]]]], - [ superpose, - [ [ 'add-atom', - '&self', - [ =, - ['TupleCount',A], - [+,0,2]]], - [ 'If', - [<,0,100], - [ 'BuildTupleCounts', - A, - [+,0,1], - 100]]]]]). - -metta_type('&self','CollapseCardinality',[->,'Expression','Number']). - -metta_defn_ES( - ['CollapseCardinality',Expression], - [ 'TupleCount', - [ collapse, - ['CountElement',Expression]]]). - -%;; Truth functions -metta_defn_ES( - ['Truth_c2w',C], - [ /, - C, - [-,1,C]]). - -metta_defn_ES( - ['Truth_w2c',W], - [ /, - W, - [+,W,1]]). - -metta_defn_ES( - [ 'Truth_Deduction', - [F1,C1], - [F2,C2]], - [ [*,F1,F2], - [ *, - [*,F1,F2], - [*,C1,C2]]]). - -metta_defn_ES( - [ 'Truth_Abduction', - [F1,C1], - [F2,C2]], - [ F2, - [ 'Truth_w2c', - [ *, - [*,F1,C1], - C2]]]). - -metta_defn_ES( - ['Truth_Induction',T1,T2], - ['Truth_Abduction',T2,T1]). - -metta_defn_ES( - [ 'Truth_Exemplification', - [F1,C1], - [F2,C2]], - [ 1.0, - [ 'Truth_w2c', - [ *, - [*,F1,F2], - [*,C1,C2]]]]). - -metta_defn_ES( - ['Truth_StructuralDeduction',T], - [ 'Truth_Deduction', - T, - [1.0,0.9]]). - -metta_defn_ES( - [ 'Truth_Negation', - [F,C]], - [ [-,1,F], - C]). - -metta_defn_ES( - ['Truth','StructuralDeductionNegated',T], - [ 'Truth_Negation', - ['Truth_StructuralDeduction',T]]). - -metta_defn_ES( - [ 'Truth_Intersection', - [F1,C1], - [F2,C2]], - [ [ * ,F1,F2], - [ * ,C1,C2]]). - -metta_defn_ES( - ['Truth_StructuralIntersection',T], - [ 'Truth_Intersection', - T, - [1.0,0.9]]). - -metta_defn_ES( - ['Truth_or',A,B], - [ -, - 1, - [ *, - [-,1,A], - [-,1,B]]]). - -metta_defn_ES( - [ 'Truth_Comparison', - [F1,C1], - [F2,C2]], - [ let, - F0, - ['Truth_or',F1,F2], - [ [ 'If', - [==,F0,0.0], - 0.0, - [ /, - [*,F1,F2], - F0]], - [ 'Truth_w2c', - [ *, - F0, - [*,C1,C2]]]]]). - -metta_defn_ES( - [ 'Truth_Analogy', - [F1,C1], - [F2,C2]], - [ [*,F1,F2], - [ *, - [*,C1,C2], - F2]]). - -metta_defn_ES( - [ 'Truth_Resemblance', - [F1,C1], - [F2,C2]], - [ [*,F1,F2], - [ *, - [*,C1,C2], - ['Truth_or',F1,F2]]]). - -metta_defn_ES( - [ 'Truth_Union', - [F1,C1], - [F2,C2]], - [ [ 'Truth_or', F1 , F2 ], - [ * , C1 , C2 ]]). - -metta_defn_ES( - [ 'Truth_Difference', - [F1,C1], - [F2,C2]], - [ [ *, - F1, - [-,1,F2]], - [*,C1,C2]]). - -metta_defn_ES( - [ 'Truth_DecomposePNN', - [F1,C1], - [F2,C2]], - [ let, - Fn, - [ *, - F1, - [-,1,F2]], - [ [-,1,Fn], - [ *, - Fn, - [*,C1,C2]]]]). - -metta_defn_ES( - [ 'Truth_DecomposeNPP', - [F1,C1], - [F2,C2]], - [ let, - F, - [ *, - [-,1,F1], - F2], - [ F, - [ *, - F, - [*,C1,C2]]]]). - -metta_defn_ES( - [ 'Truth_DecomposePNP', - [F1,C1], - [F2,C2]], - [ let, - F, - [ *, - F1, - [-,1,F2]], - [ F, - [ *, - F, - [*,C1,C2]]]]). - -metta_defn_ES( - ['Truth_DecomposePPP',V1,V2], - [ 'Truth_DecomposeNPP', - ['Truth_Negation',V1], - V2]). - -metta_defn_ES( - [ 'Truth_DecomposeNNN', - [F1,C1], - [F2,C2]], - [ let, - Fn, - [ *, - [-,1,F1], - [-,1,F2]], - [ [-,1,Fn], - [ *, - Fn, - [*,C1,C2]]]]). - -metta_defn_ES( - [ 'Truth_Eternalize', - [F,C]], - [ F, - ['Truth_w2c',C]]). - -metta_defn_ES( - [ 'Truth_Revision', - [F1,C1], - [F2,C2]], - [ 'let*', - [ [ W1, - ['Truth_c2w',C1]], - [ W2, - ['Truth_c2w',C2]], - [ W, - [+,W1,W2]], - [ F, - [ /, - [ +, - [*,W1,F1], - [*,W2,F2]], - W]], - [ C, - ['Truth_w2c',W]]], - [ [min,1.0,F], - [ min, - 0.99, - [ max, - [max,C,C1], - C2]]]]). - -metta_defn_ES( - [ 'Truth_Expectation', - [F,C]], - [ +, - [ *, - C, - [-,F,0.5]], - 0.5]). -% ;;NAL-1 -% ;;!Syllogistic rules for Inheritance: -metta_defn_ES(['|-',[[A,-->,B],C],[[B,-->,D],E]] , [[A,-->,D],['Truth_Deduction',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[A,-->,D],E]] , [[D,-->,B],['Truth_Induction',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[D,-->,B],E]] , [[D,-->,A],['Truth_Abduction',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[B,-->,D],E]] , [[D,-->,A],['Truth_Exemplification',C,E]]). -% ;;NAL-2 -% ;;!Rules for Similarity: -metta_defn_ES(['|-',[[A,<->,B],C]] , [[B,<->,A],['Truth_StructuralIntersection',C]]). -metta_defn_ES(['|-',[[A,<->,B],C],[[D,<->,A],E]] , [[D,<->,B],['Truth_Resemblance',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[D,-->,B],E]] , [[D,<->,A],['Truth_Comparison',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[A,-->,D],E]] , [[D,<->,B],['Truth_Comparison',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[D,<->,A],E]] , [[D,-->,B],['Truth_Analogy',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[D,<->,B],E]] , [[A,-->,D],['Truth_Analogy',C,E]]). -% ;;!Dealing with properties and instances: -metta_defn_ES(['|-',[[A,-->,['{',B,'}']],C]] , [[A,<->,['{',B,'}']],['Truth_StructuralIntersection',C]]). -metta_defn_ES(['|-',[[['$OBJ'(claz_bracket_vector,['$S'])],-->,A],B]] , [[['$OBJ'(claz_bracket_vector,['$S'])],<->,A],['Truth_StructuralIntersection',B]]). -metta_defn_ES(['|-',[[['{',A,'}'],-->,B],C],[[D,<->,A],E]] , [[['{',D,'}'],-->,B],['Truth_Analogy',C,E]]). -metta_defn_ES(['|-',[[A,-->,['$OBJ'(claz_bracket_vector,['$M'])]],B],[[_,<->,_],C]] , [[A,-->,['$OBJ'(claz_bracket_vector,['$S'])]],['Truth_Analogy',B,C]]). -get_metta_atom(Eq,'&self',[=,['|-',[[['{',A,'}'],<->,['{',B,'}']]],[A,<->,B],['Truth_StructuralIntersection',_]]]). -get_metta_atom(Eq,'&self',[=,['|-',[[['$OBJ'(claz_bracket_vector,[A])],<->,['$OBJ'(claz_bracket_vector,[B])]]],[_,<->,_],['Truth_StructuralIntersection',_]]]). -% ;;NAL-3 -% ;;!Set decomposition: -metta_defn_ES(['|-',[[['{',A,_,'}'],-->,B],C]] , [[['{',A,'}'],-->,B],['Truth_StructuralDeduction',C]]). -metta_defn_ES(['|-',[[['{',_,A,'}'],-->,B],C]] , [[['{',A,'}'],-->,B],['Truth_StructuralDeduction',C]]). -metta_defn_ES(['|-',[['M',-->,['$OBJ'(claz_bracket_vector,[A,B])]],A]] , [['M',-->,['$OBJ'(claz_bracket_vector,[A])]],['Truth_StructuralDeduction',A]]). -metta_defn_ES(['|-',[['M',-->,['$OBJ'(claz_bracket_vector,[A,B])]],A]] , [['M',-->,['$OBJ'(claz_bracket_vector,[B])]],['Truth_StructuralDeduction',A]]). -% ;;!Extensional and intensional intersection decomposition: -metta_defn_ES(['|-',[[[A,'|',_],-->,B],C]] , [[A,-->,B],['Truth_StructuralDeduction',C]]). -metta_defn_ES(['|-',[[A,-->,[B,&,_]],C]] , [[A,-->,B],['Truth_StructuralDeduction',C]]). -metta_defn_ES(['|-',[[[_,'|',A],-->,B],C]] , [[A,-->,B],['Truth_StructuralDeduction',C]]). -metta_defn_ES(['|-',[[A,-->,[_,&,B]],C]] , [[A,-->,B],['Truth_StructuralDeduction',C]]). -metta_defn_ES(['|-',[[[A,~,_],-->,B],C]] , [[A,-->,B],['Truth_StructuralDeduction',C]]). -metta_defn_ES(['|-',[[A,-->,[B,-,_]],C]] , [[A,-->,B],['Truth_StructuralDeduction',C]]). -metta_defn_ES(['|-',[[[_,~,A],-->,B],C]] , [[A,-->,B],['Truth_StructuralDeductionNegated',C]]). -metta_defn_ES(['|-',[[A,-->,[_,-,B]],C]] , [[A,-->,B],['Truth_StructuralDeductionNegated',C]]). -% ;;!Extensional and intensional intersection composition: (sets via reductions). -metta_defn_ES(['|-',[[A,-->,B],C],[[D,-->,B],E]] , [[[A,'|',D],-->,B],['Truth_Intersection',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[D,-->,B],E]] , [[[A,&,D],-->,B],['Truth_Union',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[D,-->,B],E]] , [[[A,~,D],-->,B],['Truth_Difference',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[A,-->,D],E]] , [[A,-->,[B,&,D]],['Truth_Intersection',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[A,-->,D],E]] , [[A,-->,[B,'|',D]],['Truth_Union',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[A,-->,D],E]] , [[A,-->,[B,-,D]],['Truth_Difference',C,E]]). -% ;;!Extensional and intensional intersection decomposition: -metta_defn_ES(['|-',[[A,-->,B],C],[[[A,'|',D],-->,B],E]] , [[D,-->,B],['Truth_DecomposePNN',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[[D,'|',A],-->,B],E]] , [[D,-->,B],['Truth_DecomposePNN',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[[A,&,D],-->,B],E]] , [[D,-->,B],['Truth_DecomposeNPP',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[[D,&,A],-->,B],E]] , [[D,-->,B],['Truth_DecomposeNPP',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[[A,~,D],-->,B],E]] , [[D,-->,B],['Truth_DecomposePNP',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[[D,~,A],-->,B],E]] , [[D,-->,B],['Truth_DecomposeNNN',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[A,-->,[B,&,D]],E]] , [[A,-->,D],['Truth_DecomposePNN',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[A,-->,[D,&,B]],E]] , [[A,-->,D],['Truth_DecomposePNN',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[A,-->,[B,'|',D]],E]] , [[A,-->,D],['Truth_DecomposeNPP',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[A,-->,[D,'|',B]],E]] , [[A,-->,D],['Truth_DecomposeNPP',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[A,-->,[B,-,D]],E]] , [[A,-->,D],['Truth_DecomposePNP',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[A,-->,[D,-,B]],E]] , [[A,-->,D],['Truth_DecomposeNNN',C,E]]). -% ;; NAL-4 -% ;;!Transformation rules between product and image: -metta_defn_ES(['|-',[[[A,*,B],-->,C],D]] , [[A,-->,[C,'/1',B]],['Truth_StructuralIntersection',D]]). -metta_defn_ES(['|-',[[[A,*,B],-->,C],D]] , [[B,-->,[C,'/2',A]],['Truth_StructuralIntersection',D]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D]] , [[[A,'\\1',C],-->,B],['Truth_StructuralIntersection',D]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D]] , [[[A,'\\2',B],-->,C],['Truth_StructuralIntersection',D]]). -% ;;other direction of same rules (as these are bi-directional). -metta_defn_ES(['|-',[[A,-->,[B,'/1',C]],D]] , [[[A,*,C],-->,B],['Truth_StructuralIntersection',D]]). -metta_defn_ES(['|-',[[A,-->,[B,'/2',C]],D]] , [[[C,*,A],-->,B],['Truth_StructuralIntersection',D]]). -metta_defn_ES(['|-',[[[A,'\\1',B],-->,C],D]] , [[A,-->,[C,*,B]],['Truth_StructuralIntersection',D]]). -metta_defn_ES(['|-',[[[A,'\\2',B],-->,C],D]] , [[A,-->,[B,*,C]],['Truth_StructuralIntersection',D]]). -% ;;!Comparative relations -metta_defn_ES(['|-',[[['{',A,'}'],'|-',>,['$OBJ'(claz_bracket_vector,['$P'])]],B],[[['{',C,'}'],'|-',>,['$OBJ'(claz_bracket_vector,['$P'])]],D]] , [[[['{',A,'}'],*,['{',C,'}']],-->,[>>>,_]],['Truth_FrequencyGreater',B,D]]). -metta_defn_ES(['|-',[[[A,*,B],-->,[>>>,C]],D],[[[B,*,E],-->,[>>>,C]],F]] , [[[A,*,E],-->,[>>>,C]],['Truth_Deduction',D,F]]). -metta_defn_ES(['|-',[[['{',A,'}'],'|-',>,['$OBJ'(claz_bracket_vector,['$P'])]],B],[[['{',C,'}'],'|-',>,['$OBJ'(claz_bracket_vector,['$P'])]],D]] , [[[['{',A,'}'],*,['{',C,'}']],-->,[===,_]],['Truth_FrequencyEqual',B,D]]). -metta_defn_ES(['|-',[[[A,*,B],-->,[===,C]],D],[[[B,*,E],-->,[===,C]],F]] , [[[A,*,E],-->,[===,C]],['Truth_Deduction',D,F]]). -metta_defn_ES(['|-',[[[A,*,B],-->,[===,C]],D]] , [[[B,*,A],-->,[===,C]],['Truth_StructuralIntersection',D]]). -% ;;!Optional rules for more efficient reasoning about relation components: -metta_defn_ES(['|-',[[[A,*,B],-->,C],D],[[[E,*,B],-->,C],F]] , [[E,-->,A],['Truth_Abduction',D,F]]). -metta_defn_ES(['|-',[[[A,*,B],-->,C],D],[[[A,*,E],-->,C],F]] , [[E,-->,B],['Truth_Abduction',D,F]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D],[[A,-->,[E,*,C]],F]] , [[E,-->,B],['Truth_Induction',D,F]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D],[[A,-->,[B,*,E]],F]] , [[E,-->,C],['Truth_Induction',D,F]]). -metta_defn_ES(['|-',[[[A,*,B],-->,C],D],[[E,-->,A],F]] , [[[E,*,B],-->,C],['Truth_Deduction',D,F]]). -metta_defn_ES(['|-',[[[A,*,B],-->,C],D],[[A,-->,E],F]] , [[[E,*,B],-->,C],['Truth_Induction',D,F]]). -metta_defn_ES(['|-',[[[A,*,B],-->,C],D],[[E,<->,A],F]] , [[[E,*,B],-->,C],['Truth_Analogy',D,F]]). -metta_defn_ES(['|-',[[[A,*,B],-->,C],D],[[E,-->,B],F]] , [[[A,*,E],-->,C],['Truth_Deduction',D,F]]). -metta_defn_ES(['|-',[[[A,*,B],-->,C],D],[[B,-->,E],F]] , [[[A,*,E],-->,C],['Truth_Induction',D,F]]). -metta_defn_ES(['|-',[[[A,*,B],-->,C],D],[[E,<->,B],F]] , [[[A,*,E],-->,C],['Truth_Analogy',D,F]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D],[[B,-->,E],F]] , [[A,-->,[E,*,C]],['Truth_Deduction',D,F]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D],[[E,-->,B],F]] , [[A,-->,[E,*,C]],['Truth_Abduction',D,F]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D],[[E,<->,B],F]] , [[A,-->,[E,*,C]],['Truth_Analogy',D,F]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D],[[C,-->,E],F]] , [[A,-->,[B,*,E]],['Truth_Deduction',D,F]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D],[[E,-->,C],F]] , [[A,-->,[B,*,E]],['Truth_Abduction',D,F]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D],[[E,<->,C],F]] , [[A,-->,[B,*,E]],['Truth_Analogy',D,F]]). -metta_defn_ES(['|-',[[[A,*,B],-->,C],D],[[[E,*,B],-->,C],F]] , [[A,<->,E],['Truth_Comparison',D,F]]). -metta_defn_ES(['|-',[[[A,*,B],-->,C],D],[[[A,*,E],-->,C],F]] , [[B,<->,E],['Truth_Comparison',D,F]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D],[[A,-->,[E,*,C]],F]] , [[B,<->,E],['Truth_Comparison',D,F]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D],[[A,-->,[B,*,E]],F]] , [[C,<->,E],['Truth_Comparison',D,F]]). -% ;;NAL-5 -% ;;!Negation conjunction and disjunction decomposition: -metta_defn_ES(['|-',[[!,A],B]],[A,['Truth_Negation',B]]). -metta_defn_ES(['|-',[[A,&&,_],B]],[A,['Truth_StructuralDeduction',B]]). -metta_defn_ES(['|-',[[_,&&,A],B]],[A,['Truth_StructuralDeduction',B]]). -metta_defn_ES(['|-',[[A,&&,B],C]] , [[B,&&,A],['Truth_StructuralIntersection',C]]). -metta_defn_ES(['|-',[A,B],[[A,&&,C],D]],[C,['Truth_DecomposePNN',B,D]]). -metta_defn_ES(['|-',[A,B],[[A,'||',C],D]],[C,['Truth_DecomposeNPP',B,D]]). -metta_defn_ES(['|-',[A,B],[[[!,A],&&,C],D]],[C,['Truth_DecomposeNNN',B,D]]). -metta_defn_ES(['|-',[A,B],[[[!,A],'||',C],D]],[C,['Truth_DecomposePPP',B,D]]). -% ;;!Syllogistic rules for Implication: -metta_defn_ES(['|-',[[A,==>,B],C],[[B,==>,D],E]] , [[A,==>,D],['Truth_Deduction',C,E]]). -metta_defn_ES(['|-',[[A,==>,B],C],[[A,==>,D],E]] , [[D,==>,B],['Truth_Induction',C,E]]). -metta_defn_ES(['|-',[[A,==>,B],C],[[D,==>,B],E]] , [[D,==>,A],['Truth_Abduction',C,E]]). -metta_defn_ES(['|-',[[A,==>,B],C],[[B,==>,D],E]] , [[D,==>,A],['Truth_Exemplification',C,E]]). -% ;;!Conditional composition for conjunction and disjunction: -metta_defn_ES(['|-',[[A,==>,B],C],[[D,==>,B],E]] , [[[A,&&,D],==>,B],['Truth_Union',C,E]]). -metta_defn_ES(['|-',[[A,==>,B],C],[[D,==>,B],E]] , [[[A,'||',D],==>,B],['Truth_Intersection',C,E]]). -metta_defn_ES(['|-',[[A,==>,B],C],[[A,==>,D],E]] , [[A,==>,[B,&&,D]],['Truth_Intersection',C,E]]). -metta_defn_ES(['|-',[[A,==>,B],C],[[A,==>,D],E]] , [[A,==>,[B,'||',D]],['Truth_Union',C,E]]). -% ;;!Multi-conditional inference: -metta_defn_ES(['|-',[[[A,&&,B],==>,C],D],[[A,==>,C],E]],[B,['Truth_Abduction',D,E]]). -metta_defn_ES(['|-',[[[A,&&,B],==>,C],D],[[E,==>,B],F]] , [[[A,&&,E],==>,C],['Truth_Deduction',D,F]]). -metta_defn_ES(['|-',[[[A,&&,B],==>,C],D],[[[A,&&,E],==>,C],F]] , [[E,==>,B],['Truth_Abduction',D,F]]). -metta_defn_ES(['|-',[[[A,&&,B],==>,C],D],[[B,==>,E],F]] , [[[A,&&,E],==>,C],['Truth_Induction',D,F]]). -% ;;!Rules for equivalence: -metta_defn_ES(['|-',[[A,<=>,B],C]] , [[B,<=>,A],['Truth_StructuralIntersection',C]]). -metta_defn_ES(['|-',[[A,==>,B],C],[[B,==>,A],D]] , [[A,<=>,B],['Truth_Intersection',C,D]]). -metta_defn_ES(['|-',[[A,==>,B],C],[[D,==>,B],E]] , [[D,<=>,A],['Truth_Comparison',C,E]]). -metta_defn_ES(['|-',[[A,==>,B],C],[[A,==>,D],E]] , [[D,<=>,B],['Truth_Comparison',C,E]]). -metta_defn_ES(['|-',[[A,==>,B],C],[[D,<=>,A],E]] , [[D,==>,B],['Truth_Analogy',C,E]]). -metta_defn_ES(['|-',[[A,==>,B],C],[[D,<=>,B],E]] , [[A,==>,D],['Truth_Analogy',C,E]]). -metta_defn_ES(['|-',[[A,<=>,B],C],[[D,<=>,A],E]] , [[D,<=>,B],['Truth_Resemblance',C,E]]). -% ;;!Higher-order decomposition -metta_defn_ES(['|-',[A,B],[[A,==>,C],D]],[C,['Truth_Deduction',B,D]]). -metta_defn_ES(['|-',[A,B],[[[A,&&,C],==>,D],E]] , [[C,==>,D],['Truth_Deduction',B,E]]). -metta_defn_ES(['|-',[A,B],[[C,==>,A],D]],[C,['Truth_Abduction',B,D]]). -metta_defn_ES(['|-',[A,B],[[A,<=>,C],D]],[C,['Truth_Analogy',B,D]]). -% ;;NAL term reductions -% ;;!Extensional intersection, union, conjunction reductions: -metta_defn_ES([A,&,A],A). -metta_defn_ES([A,'|',A],A). -metta_defn_ES([A,&&,A],A). -metta_defn_ES([A,'||',A],A). -% ;;!Extensional set reductions: -metta_defn_ES([['{',A,'}'],'|',['{',B,'}']],['{',A,B,'}']). -metta_defn_ES([['{',A,B,'}'],'|',['{',C,'}']],['{',[A|B],C,'}']). -metta_defn_ES([['{',A,'}'],'|',['{',B,C,'}']],['{',A,[B|C],'}']). -% ;;!Intensional set reductions: -metta_defn_ES([['$OBJ'(claz_bracket_vector,[A])],&,['$OBJ'(claz_bracket_vector,[B])]],['$OBJ'(claz_bracket_vector,[A,B])]). -metta_defn_ES([['$OBJ'(claz_bracket_vector,[A,B])],&,['$OBJ'(claz_bracket_vector,[C])]],['$OBJ'(claz_bracket_vector,[[A|B],C])]). -metta_defn_ES([['$OBJ'(claz_bracket_vector,[A])],&,['$OBJ'(claz_bracket_vector,[B,C])]],['$OBJ'(claz_bracket_vector,[A,[B|C]])]). -% ;;!Reduction for set element copula: -metta_defn_ES(['{',[A|B],'}'],['{',A,B,'}']). -metta_defn_ES(['$OBJ'(claz_bracket_vector,[[A|B]])],['$OBJ'(claz_bracket_vector,[A,B])]). - -%;params -metta_defn_ES(['BeliefEventsMax'],10). - -metta_defn_ES(['GoalEventsMax'],10). - -%;spaces -:-metta_eval(['bind!','&belief_events',['new-space']]). - -:-metta_eval(['bind!','&goal_events',['new-space']]). - -%;states -:-metta_eval(['bind!','¤tTime',['new-state',1]]). - -:-metta_eval(['bind!','&evidentialBase',['new-state',1]]). - -metta_defn_ES( - [increment,Atom], - [ 'change-state!', - Atom, - [ +, - 1, - ['get-state',Atom]]]). - -metta_defn_ES( - ['UpdateReasonerState'], - [ [ increment , '¤tTime' ], - [ increment ,'&evidentialBase']]). - -metta_defn_ES( - ['GetReasonerState'], - [ ['get-state','¤tTime'], - [ [ 'get-state' ,'&evidentialBase']]]). - -%;priority of events -metta_defn_ES( - [ 'EventPriorityNow', - [T,P], - T], - [ *, - P, - [ /, - 1, - [ +, - 1, - [-,T,T]]]]). - -%;retrieve the best candidate (allows to use tuples / collapse results / spaces as a PQ) -:-metta_eval(['bind!','&tempbest',['new-state',[]]]). - -:-metta_eval(['bind!','&tempbestscore',['new-state',0]]). - -metta_defn_ES( - ['BestCandidate',Tuple,EvaluateCandidateFunction,T], - [ sequential, - [ [ do, - ['change-state!','&tempbestscore',0]], - [ do, - ['change-state!','&tempbest',[]]], - [ do, - [ 'let*', - [ [ X, - [superpose,Tuple]], - [ Fx, - [EvaluateCandidateFunction,X,T]]], - [ superpose, - [ [ 'If', - [ >, - Fx, - ['get-state','&tempbestscore']], - [ sequential, - [ [ 'change-state!' , '&tempbest' , X ], - [ 'change-state!' ,'&tempbestscore', Fx ]]]]]]]], - ['get-state','&tempbest']]]). - -%;functions to select highest-priority events in belief and goal PQ -metta_defn_ES( - [ 'PriorityOf', - [ 'Event', - Sentence, - [OccT,Ev,Prio]], - T], - ['EventPriorityNow',Prio,T]). - -metta_defn_ES( - ['SelectHighestPriorityEvent',Collection,T], - [ 'BestCandidate', - [ collapse, - ['get-atoms',Collection]], 'PriorityOf',T]). - -%;a belief event to process, which demands adding it to the PQ and updating its concept -metta_defn_ES( - ['ProcessBeliefEvent',Ev,T], - [ sequential, - [ [ 'add-atom' ,'&belief_events', Ev ], - [ 'UpdateConcept' , Ev , T ]]]). - -%;bound the size of the attentional focus for tasks / events -metta_defn_ES( - [ 'BoundEvents', Collection,Threshold, - Increment, TargetAmount, T], - [ sequential, - [ [ do, - [ 'let*', - [ [ Ev, - ['get-atoms',Collection]], - [ [ 'Event', - Sentence, - [Time,Evidence,EPrio]], - Ev]], - [ 'If', - [ <, - ['EventPriorityNow',EPrio,T], - Threshold], - ['remove-atom',Collection,Ev]]]], - [ let, - CurrentAmount, - [ 'CollapseCardinality', - ['get-atoms',Collection]], - [ 'If', - [>,CurrentAmount,TargetAmount], - [ 'BoundEvents', - Collection, - [+,Threshold,Increment], Increment, TargetAmount, T]]]]]). - -%;params -metta_defn_ES(['AttentionalFocusConceptsMax'],10). - -%;spaces -:-metta_eval(['bind!','&concepts',['new-space']]). - -:-metta_eval(['bind!','&attentional_focus',['new-space']]). - -%;priority of concepts -metta_defn_ES( - [ 'ConceptPriorityNow', - [T,P], - T], - [ *, - P, - [ /, - 1, - [ +, - 1, - [-,T,T]]]]). - -%;whether evidence was just counted once -:-metta_eval(['bind!','&tempstate',['new-state','False']]). - -:-metta_eval(['bind!','&tempset',['new-space']]). - -metta_defn_ES( - ['StampDisjoint',X], - [ not, - [ sequential, - [ [ do, - ['change-state!','&tempstate','False']], - [ do, - [ case, - ['get-atoms','&tempset'], - [ [ Y, - ['remove-atom','&tempset',Y]]]]], - [ do, - [ let, - Z, - [superpose,X], - [ case, - [match,'&tempset',Z,Z], - [ [ W, - ['change-state!','&tempstate','True']], - [ '%void%', - ['add-atom','&tempset',Z]]]]]], - ['get-state','&tempstate']]]]). - -%;revise if there is no evidential overlap, else use higher-confident candidate -metta_defn_ES( - [ 'RevisionAndChoice', - [ 'Event', - [ Term1, - [F1,C1]], - [eternal,Ev1,EPrio1]], - [ 'Event', - [ Term2, - [F2,C2]], - [eternal,Ev2,EPrio2]]], - [ let, - ConclusionStamp, - ['TupleConcat',Ev1,Ev2], - [ 'If', - ['StampDisjoint',ConclusionStamp], - [ 'Event', - [ Term1, - [ 'Truth_Revision', - [F1,C1], - [F2,C2]]], - [ eternal, - ConclusionStamp, - [0,0.0]]], - [ 'If', - [>,C1,C2], - [ 'Event', - [ Term1, - [F1,C1]], - [ eternal, - Ev1, - [0,0.0]]], - [ 'Event', - [ Term2, - [F2,C2]], - [ eternal, - Ev2, - [0,0.0]]]]]]). - -%;;update beliefs in existing concept with the new event or create new concept to enter the new evidence -metta_defn_ES( - ['UpdateConcept',NewEvent,T], - [ 'let*', - [ [ [ 'Event', - [Term,TV], - [Time,Evidence,EPrio]], - NewEvent], - [ NewEventEternalized, - ['Eternalize',NewEvent]], - [ MatchConcept, - [ 'Concept', Term,Belief, - BeliefEvent,CPrio]]], - [ sequential, - [ [ case, - [match,'&attentional_focus',MatchConcept,MatchConcept], - [ [ MatchConcept, - [ sequential, - [ ['remove-atom','&attentional_focus',MatchConcept], - [ 'let*', - [ [ RevisedBelief, - ['RevisionAndChoice',Belief,NewEventEternalized]], - [ MaxPrio, - [ 'If', - [ >, - ['EventPriorityNow',EPrio,T], - ['ConceptPriorityNow',CPrio,T]], EPrio,CPrio]]], - [ 'add-atom', - '&attentional_focus', - [ 'Concept', Term, RevisedBelief, NewEvent, MaxPrio]]]]]], - [ '%void%', - [ case, - [match,'&concepts',MatchConcept,MatchConcept], - [ [ MatchConcept, - [ sequential, - [ [ 'remove-atom' , '&concepts' , MatchConcept ], - [ 'add-atom' ,'&attentional_focus', MatchConcept ], - [ 'UpdateConcept' , NewEvent , T ]]]], - [ '%void%', - [ 'add-atom', - '&attentional_focus', - [ 'Concept', Term, NewEventEternalized, NewEvent, EPrio]]]]]]]]]]]). - -%;bound the size of attentional focus of concepts -metta_defn_ES( - [ 'BoundAttention', Threshold,Increment, - TargetAmount,T], - [ sequential, - [ [ do, - [ 'let*', - [ [ C, - ['get-atoms','&attentional_focus']], - [ [ 'Concept', - Term, - ['Event',Sentence,Metadata], BeliefEvent,CPrio], - C]], - [ 'If', - [ <, - ['ConceptPriorityNow',CPrio,T], - Threshold], - [ sequential, - [ [ 'remove-atom' ,'&attentional_focus', C ], - [ 'add-atom' , '&concepts' , C ]]]]]], - [ let, - CurrentAmount, - [ 'CollapseCardinality', - ['get-atoms','&attentional_focus']], - [ 'If', - [>,CurrentAmount,TargetAmount], - [ 'BoundAttention', - [+,Threshold,Increment], Increment, TargetAmount, T]]]]]). - -%;get eternal belief of concept -metta_type('&self','EternalQuestion',[->,'Expression',T]). - -metta_defn_ES( - ['EternalQuestion',Term], - [ case, - [ match, - [ superpose, - ['&attentional_focus','&concepts']], - [ 'Concept', Term,Belief, - BeliefEvent,CPrio], - Belief], - [ [Ev,Ev], - [ '%void%', - [ 'Event', - [ 'None', - [0.5,0.0]], - [eternal,[],0.0]]]]]). - -%;get event belief of concept -metta_type('&self','EventQuestion',[->,'Expression',T]). - -metta_defn_ES( - ['EventQuestion',Term], - [ case, - [ match, - [ superpose, - ['&attentional_focus','&concepts']], - [ 'Concept', Term,Belief, - BeliefEvent,CPrio], - BeliefEvent], - [ [Ev,Ev], - [ '%void%', - [ 'Event', - [ 'None', - [0.5,0.0]], - [0,[],0.0]]]]]). - -%;;Declarative inference (deriving events and knowledge from observed events) -%;Derived belief event priority -metta_defn_ES( - ['ConclusionPriority',EPrio,CPrio,ConcTV], - [ *, - [*,EPrio,CPrio], - ['Truth_Expectation',ConcTV]]). - -%;making declarative inferences on two events (task from PQ and belief from concept) -metta_defn_ES( - [ 'Conclude', - [ 'Event', - S1, - [Time1,Ev1,Prio1]], - [ 'Event', - S2, - [Time2,Ev2,Prio2]], CPrio,T], - [ let, - ConclusionStamp, - ['TupleConcat',Ev1,Ev2], - [ 'If', - ['StampDisjoint',ConclusionStamp], - [ let, - [ConcTerm,ConcTV], - [ superpose, - [ [ '|-', S1 , S2 ], - [ '|-', S2 , S1 ]]], - [ 'Event', - [ConcTerm,ConcTV], - [ Time1, - ConclusionStamp, - [ T, - [ 'ConclusionPriority', - ['EventPriorityNow',Prio1,T], - ['ConceptPriorityNow',CPrio,T], - ConcTV]]]]]]]). - -%;find a belief for the task to generate conclusions with -metta_defn_ES( - [ 'ReasonWithTask', - [ 'Event', - S1, - [Time1,Ev1,Prio1]], - T], - [ let, - [Belief,CPrio], - [ case, - ['get-atoms','&attentional_focus'], - [ [ [ 'Concept', - Term, - [ 'Event', - SE2, - [TimeE2,EvE2,PrioE2]], - [ 'Event', - S2, - [Time2,Ev2,Prio2]], - CPrio], - [ 'If', - [ and, - [ not, - [==,Time1,eternal]], - [ >, - [ abs, - [-,Time1,Time2]], - 20]], - [ [ 'Event', - SE2, - [TimeE2,EvE2,PrioE2]], - Cprio], - [ [ 'Event', - S2, - [Time2,Ev2,Prio2]], - CPrio]]]]], - [ case, - [ 'Conclude', - [ 'Event', - S1, - [Time1,Ev1,Prio1]], - ['TemporallyAlignedBelief',Time1,Belief], CPrio,T], - [ [ ['Event',Num1,Num2], - [ 'ProcessBeliefEvent', - ['Event',Num1,Num2], - T]]]]]). - -%;select the highest priority belief event from the PQ and use it for reasoning -metta_defn_ES( - ['BeliefCycle',T], - [ do, - [ sequential, - [ [ let, - Ev, - ['SelectHighestPriorityEvent','&belief_events',T], - [ sequential, - [ [ 'remove-atom' ,'&belief_events', Ev ], - [ 'ReasonWithTask', Ev , T ]]]], - ['UpdateReasonerState'], - [ 'BoundEvents', '&belief_events',0.0,0.1, - ['BeliefEventsMax'], - T], - [ 'BoundAttention', 0.0,0.1, - ['AttentionalFocusConceptsMax'], - T]]]]). - -%;;Temporal inference (sequence and implication formation based on FIFO) -%;use the event's evidence to induce a time-independent belief which can be used in the future -metta_defn_ES( - ['Eternalize',Ev], - [ let, - [ 'Event', - [Term,TV], - [Time,Evidence,EPrio]], - Ev, - [ 'If', - [==,Time,eternal], - Ev, - [ 'Event', - [ Term, - ['Truth_Eternalize',TV]], - [ eternal, - Evidence, - [0,0.0]]]]]). - -%;use evidence of an event at a slightly different moment in time -metta_defn_ES( - [ 'Projection', - [ 'Event', - [ Term, - [F,C]], - [Time,Evidence,EPrio]], - TargetTime], - [ 'Event', - [ Term, - [ F, - [ *, - C, - [ min, - 1, - [ /, - 1, - [ abs, - [-,Time,TargetTime]]]]]]], - [TargetTime,Evidence,EPrio]]). - -%;make the belief occurrence time compatible with the task's -metta_defn_ES( - ['TemporallyAlignedBelief',TaskTime,Belief], - [ 'If', - [==,TaskTime,eternal], - ['Eternalize',Belief], - ['Projection',Belief,TaskTime]]). - -%;FIFO max. size bound -:-metta_eval(['bind!','&FIFO',['new-state',[]]]). - -metta_defn_ES(['ListFirstK',C,[]],[]). - -metta_defn_ES( - [ 'ListFirstK', - C, - [LH,LT]], - [ 'If', - [>,C,0], - [ LH, - [ 'ListFirstK', - [-,C,1], - LT]], - []]). - -%;Add event to FIFO -metta_defn_ES( - ['EventToFIFO',Ev], - [ let, - Newlist, - [ 'ListFirstK', - 3, - [ Ev, - ['get-state','&FIFO']]], - ['change-state!','&FIFO',Newlist]]). - -%;Form a sequence of two events -metta_defn_ES( - [ 'TemporalSequence', - Ev1, - [ 'Event', - [Term2,Truth2], - [Time2,Evidence2,EPrio2]]], - [ let, - [ 'Event', - [Term1,Truth1], - [Time1,Evidence1,EPrio1]], - ['Projection',Ev1,Time2], - [ 'Event', - [ [ Term1 , &/ , Term2 ], - [ 'Truth_Intersection', Truth1 , Truth2 ]], - [ Time2, - ['TupleConcat',Evidence1,Evidence2], - [0,0.0]]]]). - -%;Form a temporal implication between two events -metta_defn_ES( - [ 'TemporalImplication', - Ev1, - [ 'Event', - [Term2,Truth2], - [Time2,Evidence2,EPrio2]]], - [ let, - [ 'Event', - [Term1,Truth1], - [Time1,Evidence1,EPrio1]], - ['Projection',Ev1,Time2], - [ 'Event', - [ [ Term1 , =/> , Term2 ], - [ 'Truth_Induction', Truth1 , Truth2 ]], - [ Time2, - ['TupleConcat',Evidence1,Evidence2], - [0,0.0]]]]). - -%;Whether an event's term is an operation -metta_defn_ES( - [ 'IsOp', - [ 'Event', - [Term,Truth], - Metadata]], - [ case, - Term, - [ [ [^,Opname], - 'True'], - [Otherwise,'False']]]). - -%;Find implications in the event FIFO: -%;procedural implications -metta_defn_ES( - [ 'TemporalImplicationInduction', - [ Cons, - [ Op, - [Prec,Tail]]]], - [ 'If', - [ and, - ['IsOp',Op], - [ and, - [ not, - ['IsOp',Cons]], - [ not, - ['IsOp',Prec]]]], - [ let, - PrecOp, - ['TemporalSequence',Prec,Op], - ['TemporalImplication',PrecOp,Cons]]]). - -%;and temporal without operation -metta_defn_ES( - [ 'TemporalImplicationInduction', - [ Cons, - [Prec,Tail]]], - [ 'If', - [ and, - [ not, - ['IsOp',Prec]], - [ not, - ['IsOp',Cons]]], - ['TemporalImplication',Prec,Cons]]). - -%;Add negative evidence for implications which predicted the input unsuccessfully -metta_defn_ES( - ['NegConfirmation',PrecTerm,ObservedCons,T], - [ let, - [ 'Event', - [ [PrecTerm,=/>,PredictedCons], - ImpTV], - ImpMetadata], - [ 'EternalQuestion', - [PrecTerm,=/>,PredictedCons]], - [ 'If', - [ not, - [==,ObservedCons,PredictedCons]], - [ 'UpdateConcept', - [ 'Event', - [ [ PrecTerm , =/> ,PredictedCons], - [ 0.0 , 0.1 ]], - [ T, - [], - [0,0.0]]], - T]]]). - -%;Check if the implication's preconditions are met to anticipate the by the implication predicted outcome -get_metta_atom(Eq, '&self', [ - =, - [ 'Anticipate', - [Pos,[]], - T]]). - -metta_defn_ES( - [ 'Anticipate', - [ Pos, - [Pre,[]]], - T], - [ 'let*', - [ [ [ 'Event', - [PreTerm,PreTV], - PreMetadata], - Pre], - [ [ 'Event', - [PosTerm,PosTV], - PosMetadata], - Pos]], - [ 'If', - [ not, - ['IsOp',Pre]], - ['NegConfirmation',PreTerm,PosTerm,T]]]). - -metta_defn_ES( - [ 'Anticipate', - [ Pos, - [ Op, - [Pre,Trail]]], - T], - [ 'let*', - [ [ [ 'Event', - [PreTerm,PreTV], - PreMetadata], - Pre], - [ [ 'Event', - [OpTerm,OpTV], - OpMetadata], - Op], - [ [ 'Event', - [PosTerm,PosTV], - PosMetadata], - Pos], - [ Sequence, - [Pre,&/,'Pos']]], - [ 'If', - [ and, - ['IsOp',Op], - [ not, - ['IsOp',Pre]]], - [ 'NegConfirmation', - [PreTerm,&/,OpTerm], PosTerm,T]]]). - -%;;Input procedure -metta_defn_ES( - ['AddBeliefEvent',Sentence], - [ 'let*', - [ [ [ T , EvidentialBase ], - [ 'GetReasonerState']], - [ InputEvent, - [ 'Event', - Sentence, - [ T, - EvidentialBase, - [T,1.0]]]]], - [ do, - [ sequential, - [ ['EventToFIFO',InputEvent], - [ let, - InducedHypothesis, - [ 'TemporalImplicationInduction', - ['get-state','&FIFO']], - ['UpdateConcept',InducedHypothesis,T]], - ['ProcessBeliefEvent',InputEvent,T], - [ 'Anticipate', - ['get-state','&FIFO'], - T], - ['BeliefCycle',T]]]]]). - -%;;Procedural inference (decision making with operation execution and subgoaling) -%;Derived goal event priority -metta_defn_ES( - ['SubgoalPriority',EPrio,ConcTV], - [ *, - EPrio, - ['Truth_Expectation',ConcTV]]). - -%;Expectation of an operation is the truth expectation of its desire value -metta_defn_ES( - [ 'OpExpectation', - [ 'Decision', - [Opname,DVOp], - Subgoal], - T], - ['Truth_Expectation',DVOp]). - -%;Inject executed operation as an event and return its name -metta_defn_ES( - ['Execute',Opname], - [ superpose, - [ [ 'AddBeliefEvent', - [ Opname, - [1.0,0.9]]], - Opname]]). - -%;Add subgoals to the PQ -metta_defn_ES( - ['DeriveSubgoals',Options], - [ do, - [ let, - ['Decision',Op,Subgoal], - [superpose,Options], - ['add-atom','&goal_events',Subgoal]]]). - -%;execute the operation which most likely gets the goal achieved in current contexts, and if contexts are not yet fulfilled, derive them as subgoals -metta_defn_ES( - [ 'BestDecision', - T, - [ 'Event', - [Term,DV], - [GoalTime,GoalEvBase,GoalPrio]], - FIFO], - [ let, - Options, - [ collapse, - [ 'let*', - [ [ [ 'Event', - [ [ [ Prec, - &/, - [^,Op]], =/>,Term], - ImpTV], - [ImpTime,ImpEvBase,ImpPrio]], - [ 'EternalQuestion', - [ [ Prec, - &/, - [^,Op]], =/>,Term]]], - [ DVPrecOp, - ['Truth_Deduction',DV,ImpTV]], - [ [ 'Event', - [PrecTerm,PrecTV], - PrecMetadata], - [ 'Projection', - ['EventQuestion',Prec], - T]], - [ DVOp, - ['Truth_Deduction',PrecTV,DVPrecOp]], - [ DVPrec, - ['Truth_StructuralDeduction',DVPrecOp]], - [ SubgoalStamp, - ['TupleConcat',GoalEvBase,ImpEvBase]]], - [ 'If', - ['StampDisjoint',SubgoalStamp], - [ 'Decision', - [ [^,Op], - DVOp], - [ 'Event', - [ Prec, - ['Truth_StructuralDeduction',DVPrecOp]], - [ T, - SubgoalStamp, - [ T, - [ 'SubgoalPriority', - ['EventPriorityNow',GoalPrio,T], - DVPrec]]]]]]]], - [ let, - [ 'Decision', - [Opname,DVOp], - Subgoal], - ['BestCandidate',Options,'OpExpectation',T], - [ 'If', - [ >, - ['Truth_Expectation',DVOp], - 0.5], - ['Execute',Opname], - ['DeriveSubgoals',Options]]]]). - -%;;select the highest priority goal event from the PQ and use it for decision making -metta_defn_ES( - ['GoalCycle',T], - [ sequential, - [ [ let, - Ev, - ['SelectHighestPriorityEvent','&goal_events',T], - [ sequential, - [ [ do, - ['remove-atom','&goal_events',Ev]], - [ 'BestDecision', T,Ev, - ['get-state','&FIFO']]]]], - [ do, - ['UpdateReasonerState']], - [ do, - [ 'BoundEvents', '&goal_events',0.0,0.1, - ['GoalEventsMax'], - T]]]]). - -%;;Input procedure -metta_defn_ES( - ['AddGoalEvent',Sentence], - [ 'let*', - [ [ [ T , EvidentialBase ], - [ 'GetReasonerState']], - [ InputEvent, - [ 'Event', - Sentence, - [ T, - EvidentialBase, - [T,1.0]]]]], - [ sequential, - [ [ do, - ['add-atom','&goal_events',InputEvent]], - ['GoalCycle',T]]]]). - -:-metta_eval([print,'$STRING'("NARS test!!!!!!!!!!!!!!!!!!")]). - -:-metta_eval(['mettalog::vspace-main']). - -( :- ( - metta_eval( [ 'AddBeliefEvent', - [ [ ['{',garfield,'}'], -->,cat], - [1.0,0.9]]])) ). - -metta_defn_ES( - [ 'AddBeliefEvent', - [ [ ['{',garfield,'}'], -->,cat], - [1.0,0.9]]], - [ 'let*', - [ [ [ A , B ], - [ 'GetReasonerState']], - [ C, - [ 'Event', - [ [ ['{',garfield,'}'], -->,cat], - [1.0,0.9]], - [ A, - B, - [A,1.0]]]]], - [ do, - [ sequential, - [ ['EventToFIFO',C], - [ let, - D, - [ 'TemporalImplicationInduction', - ['get-state','&FIFO']], - ['UpdateConcept',D,A]], - ['ProcessBeliefEvent',C,A], - [ 'Anticipate', - ['get-state','&FIFO'], - A], - ['BeliefCycle',A]]]]]). - -( :- ( - metta_eval( [ 'AddBeliefEvent', - [ [ [cat,*,sky], -->,like], - [1.0,0.9]]])) ). - -metta_defn_ES( - [ 'AddBeliefEvent', - [ [ [cat,*,sky], -->,like], - [1.0,0.9]]], - [ 'let*', - [ [ [ A , B ], - [ 'GetReasonerState']], - [ C, - [ 'Event', - [ [ [cat,*,sky], -->,like], - [1.0,0.9]], - [ A, - B, - [A,1.0]]]]], - [ do, - [ sequential, - [ ['EventToFIFO',C], - [ let, - D, - [ 'TemporalImplicationInduction', - ['get-state','&FIFO']], - ['UpdateConcept',D,A]], - ['ProcessBeliefEvent',C,A], - [ 'Anticipate', - ['get-state','&FIFO'], - A], - ['BeliefCycle',A]]]]]). - -( :- ( - metta_eval( [ 'AddBeliefEvent', - [ [ sky, - -->, - [ '$OBJ'(claz_bracket_vector,[blue])]], - [1.0,0.9]]])) ). - -metta_defn_ES( - [ 'AddBeliefEvent', - [ [ sky, - -->, - [ '$OBJ'(claz_bracket_vector,[blue])]], - [1.0,0.9]]], - [ 'let*', - [ [ [ A , B ], - [ 'GetReasonerState']], - [ C, - [ 'Event', - [ [ sky, - -->, - [ '$OBJ'(claz_bracket_vector,[blue])]], - [1.0,0.9]], - [ A, - B, - [A,1.0]]]]], - [ do, - [ sequential, - [ ['EventToFIFO',C], - [ let, - D, - [ 'TemporalImplicationInduction', - ['get-state','&FIFO']], - ['UpdateConcept',D,A]], - ['ProcessBeliefEvent',C,A], - [ 'Anticipate', - ['get-state','&FIFO'], - A], - ['BeliefCycle',A]]]]]). - -%;The following question needs both a deduction and abduction step: -( :- ( - metta_eval( [ 'EternalQuestion', - [ [ ['{',garfield,'}'], - *, - [ '$OBJ'(claz_bracket_vector,[blue])]], -->,like]])) ). - -metta_defn_ES( - [ 'EternalQuestion', - [ [ ['{',garfield,'}'], - *, - [ '$OBJ'(claz_bracket_vector,[blue])]], -->,like]], - [ case, - [ match, - [ superpose, - ['&attentional_focus','&concepts']], - [ 'Concept', - [ [ ['{',garfield,'}'], - *, - [ '$OBJ'(claz_bracket_vector,[blue])]], -->,like], A,_,_], - A], - [ [B,B], - [ '%void%', - [ 'Event', - [ 'None', - [0.5,0.0]], - [eternal,[],0.0]]]]]). - -%;expected: [(Event (((({ garfield }) * ([ blue ])) --> like) (1.0 0.2965825874694874)) (eternal (Cons 2 (Cons 1 (Cons 3 Nil))) 0.643288027761712))] -%;Lets stress the control mechanism as these type of events with common extension or intension causes dozens of derivations: -( :- ( - metta_eval( [ 'AddBeliefEvent', - [ [ A ,-->,cat], - [ 1.0,0.9]]])) ). - -metta_defn_ES( - [ 'AddBeliefEvent', - [ [ 'A',-->,cat], - [ 1.0,0.9]]], - [ 'let*', - [ [ [ A , B ], - [ 'GetReasonerState']], - [ C, - [ 'Event', - [ [ 'A',-->,cat], - [ 1.0,0.9]], - [ A, - B, - [A,1.0]]]]], - [ do, - [ sequential, - [ ['EventToFIFO',C], - [ let, - D, - [ 'TemporalImplicationInduction', - ['get-state','&FIFO']], - ['UpdateConcept',D,A]], - ['ProcessBeliefEvent',C,A], - [ 'Anticipate', - ['get-state','&FIFO'], - A], - ['BeliefCycle',A]]]]]). - -( :- ( - metta_eval( [ 'AddBeliefEvent', - [ [ B ,-->,cat], - [ 1.0,0.9]]])) ). - -metta_defn_ES( - [ 'AddBeliefEvent', - [ [ 'B',-->,cat], - [ 1.0,0.9]]], - [ 'let*', - [ [ [ A , B ], - [ 'GetReasonerState']], - [ C, - [ 'Event', - [ [ 'B',-->,cat], - [ 1.0,0.9]], - [ A, - B, - [A,1.0]]]]], - [ do, - [ sequential, - [ ['EventToFIFO',C], - [ let, - D, - [ 'TemporalImplicationInduction', - ['get-state','&FIFO']], - ['UpdateConcept',D,A]], - ['ProcessBeliefEvent',C,A], - [ 'Anticipate', - ['get-state','&FIFO'], - A], - ['BeliefCycle',A]]]]]). - -( :- ( - metta_eval( [ 'AddBeliefEvent', - [ [ C ,-->,cat], - [ 1.0,0.9]]])) ). - -metta_defn_ES( - [ 'AddBeliefEvent', - [ [ 'C',-->,cat], - [ 1.0,0.9]]], - [ 'let*', - [ [ [ A , B ], - [ 'GetReasonerState']], - [ C, - [ 'Event', - [ [ 'C',-->,cat], - [ 1.0,0.9]], - [ A, - B, - [A,1.0]]]]], - [ do, - [ sequential, - [ ['EventToFIFO',C], - [ let, - D, - [ 'TemporalImplicationInduction', - ['get-state','&FIFO']], - ['UpdateConcept',D,A]], - ['ProcessBeliefEvent',C,A], - [ 'Anticipate', - ['get-state','&FIFO'], - A], - ['BeliefCycle',A]]]]]). - -:-metta_eval(['EternalQuestion',[['A',&,'B'],-->,cat]]). - -metta_defn_ES( - [ 'EternalQuestion', - [['A',&,'B'],-->,cat]], - [ case, - [ match, - [ superpose, - ['&attentional_focus','&concepts']], - [ 'Concept', - [['A',&,'B'],-->,cat], A,_,_], - A], - [ [B,B], - [ '%void%', - [ 'Event', - [ 'None', - [0.5,0.0]], - [eternal,[],0.0]]]]]). - -%;expected: [(Event (((A & B) --> cat) (1.0 0.44751381215469616)) (eternal (Cons 4 (Cons 5 Nil)) (5 0.4525)))] -:-metta_eval(['EternalQuestion',[['B',&,'C'],-->,cat]]). - -metta_defn_ES( - [ 'EternalQuestion', - [['B',&,'C'],-->,cat]], - [ case, - [ match, - [ superpose, - ['&attentional_focus','&concepts']], - [ 'Concept', - [['B',&,'C'],-->,cat], A,_,_], - A], - [ [B,B], - [ '%void%', - [ 'Event', - [ 'None', - [0.5,0.0]], - [eternal,[],0.0]]]]]). - -%;expected: [(Event (((B & C) --> cat) (1.0 0.44751381215469616)) (eternal (Cons 5 (Cons 6 Nil)) (6 0.4525)))] -( :- ( - metta_eval( [ 'EternalQuestion', - [ [['A',&,'B'],&,'C'], -->,cat]])) ). - -metta_defn_ES( - [ 'EternalQuestion', - [ [['A',&,'B'],&,'C'], -->,cat]], - [ case, - [ match, - [ superpose, - ['&attentional_focus','&concepts']], - [ 'Concept', - [ [['A',&,'B'],&,'C'], -->,cat], A,_,_], - A], - [ [B,B], - [ '%void%', - [ 'Event', - [ 'None', - [0.5,0.0]], - [eternal,[],0.0]]]]]). - -%;expected: [(Event ((((A & B) & C) --> cat) (1.0 0.42163100057836905)) (eternal (Cons 5 (Cons 4 (Cons 6 Nil))) (6 0.195593125))) -( :- ( - metta_eval( [ 'AddBeliefEvent', - [ [ [ ['{',garfield,'}'], - *, - [ '$OBJ'(claz_bracket_vector,[blue])]], -->,like], - [1.0,0.9]]])) ). - -metta_defn_ES( - [ 'AddBeliefEvent', - [ [ [ ['{',garfield,'}'], - *, - [ '$OBJ'(claz_bracket_vector,[blue])]], -->,like], - [1.0,0.9]]], - [ 'let*', - [ [ [ A , B ], - [ 'GetReasonerState']], - [ C, - [ 'Event', - [ [ [ ['{',garfield,'}'], - *, - [ '$OBJ'(claz_bracket_vector,[blue])]], -->,like], - [1.0,0.9]], - [ A, - B, - [A,1.0]]]]], - [ do, - [ sequential, - [ ['EventToFIFO',C], - [ let, - D, - [ 'TemporalImplicationInduction', - ['get-state','&FIFO']], - ['UpdateConcept',D,A]], - ['ProcessBeliefEvent',C,A], - [ 'Anticipate', - ['get-state','&FIFO'], - A], - ['BeliefCycle',A]]]]]). - -( :- ( - metta_eval( [ 'EternalQuestion', - [ [ ['{',garfield,'}'], - *, - [ '$OBJ'(claz_bracket_vector,[blue])]], -->,like]])) ). - -metta_defn_ES( - [ 'EternalQuestion', - [ [ ['{',garfield,'}'], - *, - [ '$OBJ'(claz_bracket_vector,[blue])]], -->,like]], - [ case, - [ match, - [ superpose, - ['&attentional_focus','&concepts']], - [ 'Concept', - [ [ ['{',garfield,'}'], - *, - [ '$OBJ'(claz_bracket_vector,[blue])]], -->,like], A,_,_], - A], - [ [B,B], - [ '%void%', - [ 'Event', - [ 'None', - [0.5,0.0]], - [eternal,[],0.0]]]]]). - -%;expected: [(Event (((({ garfield }) * ([ blue ])) --> like) (1.0 0.5692683291397822)) (eternal (Cons 7 (Cons 2 (Cons 1 (Cons 3 Nil)))) 0.0))] -%;Please notice that it has revised it with the prior derived result, as you can also see in the evidence trail 1,2,3 being included -:-metta_eval(['mettalog::vspace-main']). - -%;debug: -:-metta_eval(['CollapseCardinality',['get-atoms','&belief_events']]). - -metta_defn_ES( - [ 'CollapseCardinality', - ['get-atoms','&belief_events']], - [ 'TupleCount', - [ collapse, - [ 'CountElement', - ['get-atoms','&belief_events']]]]). - -metta_defn_ES( - [ 'CountElement', - ['get-atoms','&belief_events']], - [ case, - ['get-atoms','&belief_events'], - [ [ _,1]]]). - -%;[8] -:-metta_eval(['CollapseCardinality',['get-atoms','&attentional_focus']]). - -metta_defn_ES( - [ 'CollapseCardinality', - ['get-atoms','&attentional_focus']], - [ 'TupleCount', - [ collapse, - [ 'CountElement', - ['get-atoms','&attentional_focus']]]]). - -metta_defn_ES( - [ 'CountElement', - ['get-atoms','&attentional_focus']], - [ case, - ['get-atoms','&attentional_focus'], - [ [ _,1]]]). - -%;[8] -:-metta_eval(['CollapseCardinality',['get-atoms','&concepts']]). - -metta_defn_ES( - [ 'CollapseCardinality', - ['get-atoms','&concepts']], - [ 'TupleCount', - [ collapse, - [ 'CountElement', - ['get-atoms','&concepts']]]]). - -metta_defn_ES( - [ 'CountElement', - ['get-atoms','&concepts']], - [ case, - ['get-atoms','&concepts'], - [ [ _,1]]]). - -%;[100] -:-metta_eval(['mettalog::vspace-main']). - -% 17,439,387 inferences, 1.561 CPU in 1.572 seconds (99% CPU, 11172049 Lips) - diff --git a/.Attic/metta_lang/metta_toplevel.pl.Unused b/.Attic/metta_lang/metta_toplevel.pl.Unused deleted file mode 100755 index 93c5a8f7005..00000000000 --- a/.Attic/metta_lang/metta_toplevel.pl.Unused +++ /dev/null @@ -1,2155 +0,0 @@ -/* Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: J.Wielemaker@vu.nl - WWW: http://www.swi-prolog.org - Copyright (c) 1985-2021, University of Amsterdam - VU University Amsterdam - SWI-Prolog Solutions b.v. - All rights reserved. - - 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. -*/ -/* -:- module('metta_toplevel', - [ '$initialise'/0, % start Prolog - 'metta_toplevel'/0, % Prolog top-level (re-entrant) - '$compile'/0, % `-c' toplevel - '$config'/0, % --dump-runtime-variables toplevel - initialize/0, % Run program '$initialization' - version/0, % Write initial banner - version/1, % Add message to the banner - prolog/0, % user toplevel predicate - 'metta_query_loop'/0, % toplevel predicate - 'metta_execute_query'/3, % +Query, +Bindings, -Truth - residual_goals/1, % +Callable - ('$initialization')/1, % '$initialization' goal (directive) - '$thread_init'/0, % initialise thread - (thread_initialization)/1 % thread '$initialization' goal - ]). -*/ - - /******************************* - * VERSION BANNER * - *******************************/ - -:- dynamic - prolog:version_msg/1. - -%! version is det. -% -% Print the Prolog banner message and messages registered using -% version/1. - -version :- - print_message(banner, welcome). - -%! version(+Message) is det. -% -% Add message to version/0 -/* -:- multifile - system:term_expansion/2. - -system:term_expansion((:- version(Message)), - prolog:version_msg(Message)). - -version(Message) :- - ( prolog:version_msg(Message) - -> true - ; assertz(prolog:version_msg(Message)) - ). -*/ - - /******************************** - * INITIALISATION * - *********************************/ - -%! load_init_file is det. -% -% Load the user customization file. This can be done using ``swipl -f -% file`` or simply using ``swipl``. In the first case we search the -% file both directly and over the alias `user_app_config`. In the -% latter case we only use the alias. - -load_init_file :- - '$cmd_option_val'(init_file, OsFile), - !, - prolog_to_os_filename(File, OsFile), - load_init_file(File, explicit). -load_init_file :- - load_init_file('init.pl', implicit). - -%! loaded_init_file(?Base, ?AbsFile) -% -% Used by prolog_load_context/2 to confirm we are loading a script. - -:- dynamic - loaded_init_file/2. % already loaded init files - -load_init_file(none, _) :- !. -load_init_file(Base, _) :- - loaded_init_file(Base, _), - !. -load_init_file(InitFile, explicit) :- - exists_file(InitFile), - !, - ensure_loaded(user:InitFile). -load_init_file(Base, _) :- - absolute_file_name(user_app_config(Base), InitFile, - [ access(read), - file_errors(fail) - ]), - asserta(loaded_init_file(Base, InitFile)), - load_files(user:InitFile, - [ scope_settings(false) - ]). -load_init_file('init.pl', implicit) :- - ( current_prolog_flag(windows, true), - absolute_file_name(user_profile('swipl.ini'), InitFile, - [ access(read), - file_errors(fail) - ]) - ; expand_file_name('~/.swiplrc', [InitFile]), - exists_file(InitFile) - ), - !, - print_message(warning, backcomp(init_file_moved(InitFile))). -load_init_file(_, _). - -'$load_system_init_file' :- - loaded_init_file(system, _), - !. -'$load_system_init_file' :- - '$cmd_option_val'(system_init_file, Base), - Base \== none, - current_prolog_flag(home, Home), - file_name_extension(Base, rc, Name), - symbolic_list_concat([Home, '/', Name], File), - absolute_file_name(File, Path, - [ file_type(prolog), - access(read), - file_errors(fail) - ]), - asserta(loaded_init_file(system, Path)), - load_files(user:Path, - [ silent(true), - scope_settings(false) - ]), - !. -'$load_system_init_file'. - -'$load_script_file' :- - loaded_init_file(script, _), - !. -'$load_script_file' :- - '$cmd_option_val'(script_file, OsFiles), - load_script_files(OsFiles). - -load_script_files([]). -load_script_files([OsFile|More]) :- - prolog_to_os_filename(File, OsFile), - ( absolute_file_name(File, Path, - [ file_type(prolog), - access(read), - file_errors(fail) - ]) - -> asserta(loaded_init_file(script, Path)), - load_files(user:Path, []), - load_files(More) - ; throw(error(existence_error(script_file, File), _)) - ). - - - /******************************* - * AT_INITIALISATION * - *******************************/ - -:- meta_predicate - '$initialization'(0). - -:- '$iso'(('$initialization')/1). - -%! '$initialization'(:Goal) -% -% Runs Goal after loading the file in which this directive -% appears as well as after restoring a saved state. -% -% @see '$initialization'/2 -/* -'$initialization'(Goal) :- - Goal = _:G, - prolog:initialize_now(G, Use), - !, - print_message(warning, initialize_now(G, Use)), - initialization(Goal, now). -'$initialization'(Goal) :- - initialization(Goal, after_load). - -:- multifile - prolog:initialize_now/2, - prolog:message//1. - -prolog:initialize_now(load_foreign_library(_), - 'use :- use_foreign_library/1 instead'). -prolog:initialize_now(load_foreign_library(_,_), - 'use :- use_foreign_library/2 instead'). - -prolog:message(initialize_now(Goal, Use)) --> - [ 'Initialization goal ~p will be executed'-[Goal],nl, - 'immediately for backward compatibility reasons', nl, - '~w'-[Use] - ]. - -'$run_initialization' :- - '$run_initialization'(_, []), - '$thread_init'. - -%! initialize -% -% Run goals registered with `:- '$initialization'(Goal, program).`. Stop -% with an exception if a goal fails or raises an exception. - -initialize :- - forall('$init_goal'(when(program), Goal, Ctx), - run_initialize(Goal, Ctx)). - -run_initialize(Goal, Ctx) :- - ( catch(Goal, E, true), - ( var(E) - -> true - ; throw(error(initialization_error(E, Goal, Ctx), _)) - ) - ; throw(error(initialization_error(failed, Goal, Ctx), _)) - ). - -*/ - /******************************* - * THREAD INITIALIZATION * - *******************************/ -/* -:- meta_predicate - thread_initialization(0). -:- dynamic - '$at_thread_initialization'/1. - -%! thread_initialization(:Goal) -% -% Run Goal now and everytime a new thread is created. - -thread_initialization(Goal) :- - assert('$at_thread_initialization'(Goal)), - call(Goal), - !. - -'$thread_init' :- - ( '$at_thread_initialization'(Goal), - ( call(Goal) - -> fail - ; fail - ) - ; true - ). -*/ - - /******************************* - * FILE SEARCH PATH (-p) * - *******************************/ -/* -%! '$set_file_search_paths' is det. -% -% Process -p PathSpec options. - -'$set_file_search_paths' :- - '$cmd_option_val'(search_paths, Paths), - ( '$member'(Path, Paths), - atom_chars(Path, Chars), - ( phrase('$search_path'(Name, Aliases), Chars) - -> '$reverse'(Aliases, Aliases1), - forall('$member'(Alias, Aliases1), - asserta(user:file_search_path(Name, Alias))) - ; print_message(error, commandline_arg_type(p, Path)) - ), - fail ; true - ). - -'$search_path'(Name, Aliases) --> - '$string'(NameChars), - [=], - !, - {atom_chars(Name, NameChars)}, - '$search_aliases'(Aliases). - -'$search_aliases'([Alias|More]) --> - '$string'(AliasChars), - path_sep, - !, - { '$make_alias'(AliasChars, Alias) }, - '$search_aliases'(More). -'$search_aliases'([Alias]) --> - '$string'(AliasChars), - '$eos', - !, - { '$make_alias'(AliasChars, Alias) }. - -path_sep --> - { current_prolog_flag(windows, true) - }, - !, - [;]. -path_sep --> - [:]. - -'$string'([]) --> []. -'$string'([H|T]) --> [H], '$string'(T). - -'$eos'([], []). - -'$make_alias'(Chars, Alias) :- - catch(term_to_atom(Alias, Chars), _, fail), - ( atom(Alias) - ; functor(Alias, F, 1), - F \== / - ), - !. -'$make_alias'(Chars, Alias) :- - atom_chars(Alias, Chars). - -*/ - /******************************* - * LOADING ASSIOCIATED FILES * - *******************************/ - -%! argv_files(-Files) is det. -% -% Update the Prolog flag `argv`, extracting the leading script files. -/* -argv_files(Files) :- - current_prolog_flag(argv, Argv), - no_option_files(Argv, Argv1, Files, ScriptArgs), - ( ( ScriptArgs == true - ; Argv1 == [] - ) - -> ( Argv1 \== Argv - -> set_prolog_flag(argv, Argv1) - ; true - ) - ; '$usage', - halt(1) - ). - -no_option_files([--|Argv], Argv, [], true) :- !. -no_option_files([Opt|_], _, _, ScriptArgs) :- - ScriptArgs \== true, - sub_atom(Opt, 0, _, _, '-'), - !, - '$usage', - halt(1). -no_option_files([OsFile|Argv0], Argv, [File|T], ScriptArgs) :- - file_name_extension(_, Ext, OsFile), - user:prolog_file_type(Ext, prolog), - !, - ScriptArgs = true, - prolog_to_os_filename(File, OsFile), - no_option_files(Argv0, Argv, T, ScriptArgs). -no_option_files([OsScript|Argv], Argv, [Script], ScriptArgs) :- - ScriptArgs \== true, - !, - prolog_to_os_filename(Script, OsScript), - ( exists_file(Script) - -> true - ; '$existence_error'(file, Script) - ), - ScriptArgs = true. -no_option_files(Argv, Argv, [], _). - -clean_argv :- - ( current_prolog_flag(argv, [--|Argv]) - -> set_prolog_flag(argv, Argv) - ; true - ). - -%! associated_files(-Files) -% -% If SWI-Prolog is started as ., where is -% the extension registered for associated files, set the Prolog -% flag associated_file, switch to the directory holding the file -% and -if possible- adjust the window title. - -associated_files([]) :- - current_prolog_flag(saved_program_class, runtime), - !, - clean_argv. -associated_files(Files) :- - '$set_prolog_file_extension', - argv_files(Files), - ( Files = [File|_] - -> absolute_file_name(File, AbsFile), - set_prolog_flag(associated_file, AbsFile), - set_working_directory(File), - set_window_title(Files) - ; true - ). - -%! set_working_directory(+File) -% -% When opening as a GUI application, e.g., by opening a file from -% the Finder/Explorer/..., we typically want to change working -% directory to the location of the primary file. We currently -% detect that we are a GUI app by the Prolog flag =console_menu=, -% which is set by swipl-win[.exe]. - -set_working_directory(File) :- - current_prolog_flag(console_menu, true), - access_file(File, read), - !, - file_directory_name(File, Dir), - working_directory(_, Dir). -set_working_directory(_). - -set_window_title([File|More]) :- - current_predicate(system:window_title/2), - !, - ( More == [] - -> Extra = [] - ; Extra = ['...'] - ), - symbolic_list_concat(['SWI-Prolog --', File | Extra], ' ', Title), - system:window_title(_, Title). -set_window_title(_). - - -%! start_pldoc -% -% If the option =|--pldoc[=port]|= is given, load the PlDoc -% system. - -start_pldoc :- - '$cmd_option_val'(pldoc_server, Server), - ( Server == '' - -> call((doc_server(_), doc_browser)) - ; catch(atom_number(Server, Port), _, fail) - -> call(doc_server(Port)) - ; print_message(error, option_usage(pldoc)), - halt(1) - ). -start_pldoc. - - -%! load_associated_files(+Files) -% -% Load Prolog files specified from the commandline. - -load_associated_files(Files) :- - ( '$member'(File, Files), - load_files(user:File, [expand(false)]), - fail - ; true - ). - -hkey('HKEY_CURRENT_USER/Software/SWI/Prolog'). -hkey('HKEY_LOCAL_MACHINE/Software/SWI/Prolog'). - -'$set_prolog_file_extension' :- - current_prolog_flag(windows, true), - hkey(Key), - catch(win_registry_get_value(Key, fileExtension, Ext0), - _, fail), - !, - ( atom_concat('.', Ext, Ext0) - -> true - ; Ext = Ext0 - ), - ( user:prolog_file_type(Ext, prolog) - -> true - ; asserta(user:prolog_file_type(Ext, prolog)) - ). -'$set_prolog_file_extension'. - -*/ - /******************************** - * TOPLEVEL GOALS * - *********************************/ -/* -%! '$initialise' is semidet. -% -% Called from PL_initialise() to do the Prolog part of the -% '$initialization'. If an exception occurs, this is printed and -% '$initialise' fails. - -'$initialise' :- - catch(initialise_prolog, E, initialise_error(E)). - -initialise_error('$aborted') :- !. -initialise_error(E) :- - print_message(error, initialization_exception(E)), - fail. -*/ -initialise_prolog :- - '$clean_history', - apple_setup_app, - '$run_initialization', - '$load_system_init_file', - set_toplevel, - '$set_file_search_paths', - init_debug_flags, - start_pldoc, - opt_attach_packs, - load_init_file, - catch(setup_colors, E, print_message(warning, E)), - associated_files(Files), - '$load_script_file', - load_associated_files(Files), - '$cmd_option_val'(goals, Goals), - ( Goals == [], - \+ '$init_goal'(when(_), _, _) - -> version % default interactive run - ; run_init_goals(Goals), - ( load_only - -> version - ; run_program_init, - run_main_init - ) - ). - -:- if(current_prolog_flag(apple,true)). -apple_set_working_directory :- - ( expand_file_name('~', [Dir]), - exists_directory(Dir) - -> working_directory(_, Dir) - ; true - ). - -apple_set_locale :- - ( getenv('LC_CTYPE', 'UTF-8'), - apple_current_locale_identifier(LocaleID), - atom_concat(LocaleID, '.UTF-8', Locale), - catch(setlocale(ctype, _Old, Locale), _, fail) - -> setenv('LANG', Locale), - unsetenv('LC_CTYPE') - ; true - ). - -apple_setup_app :- - current_prolog_flag(apple, true), - current_prolog_flag(console_menu, true), % SWI-Prolog.app on MacOS - apple_set_working_directory, - apple_set_locale. -:- endif. -apple_setup_app. - -opt_attach_packs :- - current_prolog_flag(packs, true), - !, - attach_packs. -opt_attach_packs. - -set_toplevel :- - '$cmd_option_val'(toplevel, TopLevelAtom), - catch(term_to_atom(TopLevel, TopLevelAtom), E, - (print_message(error, E), - halt(1))), - create_prolog_flag(toplevel_goal, TopLevel, [type(term)]). - -load_only :- - current_prolog_flag(os_argv, OSArgv), - memberchk('-l', OSArgv), - current_prolog_flag(argv, Argv), - \+ memberchk('-l', Argv). - -%! run_init_goals(+Goals) is det. -% -% Run registered '$initialization' goals on order. If a goal fails, -% execution is halted. - -run_init_goals([]). -run_init_goals([H|T]) :- - run_init_goal(H), - run_init_goals(T). - -run_init_goal(Text) :- - catch(term_to_atom(Goal, Text), E, - ( print_message(error, init_goal_syntax(E, Text)), - halt(2) - )), - run_init_goal(Goal, Text). - -%! run_program_init is det. -% -% Run goals registered using - -run_program_init :- - forall('$init_goal'(when(program), Goal, Ctx), - run_init_goal(Goal, @(Goal,Ctx))). - -run_main_init :- - findall(Goal-Ctx, '$init_goal'(when(main), Goal, Ctx), Pairs), - '$last'(Pairs, Goal-Ctx), - !, - ( current_prolog_flag(toplevel_goal, default) - -> set_prolog_flag(toplevel_goal, halt) - ; true - ), - run_init_goal(Goal, @(Goal,Ctx)). -run_main_init. - -run_init_goal(Goal, Ctx) :- - ( catch_with_backtrace(user:Goal, E, true) - -> ( var(E) - -> true - ; print_message(error, init_goal_failed(E, Ctx)), - halt(2) - ) - ; ( current_prolog_flag(verbose, silent) - -> Level = silent - ; Level = error - ), - print_message(Level, init_goal_failed(failed, Ctx)), - halt(1) - ). - -%! init_debug_flags is det. -% -% Initialize the various Prolog flags that control the debugger and -% toplevel. - -init_debug_flags :- - once(print_predicate(_, [print], PrintOptions)), - Keep = [keep(true)], - create_prolog_flag(answer_write_options, PrintOptions, Keep), - create_prolog_flag(prompt_alternatives_on, determinism, Keep), - create_prolog_flag(toplevel_extra_white_line, true, Keep), - create_prolog_flag(toplevel_print_factorized, false, Keep), - create_prolog_flag(print_write_options, - [ portray(true), quoted(true), numbervars(true) ], - Keep), - create_prolog_flag(toplevel_residue_vars, false, Keep), - create_prolog_flag(toplevel_list_wfs_residual_program, true, Keep), - '$set_debugger_write_options'(print). - -%! setup_backtrace -% -% Initialise printing a backtrace. - -setup_backtrace :- - ( \+ current_prolog_flag(backtrace, false), - load_setup_file(library(prolog_stack)) - -> true - ; true - ). - -%! setup_colors is det. -% -% Setup interactive usage by enabling colored output. - -setup_colors :- - ( \+ current_prolog_flag(color_term, false), - stream_property(user_input, tty(true)), - stream_property(user_error, tty(true)), - stream_property(user_output, tty(true)), - \+ getenv('TERM', dumb), - load_setup_file(user:library(ansi_term)) - -> true - ; true - ). - -%! setup_history -% -% Enable per-directory persistent history. - -setup_history :- - ( \+ current_prolog_flag(save_history, false), - stream_property(user_input, tty(true)), - \+ current_prolog_flag(readline, false), - load_setup_file(library(prolog_history)) - -> prolog_history(enable) - ; true - ), - set_default_history, - '$load_history'. - -%! setup_readline -% -% Setup line editing. - -setup_readline :- - ( current_prolog_flag(readline, swipl_win) - -> true - ; stream_property(user_input, tty(true)), - current_prolog_flag(tty_control, true), - \+ getenv('TERM', dumb), - ( current_prolog_flag(readline, ReadLine) - -> true - ; ReadLine = true - ), - readline_library(ReadLine, Library), - load_setup_file(library(Library)) - -> set_prolog_flag(readline, Library) - ; set_prolog_flag(readline, false) - ). - -readline_library(true, Library) :- - !, - preferred_readline(Library). -readline_library(false, _) :- - !, - fail. -readline_library(Library, Library). - -preferred_readline(editline). -preferred_readline(readline). - -%! load_setup_file(+File) is semidet. -% -% Load a file and fail silently if the file does not exist. - -load_setup_file(File) :- - catch(load_files(File, - [ silent(true), - if(not_loaded) - ]), _, fail). - - -:- '$hide'('metta_toplevel'/0). % avoid in the GUI stacktrace - -%! 'metta_toplevel' -% -% Called from PL_toplevel() - -'metta_toplevel' :- - '$runtoplevel', - print_message(informational, halt). - -%! '$runtoplevel' -% -% Actually run the toplevel. The values `default` and `prolog` both -% start the interactive toplevel, where `prolog` implies the user gave -% =|-t prolog|=. -% -% @see prolog/0 is the default interactive toplevel - -'$runtoplevel' :- - current_prolog_flag(toplevel_goal, TopLevel0), - toplevel_goal(TopLevel0, TopLevel), - user:TopLevel. - -:- dynamic setup_done/0. -:- volatile setup_done/0. - -toplevel_goal(default, 'metta_query_loop') :- - !, - setup_interactive. -toplevel_goal(prolog, 'metta_query_loop') :- - !, - setup_interactive. -toplevel_goal(Goal, Goal). - -setup_interactive :- - setup_done, - !. -setup_interactive :- - asserta(setup_done), - catch(setup_backtrace, E, print_message(warning, E)), - catch(setup_readline, E, print_message(warning, E)), - catch(setup_history, E, print_message(warning, E)). - -%! '$compile' -% -% Toplevel called when invoked with -c option. - -'$compile' :- - ( catch('$compile_', E, (print_message(error, E), halt(1))) - -> true - ; print_message(error, error(goal_failed('$compile'), _)), - halt(1) - ), - halt. % set exit code - -'$compile_' :- - '$load_system_init_file', - catch(setup_colors, _, true), - '$set_file_search_paths', - init_debug_flags, - '$run_initialization', - opt_attach_packs, - use_module(library(qsave)), - qsave:qsave_toplevel. - -%! '$config' -% -% Toplevel when invoked with --dump-runtime-variables -/* -'$config' :- - '$load_system_init_file', - '$set_file_search_paths', - init_debug_flags, - '$run_initialization', - load_files(library(prolog_config)), - ( catch(prolog_dump_runtime_variables, E, - (print_message(error, E), halt(1))) - -> true - ; print_message(error, error(goal_failed(prolog_dump_runtime_variables),_)) - ). - -*/ - /******************************** - * USER INTERACTIVE LOOP * - *********************************/ - -%! prolog -% -% Run the Prolog toplevel. This is now the same as break/0, which -% pretends to be in a break-level if there is a parent -% environment. - -%prolog :- break. - -:- create_prolog_flag(toplevel_mode, backtracking, []). - -%! 'metta_query_loop' -% -% Run the normal Prolog query loop. Note that the query is not -% protected by catch/3. Dealing with unhandled exceptions is done -% by the C-function query_loop(). This ensures that unhandled -% exceptions are really unhandled (in Prolog). - -'metta_query_loop' :- - current_prolog_flag(toplevel_mode, recursive), - !, - break_level(Level), - read_expanded_query(Level, Query, Bindings), - ( Query == end_of_file - -> print_message(query, query(eof)) - ; '$call_no_catch'('metta_execute_query'(Query, Bindings, _)), - ( current_prolog_flag(toplevel_mode, recursive) - -> 'metta_query_loop' - ; '$switch_toplevel_mode'(backtracking), - 'metta_query_loop' % Maybe throw('$switch_toplevel_mode')? - ) - ). -'metta_query_loop' :- - break_level(BreakLev), - repeat, - read_expanded_query(BreakLev, Query, Bindings), - ( Query == end_of_file - -> !, print_message(query, query(eof)) - ; 'metta_execute_query'(Query, Bindings, _), - ( current_prolog_flag(toplevel_mode, recursive) - -> !, - '$switch_toplevel_mode'(recursive), - 'metta_query_loop' - ; fail - ) - ). - -break_level(BreakLev) :- - ( current_prolog_flag(break_level, BreakLev) - -> true - ; BreakLev = -1 - ). - -read_expanded_query(BreakLev, ExpandedQuery, ExpandedBindings) :- - '$current_typein_module'(TypeIn), - ( stream_property(user_input, tty(true)) - -> '$system_prompt'(TypeIn, BreakLev, Prompt), - prompt(Old, '| ') - ; Prompt = '', - prompt(Old, '') - ), - trim_stacks, - trim_heap, - repeat, - read_query(Prompt, Query, Bindings), - prompt(_, Old), - catch(call_expand_query(Query, ExpandedQuery, - Bindings, ExpandedBindings), - Error, - (print_message(error, Error), fail)), - !. - -%! read_s_term_with_history(-Term, +Options) -% -% Read a term guide by Options and maintain a history similar to most -% Unix shells. -% -% When read_history reads a term of the form $silent(Goal), it will -% call Goal and pretend it has not seen anything. This hook is used by -% the GNU-Emacs interface to for communication between GNU-EMACS and -% SWI-Prolog. - -read_s_term_with_history(Term, Options) :- - '$option'(prompt(Prompt), Options, '~! metta>'), - '$option'(input(Input), Options, user_input), - repeat, - prompt_history(Prompt), - read_query_line(Input, Raw), - read_history_(Raw, Term, Options), - !. - - -%! read_query(+Prompt, -Goal, -Bindings) is det. -% -% Read the next query. The first clause deals with the case where -% !-based history is enabled. The second is used if we have command -% line editing. - - -:- if(current_prolog_flag(emscripten, true)). -read_query(_Prompt, Goal, Bindings) :- - '$can_yield', - !, - await(goal, GoalString), - term_string(Goal, GoalString, [variable_names(Bindings)]). -:- endif. -read_query(Prompt, Goal, Bindings) :- - current_prolog_flag(history, N), - integer(N), N > 0, - !, - read_s_term_with_history( - Goal, - [ show(h), - help('!h'), - no_save([trace, end_of_file]), - prompt(Prompt), - variable_names(Bindings) - ]). -read_query(Prompt, Goal, Bindings) :- - remove_history_prompt(Prompt, Prompt1), - repeat, % over syntax errors - prompt1(Prompt1), - read_query_line(user_input, Line), - '$save_history_line'(Line), % save raw line (edit syntax errors) - '$current_typein_module'(TypeIn), - catch(read_s_term_as_atom(Line, Goal, - [ variable_names(Bindings), - module(TypeIn) - ]), E, - ( print_message(error, E), - fail - )), - !, - '$save_history_event'(Line). % save event (no syntax errors) - -%! read_query_line(+Input, -Line) is det. - -read_query_line(Input, Line) :- - stream_property(Input, error(true)), - !, - Line = end_of_file. -read_query_line(Input, Line) :- - catch(read_s_term_as_atom(Input, Line), Error, true), - save_debug_after_read, - ( var(Error) - -> true - ; catch(print_message(error, Error), _, true), - ( Error = error(syntax_error(_),_) - -> fail - ; throw(Error) - ) - ). - -%! read_s_term_as_atom(+Input, -Line) -% -% Read the next term as an atom and skip to the newline or a -% non-space character. - -read_s_term_as_atom(In, Line) :- - read_metta(In,Line), - ( Line == end_of_file - -> true - ; skip_to_nl(In) - ). -/* -read_s_term_as_atom(In, Line) :- - '$raw_read'(In, Line), - ( Line == end_of_file - -> true - ; skip_to_nl(In) - ). -*/ - -%! skip_to_nl(+Input) is det. -% -% Read input after the term. Skips white space and %... comment -% until the end of the line or a non-blank character. - -skip_to_nl(In) :- - repeat, - peek_char(In, C), - ( C == '%' - -> skip(In, '\n') - ; char_type(C, space) - -> get_char(In, _), - C == '\n' - ; true - ), - !. - -remove_history_prompt('', '') :- !. -remove_history_prompt(Prompt0, Prompt) :- - atom_chars(Prompt0, Chars0), - clean_history_prompt_chars(Chars0, Chars1), - delete_leading_blanks(Chars1, Chars), - atom_chars(Prompt, Chars). - -clean_history_prompt_chars([], []). -clean_history_prompt_chars(['~', !|T], T) :- !. -clean_history_prompt_chars([H|T0], [H|T]) :- - clean_history_prompt_chars(T0, T). - -delete_leading_blanks([' '|T0], T) :- - !, - delete_leading_blanks(T0, T). -delete_leading_blanks(L, L). - - -%! set_default_history -% -% Enable !-based numbered command history. This is enabled by default -% if we are not running under GNU-emacs and we do not have our own -% line editing. - -set_default_history :- - current_prolog_flag(history, _), - !. -set_default_history :- - ( ( \+ current_prolog_flag(readline, false) - ; current_prolog_flag(emacs_inferior_process, true) - ) - -> create_prolog_flag(history, 0, []) - ; create_prolog_flag(history, 25, []) - ). - - - /******************************* - * TOPLEVEL DEBUG * - *******************************/ - -%! save_debug_after_read -% -% Called right after the toplevel read to save the debug status if -% it was modified from the GUI thread using e.g. -% -% == -% thread_signal(main, gdebug) -% == -% -% @bug Ideally, the prompt would change if debug mode is enabled. -% That is hard to realise with all the different console -% interfaces supported by SWI-Prolog. - -save_debug_after_read :- - current_prolog_flag(debug, true), - !, - save_debug. -save_debug_after_read. - -save_debug :- - ( tracing, - notrace - -> Tracing = true - ; Tracing = false - ), - current_prolog_flag(debug, Debugging), - set_prolog_flag(debug, false), - create_prolog_flag(query_debug_settings, - debug(Debugging, Tracing), []). - -restore_debug :- - current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)), - set_prolog_flag(debug, Debugging), - ( Tracing == true - -> trace - ; true - ). - -%:- '$initialization'(create_prolog_flag(query_debug_settings, debug(false, false), [])). - - - /******************************** - * PROMPTING * - ********************************/ - -'$system_prompt'(Module, BrekLev, Prompt) :- - current_prolog_flag(toplevel_prompt, PAtom), - atom_codes(PAtom, P0), - ( Module \== user - -> '$substitute'('~m', [Module, ': '], P0, P1) - ; '$substitute'('~m', [], P0, P1) - ), - ( BrekLev > 0 - -> '$substitute'('~l', ['[', BrekLev, '] '], P1, P2) - ; '$substitute'('~l', [], P1, P2) - ), - current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)), - ( Tracing == true - -> '$substitute'('~d', ['[trace] '], P2, P3) - ; Debugging == true - -> '$substitute'('~d', ['[debug] '], P2, P3) - ; '$substitute'('~d', [], P2, P3) - ), - atom_chars(Prompt, P3). - -'$substitute'(From, T, Old, New) :- - atom_codes(From, FromCodes), - phrase(subst_chars(T), T0), - '$append'(Pre, S0, Old), - '$append'(FromCodes, Post, S0) -> - '$append'(Pre, T0, S1), - '$append'(S1, Post, New), - !. -'$substitute'(_, _, Old, Old). - -subst_chars([]) --> - []. -subst_chars([H|T]) --> - { atomic(H), - !, - atom_codes(H, Codes) - }, - Codes, - subst_chars(T). -subst_chars([H|T]) --> - H, - subst_chars(T). - - - /******************************** - * EXECUTION * - ********************************/ - -%! 'metta_execute_query'(Goal, Bindings, -Truth) is det. -% -% Execute Goal using Bindings. - -'metta_execute_query'(Var, _, true) :- - var(Var), - !, - print_message(informational, var_query(Var)). -'metta_execute_query'(Goal, Bindings, Truth) :- - '$current_typein_module'(TypeIn), - '$dwim_correct_goal'(TypeIn:Goal, Bindings, Corrected), - !, - setup_call_cleanup( - '$set_source_module'(M0, TypeIn), - expand_goal(Corrected, Expanded), - '$set_source_module'(M0)), - print_message(silent, toplevel_goal(Expanded, Bindings)), - '$execute_goal2'(Expanded, Bindings, Truth). -'metta_execute_query'(_, _, false) :- - notrace, - print_message(query, query(no)). - -'$execute_goal2'(Goal, Bindings, true) :- - restore_debug, - '$current_typein_module'(TypeIn), - residue_vars(TypeIn:Goal, Vars, TypeIn:Delays, Chp), - deterministic(Det), - ( save_debug - ; restore_debug, fail - ), - flush_output(user_output), - ( Det == true - -> DetOrChp = true - ; DetOrChp = Chp - ), - call_expand_answer(Bindings, NewBindings), - ( \+ \+ write_bindings(NewBindings, Vars, Delays, DetOrChp) - -> ! - ). -'$execute_goal2'(_, _, false) :- - save_debug, - print_message(query, query(no)). - -residue_vars(Goal, Vars, Delays, Chp) :- - current_prolog_flag(toplevel_residue_vars, true), - !, - '$wfs_call'(call_residue_vars(stop_backtrace(Goal, Chp), Vars), Delays). -residue_vars(Goal, [], Delays, Chp) :- - '$wfs_call'(stop_backtrace(Goal, Chp), Delays). - -stop_backtrace(Goal, Chp) :- - toplevel_call(Goal), - prolog_current_choice(Chp). - -toplevel_call(Goal) :- - call(Goal), - no_lco. - -no_lco. - -%! write_bindings(+Bindings, +ResidueVars, +Delays, +DetOrChp) -%! is semidet. -% -% Write bindings resulting from a query. The flag -% prompt_alternatives_on determines whether the user is prompted -% for alternatives. =groundness= gives the classical behaviour, -% =determinism= is considered more adequate and informative. -% -% Succeeds if the user accepts the answer and fails otherwise. -% -% @arg ResidueVars are the residual constraints and provided if -% the prolog flag `toplevel_residue_vars` is set to -% `project`. - -write_bindings(Bindings, ResidueVars, Delays, DetOrChp) :- - '$current_typein_module'(TypeIn), - translate_bindings(Bindings, Bindings1, ResidueVars, TypeIn:Residuals), - omit_qualifier(Delays, TypeIn, Delays1), - name_vars(Bindings1, Residuals, Delays1), - write_bindings2(Bindings1, Residuals, Delays1, DetOrChp). - -write_bindings2([], Residuals, Delays, _) :- - current_prolog_flag(prompt_alternatives_on, groundness), - !, - print_message(query, query(yes(Delays, Residuals))). -write_bindings2(Bindings, Residuals, Delays, true) :- - current_prolog_flag(prompt_alternatives_on, determinism), - !, - print_message(query, query(yes(Bindings, Delays, Residuals))). -write_bindings2(Bindings, Residuals, Delays, Chp) :- - repeat, - print_message(query, query(more(Bindings, Delays, Residuals))), - get_respons(Action, Chp), - ( Action == redo - -> !, fail - ; Action == show_again - -> fail - ; !, - print_message(query, query(done)) - ). - -name_vars(Bindings, Residuals, Delays) :- - current_prolog_flag(toplevel_name_variables, true), - !, - '$term_multitons'(t(Bindings,Residuals,Delays), Vars), - name_vars_(Vars, Bindings, 0), - term_variables(t(Bindings,Residuals,Delays), SVars), - anon_vars(SVars). -name_vars(_Bindings, _Residuals, _Delays). - -name_vars_([], _, _). -name_vars_([H|T], Bindings, N) :- - name_var(Bindings, Name, N, N1), - H = '$VAR'(Name), - name_vars_(T, Bindings, N1). - -anon_vars([]). -anon_vars(['$VAR'('_')|T]) :- - anon_vars(T). - -name_var(Bindings, Name, N0, N) :- - between(N0, infinite, N1), - I is N1//26, - J is 0'A + N1 mod 26, %' - ( I == 0 - -> format(atom(Name), '_~c', [J]) - ; format(atom(Name), '_~c~d', [J, I]) - ), - ( current_prolog_flag(toplevel_print_anon, false) - -> true - ; \+ is_bound(Bindings, Name) - ), - !, - N is N1+1. - -is_bound([Vars=_|T], Name) :- - ( in_vars(Vars, Name) - -> true - ; is_bound(T, Name) - ). - -in_vars(Name, Name) :- !. -in_vars(Names, Name) :- - '$member'(Name, Names). - -%! residual_goals(:NonTerminal) -% -% Directive that registers NonTerminal as a collector for residual -% goals. -/* -:- multifile - residual_goal_collector/1. - -:- meta_predicate - residual_goals(2). - -residual_goals(NonTerminal) :- - throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)). - -system:term_expansion((:- residual_goals(NonTerminal)), - 'metta_toplevel':residual_goal_collector(M2:Head)) :- - \+ current_prolog_flag(xref, true), - prolog_load_context(module, M), - strip_module(M:NonTerminal, M2, Head), - '$must_be'(callable, Head). - -%! prolog:residual_goals// is det. -% -% DCG that collects residual goals that are not associated with -% the answer through attributed variables. - -:- public prolog:residual_goals//0. - -prolog:residual_goals --> - { findall(NT, residual_goal_collector(NT), NTL) }, - collect_residual_goals(NTL). - -collect_residual_goals([]) --> []. -collect_residual_goals([H|T]) --> - ( call(H) -> [] ; [] ), - collect_residual_goals(T). -*/ - - -%! prolog:translate_bindings(+Bindings0, -Bindings, +ResidueVars, -%! +ResidualGoals, -Residuals) is det. -% -% Translate the raw variable bindings resulting from successfully -% completing a query into a binding list and list of residual -% goals suitable for human consumption. -% -% @arg Bindings is a list of binding(Vars,Value,Substitutions), -% where Vars is a list of variable names. E.g. -% binding(['A','B'],42,[])` means that both the variable -% A and B have the value 42. Values may contain terms -% '$VAR'(Name) to indicate sharing with a given variable. -% Value is always an acyclic term. If cycles appear in the -% answer, Substitutions contains a list of substitutions -% that restore the original term. -% -% @arg Residuals is a pair of two lists representing residual -% goals. The first element of the pair are residuals -% related to the query variables and the second are -% related that are disconnected from the query. -/* -:- public - prolog:translate_bindings/5. -:- meta_predicate - prolog:translate_bindings(+, -, +, +, :). - -prolog:translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals) :- - translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals). -*/ -translate_bindings(Bindings0, Bindings, ResidueVars, Residuals) :- - prolog:residual_goals(ResidueGoals, []), - translate_bindings(Bindings0, Bindings, ResidueVars, ResidueGoals, - Residuals). - -translate_bindings(Bindings0, Bindings, [], [], _:[]-[]) :- - term_attvars(Bindings0, []), - !, - join_same_bindings(Bindings0, Bindings1), - factorize_bindings(Bindings1, Bindings2), - bind_vars(Bindings2, Bindings3), - filter_bindings(Bindings3, Bindings). -translate_bindings(Bindings0, Bindings, ResidueVars, ResGoals0, - TypeIn:Residuals-HiddenResiduals) :- - project_constraints(Bindings0, ResidueVars), - hidden_residuals(ResidueVars, Bindings0, HiddenResiduals0), - omit_qualifiers(HiddenResiduals0, TypeIn, HiddenResiduals), - copy_term(Bindings0+ResGoals0, Bindings1+ResGoals1, Residuals0), - '$append'(ResGoals1, Residuals0, Residuals1), - omit_qualifiers(Residuals1, TypeIn, Residuals), - join_same_bindings(Bindings1, Bindings2), - factorize_bindings(Bindings2, Bindings3), - bind_vars(Bindings3, Bindings4), - filter_bindings(Bindings4, Bindings). - -hidden_residuals(ResidueVars, Bindings, Goal) :- - term_attvars(ResidueVars, Remaining), - term_attvars(Bindings, QueryVars), - subtract_vars(Remaining, QueryVars, HiddenVars), - copy_term(HiddenVars, _, Goal). - -subtract_vars(All, Subtract, Remaining) :- - sort(All, AllSorted), - sort(Subtract, SubtractSorted), - ord_subtract(AllSorted, SubtractSorted, Remaining). - -ord_subtract([], _Not, []). -ord_subtract([H1|T1], L2, Diff) :- - diff21(L2, H1, T1, Diff). - -diff21([], H1, T1, [H1|T1]). -diff21([H2|T2], H1, T1, Diff) :- - compare(Order, H1, H2), - diff3(Order, H1, T1, H2, T2, Diff). - -diff12([], _H2, _T2, []). -diff12([H1|T1], H2, T2, Diff) :- - compare(Order, H1, H2), - diff3(Order, H1, T1, H2, T2, Diff). - -diff3(<, H1, T1, H2, T2, [H1|Diff]) :- - diff12(T1, H2, T2, Diff). -diff3(=, _H1, T1, _H2, T2, Diff) :- - ord_subtract(T1, T2, Diff). -diff3(>, H1, T1, _H2, T2, Diff) :- - diff21(T2, H1, T1, Diff). - - -%! project_constraints(+Bindings, +ResidueVars) is det. -% -% Call :project_attributes/2 if the Prolog flag -% `toplevel_residue_vars` is set to `project`. - -project_constraints(Bindings, ResidueVars) :- - !, - term_attvars(Bindings, AttVars), - phrase(attribute_modules(AttVars), Modules0), - sort(Modules0, Modules), - term_variables(Bindings, QueryVars), - project_attributes(Modules, QueryVars, ResidueVars). -project_constraints(_, _). - -project_attributes([], _, _). -project_attributes([M|T], QueryVars, ResidueVars) :- - ( current_predicate(M:project_attributes/2), - catch(M:project_attributes(QueryVars, ResidueVars), E, - print_message(error, E)) - -> true - ; true - ), - project_attributes(T, QueryVars, ResidueVars). - -attribute_modules([]) --> []. -attribute_modules([H|T]) --> - { get_attrs(H, Attrs) }, - attrs_modules(Attrs), - attribute_modules(T). - -attrs_modules([]) --> []. -attrs_modules(att(Module, _, More)) --> - [Module], - attrs_modules(More). - - -%! join_same_bindings(Bindings0, Bindings) -% -% Join variables that are bound to the same value. Note that we -% return the _last_ value. This is because the factorization may -% be different and ultimately the names will be printed as V1 = -% V2, ... VN = Value. Using the last, Value has the factorization -% of VN. - -join_same_bindings([], []). -join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :- - take_same_bindings(T0, V0, V, Names, T1), - join_same_bindings(T1, T). - -take_same_bindings([], Val, Val, [], []). -take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :- - V0 == V1, - !, - take_same_bindings(T0, V1, V, Names, T). -take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :- - take_same_bindings(T0, V0, V, Names, T). - - -%! omit_qualifiers(+QGoals, +TypeIn, -Goals) is det. -% -% Omit unneeded module qualifiers from QGoals relative to the -% given module TypeIn. - - -omit_qualifiers([], _, []). -omit_qualifiers([Goal0|Goals0], TypeIn, [Goal|Goals]) :- - omit_qualifier(Goal0, TypeIn, Goal), - omit_qualifiers(Goals0, TypeIn, Goals). - -omit_qualifier(M:G0, TypeIn, G) :- - M == TypeIn, - !, - omit_meta_qualifiers(G0, TypeIn, G). -omit_qualifier(M:G0, TypeIn, G) :- - predicate_property(TypeIn:G0, imported_from(M)), - \+ predicate_property(G0, transparent), - !, - G0 = G. -omit_qualifier(_:G0, _, G) :- - predicate_property(G0, built_in), - \+ predicate_property(G0, transparent), - !, - G0 = G. -omit_qualifier(M:G0, _, M:G) :- - atom(M), - !, - omit_meta_qualifiers(G0, M, G). -omit_qualifier(G0, TypeIn, G) :- - omit_meta_qualifiers(G0, TypeIn, G). - -omit_meta_qualifiers(V, _, V) :- - var(V), - !. -omit_meta_qualifiers((QA,QB), TypeIn, (A,B)) :- - !, - omit_qualifier(QA, TypeIn, A), - omit_qualifier(QB, TypeIn, B). -omit_meta_qualifiers(tnot(QA), TypeIn, tnot(A)) :- - !, - omit_qualifier(QA, TypeIn, A). -omit_meta_qualifiers(freeze(V, QGoal), TypeIn, freeze(V, Goal)) :- - callable(QGoal), - !, - omit_qualifier(QGoal, TypeIn, Goal). -omit_meta_qualifiers(when(Cond, QGoal), TypeIn, when(Cond, Goal)) :- - callable(QGoal), - !, - omit_qualifier(QGoal, TypeIn, Goal). -omit_meta_qualifiers(G, _, G). - - -%! bind_vars(+BindingsIn, -Bindings) -% -% Bind variables to '$VAR'(Name), so they are printed by the names -% used in the query. Note that by binding in the reverse order, -% variables bound to one another come out in the natural order. - -bind_vars(Bindings0, Bindings) :- - bind_query_vars(Bindings0, Bindings, SNames), - bind_skel_vars(Bindings, Bindings, SNames, 1, _). - -bind_query_vars([], [], []). -bind_query_vars([binding(Names,Var,[Var2=Cycle])|T0], - [binding(Names,Cycle,[])|T], [Name|SNames]) :- - Var == Var2, % also implies var(Var) - !, - '$last'(Names, Name), - Var = '$VAR'(Name), - bind_query_vars(T0, T, SNames). -bind_query_vars([B|T0], [B|T], AllNames) :- - B = binding(Names,Var,Skel), - bind_query_vars(T0, T, SNames), - ( var(Var), \+ attvar(Var), Skel == [] - -> AllNames = [Name|SNames], - '$last'(Names, Name), - Var = '$VAR'(Name) - ; AllNames = SNames - ). - - - -bind_skel_vars([], _, _, N, N). -bind_skel_vars([binding(_,_,Skel)|T], Bindings, SNames, N0, N) :- - bind_one_skel_vars(Skel, Bindings, SNames, N0, N1), - bind_skel_vars(T, Bindings, SNames, N1, N). - -%! bind_one_skel_vars(+Subst, +Bindings, +VarName, +N0, -N) -% -% Give names to the factorized variables that do not have a name -% yet. This introduces names _S, avoiding duplicates. If a -% factorized variable shares with another binding, use the name of -% that variable. -% -% @tbd Consider the call below. We could remove either of the -% A = x(1). Which is best? -% -% == -% ?- A = x(1), B = a(A,A). -% A = x(1), -% B = a(A, A), % where -% A = x(1). -% == - -bind_one_skel_vars([], _, _, N, N). -bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :- - ( var(Var) - -> ( '$member'(binding(Names, VVal, []), Bindings), - same_term(Value, VVal) - -> '$last'(Names, VName), - Var = '$VAR'(VName), - N2 = N0 - ; between(N0, infinite, N1), - atom_concat('_S', N1, Name), - \+ memberchk(Name, Names), - !, - Var = '$VAR'(Name), - N2 is N1 + 1 - ) - ; N2 = N0 - ), - bind_one_skel_vars(T, Bindings, Names, N2, N). - - -%! factorize_bindings(+Bindings0, -Factorized) -% -% Factorize cycles and sharing in the bindings. - -factorize_bindings([], []). -factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :- - '$factorize_term'(Value, Skel, Subst0), - ( current_prolog_flag(toplevel_print_factorized, true) - -> Subst = Subst0 - ; only_cycles(Subst0, Subst) - ), - factorize_bindings(T0, T). - - -only_cycles([], []). -only_cycles([B|T0], List) :- - ( B = (Var=Value), - Var = Value, - acyclic_term(Var) - -> only_cycles(T0, List) - ; List = [B|T], - only_cycles(T0, T) - ). - - -%! filter_bindings(+Bindings0, -Bindings) -% -% Remove bindings that must not be printed. There are two of them: -% Variables whose name start with '_' and variables that are only -% bound to themselves (or, unbound). - -filter_bindings([], []). -filter_bindings([H0|T0], T) :- - hide_vars(H0, H), - ( ( arg(1, H, []) - ; self_bounded(H) - ) - -> filter_bindings(T0, T) - ; T = [H|T1], - filter_bindings(T0, T1) - ). - -hide_vars(binding(Names0, Skel, Subst), binding(Names, Skel, Subst)) :- - hide_names(Names0, Skel, Subst, Names). - -hide_names([], _, _, []). -hide_names([Name|T0], Skel, Subst, T) :- - ( sub_atom(Name, 0, _, _, '_'), - current_prolog_flag(toplevel_print_anon, false), - sub_atom(Name, 1, 1, _, Next), - char_type(Next, prolog_var_start) - -> true - ; Subst == [], - Skel == '$VAR'(Name) - ), - !, - hide_names(T0, Skel, Subst, T). -hide_names([Name|T0], Skel, Subst, [Name|T]) :- - hide_names(T0, Skel, Subst, T). - -self_bounded(binding([Name], Value, [])) :- - Value == '$VAR'(Name). - -%! get_respons(-Action, +Chp) -% -% Read the continuation entered by the user. - -:- if(current_prolog_flag(emscripten, true)). -get_respons(Action, _Chp) :- - '$can_yield', - !, - await(more, ActionS), - atom_string(Action, ActionS). -:- endif. -get_respons(Action, Chp) :- - repeat, - flush_output(user_output), - get_single_char(Char), - answer_respons(Char, Chp, Action), - ( Action == again - -> print_message(query, query(action)), - fail - ; ! - ). - -answer_respons(Char, _, again) :- - '$in_reply'(Char, '?h'), - !, - print_message(help, query(help)). -answer_respons(Char, _, redo) :- - '$in_reply'(Char, ';nrNR \t'), - !, - print_message(query, if_tty([ansi(bold, ';', [])])). -answer_respons(Char, _, redo) :- - '$in_reply'(Char, 'tT'), - !, - trace, - save_debug, - print_message(query, if_tty([ansi(bold, '; [trace]', [])])). -answer_respons(Char, _, continue) :- - '$in_reply'(Char, 'ca\n\ryY.'), - !, - print_message(query, if_tty([ansi(bold, '.', [])])). -answer_respons(0'b, _, show_again) :- %' - !, - break. -answer_respons(0'*, Chp, show_again) :- %' - !, - print_last_chpoint(Chp). -answer_respons(Char, _, show_again) :- - print_predicate(Char, Pred, Options), - !, - print_message(query, if_tty(['~w'-[Pred]])), - set_prolog_flag(answer_write_options, Options). -answer_respons(-1, _, show_again) :- - !, - print_message(query, halt('EOF')), - halt(0). -answer_respons(Char, _, again) :- - print_message(query, no_action(Char)). - -print_predicate(0'w, [write], [ quoted(true), %' - spacing(next_argument) - ]). -print_predicate(0'p, [print], [ quoted(true), %' - portray(true), - max_depth(10), - spacing(next_argument) - ]). - - -print_last_chpoint(Chp) :- - current_predicate(print_last_choice_point/0), - !, - print_last_chpoint_(Chp). -print_last_chpoint(Chp) :- - use_module(library(prolog_stack), [print_last_choicepoint/2]), - print_last_chpoint_(Chp). - -print_last_chpoint_(Chp) :- - print_last_choicepoint(Chp, [message_level(information)]). - - - /******************************* - * EXPANSION * - *******************************/ - -:- user:dynamic(expand_query/4). -:- user:multifile(expand_query/4). - -call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :- - user:expand_query(Goal, Expanded, Bindings, ExpandedBindings), - !. -call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :- - toplevel_variables:expand_query(Goal, Expanded, Bindings, ExpandedBindings), - !. -call_expand_query(Goal, Goal, Bindings, Bindings). - - -:- user:dynamic(expand_answer/2). -:- user:multifile(expand_answer/2). - -call_expand_answer(Goal, Expanded) :- - user:expand_answer(Goal, Expanded), - !. -call_expand_answer(Goal, Expanded) :- - toplevel_variables:expand_answer(Goal, Expanded), - !. -call_expand_answer(Goal, Goal). - - - -/* Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: J.Wielemaker@vu.nl - WWW: http://www.swi-prolog.org - Copyright (c) 1985-2020, University of Amsterdam - VU University Amsterdam - CWI Amsterdam - All rights reserved. - - 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. -*/ -/* -:- module('$history', - [ read_term_with_history/2, % -Term, +Line - '$save_history_line'/1, % +Line - '$clean_history'/0, - '$load_history'/0, - '$save_history_event'/1 - ]). - -%! read_term_with_history(-Term, +Options) -% -% Read a term guide by Options and maintain a history similar to most -% Unix shells. -% -% When read_history reads a term of the form $silent(Goal), it will -% call Goal and pretend it has not seen anything. This hook is used by -% the GNU-Emacs interface to for communication between GNU-EMACS and -% SWI-Prolog. - -read_term_with_history(Term, Options) :- - '$option'(prompt(Prompt), Options, '~! ?> '), - '$option'(input(Input), Options, user_input), - repeat, - prompt_history(Prompt), - read_query_line(Input, Raw), - read_history_(Raw, Term, Options), - !. -*/ -read_history_(Raw, _Term, Options) :- - '$option'(show(Raw), Options, history), - list_history, - !, - fail. -read_history_(Raw, _Term, Options) :- - '$option'(help(Raw), Options, '!help'), - '$option'(show(Show), Options, '!history'), - print_message(help, history(help(Show, Raw))), - !, - fail. -read_history_(Raw, Term, Options) :- - expand_history(Raw, Expanded, Changed), - '$save_history_line'(Expanded), - '$option'(module(Module), Options, Var), - ( Module == Var - -> '$current_typein_module'(Module) - ; true - ), - ( '$select'(variable_names(Bindings), Options, Options1) - -> true - ; Options1 = Options, - i(Bindings) % ignore - ), - catch(read_term_from_atom(Expanded, Term0, - [ module(Module), - variable_names(Bindings0) - | Options1 - ]), - E, - ( print_message(error, E), - fail - )), - ( var(Term0) - -> Term = Term0, - Bindings = Bindings0 - ; Term0 = '$silent'(Goal) - -> user:ignore(Goal), - read_term_with_history(Term, Options) - ; save_event(Expanded, Options), - ( Changed == true - -> print_message(query, history(expanded(Expanded))) - ; true - ), - Term = Term0, - Bindings = Bindings0 - ). - -i(_). - -% list_history -% Write history events to the current output stream. - -list_history :- - ( '$history'(Last, _) - -> true - ; Last = 0 - ), - history_depth_(Depth), - plus(First, Depth, Last), - findall(Nr/Event, - ( between(First, Last, Nr), - '$history'(Nr, Event) - ), - Events), - print_message(query, history(history(Events))). - -'$clean_history' :- - retractall('$history'(_,_)). - -%! '$load_history' is det. -% -% Load persistent history using a hook - -'$load_history' :- - '$clean_history', - current_prolog_flag(history, Depth), - Depth > 0, - catch(prolog:history(current_input, load), _, true), !. -'$load_history'. - - -%% prompt_history(+Prompt) -% -% Give prompt, substituting '~!' by the event number. - -prompt_history('') :- - !, - ttyflush. -prompt_history(Prompt) :- - ( '$history'(Last, _) - -> This is Last + 1 - ; This = 1 - ), - atom_codes(Prompt, SP), - atom_codes(This, ST), - ( atom_codes('~!', Repl), - substitute(Repl, ST, SP, String) - -> prompt1(String) - ; prompt1(Prompt) - ), - ttyflush. - -% substitute(+Old, +New, +String, -Substituted) -% substitute first occurence of Old in String by New - -substitute(Old, New, String, Substituted) :- - '$append'(Head, OldAndTail, String), - '$append'(Old, Tail, OldAndTail), - !, - '$append'(Head, New, HeadAndNew), - '$append'(HeadAndNew, Tail, Substituted), - !. - -%! '$save_history_line'(+Line) -% -% Add Line to the command line editing history. - -:- multifile - prolog:history_line/2. - -'$save_history_line'(end_of_file) :- !. -'$save_history_line'(Line) :- - format(string(CompleteLine), '~W~W', - [ Line, [partial(true)], - '.', [partial(true)] - ]), - catch(prolog:history(user_input, add(CompleteLine)), _, fail), - !. -'$save_history_line'(_). - -%! save_event(+Event, +Options) -% -% Save Event into the history system unless it appears in the -% option `no_save`. - -save_event(Event, Options) :- - '$option'(no_save(Dont), Options), - memberchk(Event, Dont), - !. -save_event(Event, _) :- - '$save_history_event'(Event). - -%! '$save_history_event'(+Event) is det. -% -% Save an input line as text into the !- based history. Event is one -% of -% -% * a *string*. The event is added with a next number at the end. -% * a *pair*. The event is added with the given sequence number. - -:- thread_local - '$history'/2. - -'$save_history_event'(Num-String) :- - integer(Num), string(String), - !, - asserta('$history'(Num, String)), - truncate_history(Num). -'$save_history_event'(Event) :- - to_string(Event, Event1), - !, - last_event(Num, String), - ( Event1 == String - -> true - ; New is Num + 1, - asserta('$history'(New, Event1)), - truncate_history(New) - ). -'$save_history_event'(Event) :- - '$type_error'(history_event, Event). - -last_event(Num, String) :- - '$history'(Num, String), - !. -last_event(0, ""). - -to_string(String, String) :- - string(String), - !. -to_string(Atom, String) :- - atom_string(Atom, String). - -truncate_history(New) :- - history_depth_(Depth), - remove_history(New, Depth). - -remove_history(New, Depth) :- - New - Depth =< 0, - !. -remove_history(New, Depth) :- - Remove is New - Depth, - retract('$history'(Remove, _)), - !. -remove_history(_, _). - -% history_depth_(-Depth) -% Define the depth to which to keep the history. - -history_depth_(N) :- - current_prolog_flag(history, N), - integer(N), - N > 0, - !. -history_depth_(25). - -% expand_history(+Raw, -Expanded) -% Expand Raw using the available history list. Expandations performed -% are: -% -% !match % Last event starting -% !n % Event nr. -% !! % last event -% -% Note: the first character after a '!' should be a letter or number to -% avoid problems with the cut. - -expand_history(Raw, Expanded, Changed) :- - atom_chars(Raw, RawString), - expand_history2(RawString, ExpandedString, Changed), - atom_chars(Expanded, ExpandedString), - !. - -expand_history2([!], [!], false) :- !. -expand_history2([!, C|Rest], [!|Expanded], Changed) :- - not_event_char(C), - !, - expand_history2([C|Rest], Expanded, Changed). -expand_history2([!|Rest], Expanded, true) :- - !, - match_event(Rest, Event, NewRest), - '$append'(Event, RestExpanded, Expanded), - !, - expand_history2(NewRest, RestExpanded, _). -expand_history2(['\''|In], ['\''|Out], Changed) :- - !, - skip_quoted(In, '\'', Out, Tin, Tout), - expand_history2(Tin, Tout, Changed). -expand_history2(['"'|In], ['"'|Out], Changed) :- - !, - skip_quoted(In, '"', Out, Tin, Tout), - expand_history2(Tin, Tout, Changed). -expand_history2([H|T], [H|R], Changed) :- - !, - expand_history2(T, R, Changed). -expand_history2([], [], false). - -skip_quoted([Q|T],Q,[Q|R], T, R) :- !. -skip_quoted([\,Q|T0],Q,[\,Q|T], In, Out) :- - !, - skip_quoted(T0, Q, T, In, Out). -skip_quoted([Q,Q|T0],Q,[Q,Q|T], In, Out) :- - !, - skip_quoted(T0, Q, T, In, Out). -skip_quoted([C|T0],Q,[C|T], In, Out) :- - !, - skip_quoted(T0, Q, T, In, Out). -skip_quoted([], _, [], [], []). - -% get_last_event(-String) -% return last event typed as a string - -get_last_event(Event) :- - '$history'(_, Atom), - atom_chars(Atom, Event), - !. -get_last_event(_) :- - print_message(query, history(no_event)), - fail. - -% match_event(+Spec, -Event, -Rest) -% Use Spec as a specification of and event and return the event as Event -% and what is left of Spec as Rest. - -match_event(Spec, Event, Rest) :- - find_event(Spec, Event, Rest), - !. -match_event(_, _, _) :- - print_message(query, history(no_event)), - fail. - -not_event_char(C) :- code_type(C, csym), !, fail. -not_event_char(!) :- !, fail. -not_event_char(_). - -find_event([!|Left], Event, Left) :- - !, - get_last_event(Event). -find_event([N|Rest], Event, Left) :- - code_type(N, digit), - !, - take_number([N|Rest], String, Left), - number_codes(Number, String), - '$history'(Number, Atom), - atom_chars(Atom, Event). -find_event(Spec, Event, Left) :- - take_string(Spec, String, Left), - matching_event(String, Event). - -take_string([C|Rest], [C|String], Left) :- - code_type(C, csym), - !, - take_string(Rest, String, Left). -take_string([C|Rest], [], [C|Rest]) :- !. -take_string([], [], []). - -take_number([C|Rest], [C|String], Left) :- - code_type(C, digit), - !, - take_string(Rest, String, Left). -take_number([C|Rest], [], [C|Rest]) :- !. -take_number([], [], []). - -% matching_event(+String, -Event) -% -% Return first event with prefix String as a Prolog string. - -matching_event(String, Event) :- - '$history'(_, AtomEvent), - atom_chars(AtomEvent, Event), - '$append'(String, _, Event), - !. - diff --git a/.Attic/metta_lang/metta_types.pl.broken b/.Attic/metta_lang/metta_types.pl.broken deleted file mode 100755 index 36ef3b0917e..00000000000 --- a/.Attic/metta_lang/metta_types.pl.broken +++ /dev/null @@ -1,744 +0,0 @@ -/* - * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpreter/Runtime - * 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. - */ -typed_list(Cmpd,Type,List):- compound(Cmpd), Cmpd\=[_|_], compound_name_arguments(Cmpd,Type,[List|_]),is_list(List). -is_syspred(H,Len,Pred):- notrace(is_syspred0(H,Len,Pred)). -is_syspred0(H,_Ln,_Prd):- \+ atom(H),!,fail. -is_syspred0(H,_Ln,_Prd):- upcase_atom(H,U),downcase_atom(H,U),!,fail. -is_syspred0(H,Len,Pred):- current_predicate(H/Len),!,Pred=H. -is_syspred0(H,Len,Pred):- atom_concat(Mid,'!',H), H\==Mid, is_syspred0(Mid,Len,Pred),!. -is_syspred0(H,Len,Pred):- atom_concat(Mid,'-p',H), H\==Mid, is_syspred0(Mid,Len,Pred),!. -is_syspred0(H,Len,Pred):- atom_concat(Mid,'-fn',H), H\==Mid, is_syspred0(Mid,Len,Pred),!. -is_syspred0(H,Len,Pred):- into_underscores(H,Mid), H\==Mid, is_syspred0(Mid,Len,Pred),!. -%is_function(F):- atom(F). -is_metta_data_functor(_Eq,_Othr,H):- - bt,trace, clause(is_data_functor(H),_). -is_metta_data_functor(Eq,Other,H):- H\=='Right', H\=='Something', - % metta_type(Other,H,_), % fail, - \+ get_metta_atom(Eq,Other,[H|_]), - \+ metta_defn(Eq,Other,[H|_],_), - \+ is_metta_builtin(H), - \+ is_comp_op(H,_), - \+ is_math_op(H,_,_). - - -:- if( \+ current_predicate(mnotrace/1) ). - mnotrace(G):- once(G). -:- endif. - -'Number':attr_unify_hook(_,NewValue):- numeric(NewValue). - -%is_decl_type(ST):- metta_type(_,_,[_|Type]),is_list(Type),sub_sterm(T,Type),nonvar(T),T=@=ST, \+ nontype(ST). - -is_decl_utype('%Undefined%'). -is_decl_utype('Number'). -is_decl_utype('Symbol'). -is_decl_utype('Expression'). -is_decl_utype('String'). -is_decl_utype('Bool'). -is_decl_utype('Type'). -is_decl_utype('Any'). -is_decl_utype('Atom'). -%is_decl_utype(Type):- is_decl_type_l(Type). -is_decl_mtype('Variable'). -is_decl_mtype('Number'). -is_decl_mtype('Symbol'). -is_decl_mtype('Expression'). -is_decl_mtype('Grounded'). - -%is_decl_type([ST|_]):- !, atom(ST),is_decl_type_l(ST). -%is_decl_type(ST):- \+ atom(ST),!,fail. -is_decl_type(Type):- is_decl_utype(Type). -is_decl_type(Type):- is_decl_type_l(Type). -is_decl_type([Type,SType]):- is_decl_type_l(Type),is_decl_utype(SType). - -is_decl_type_l('StateMonad'). is_decl_type_l('List'). - -last_type(List,Type):- is_list(List),last(List,Type),is_type(Type). -last_type(Type,Type):- is_type(Type),!. - -is_type(Type):- nontype(Type),!,fail. -is_type(Type):- is_decl_type(Type). -%is_type(Type):- atom(Type). - -nontype(Type):- var(Type),!. -nontype('->'). -nontype(N):- number(N). - -needs_eval(EvalMe):- is_list(EvalMe). - - -args_violation(_Dpth,_Slf,Args,List):- ( \+ iz_conz(Args); \+ iz_conz(List)), !, fail. -args_violation(Depth,Self,[A|Args],[L|List]):- - once( arg_violation(Depth,Self,A,L) ; - args_violation(Depth,Self,Args,List)). - -arg_violation(Depth,Self,A,L):- - \+ (get_type_equals(Depth,Self,A,T), \+ type_violation(T,L)). -%arg_violation(Depth,Self,A,_):- get_type(Depth,Self,A,_),!. - -type_violation(T,L):- \+ \+ (is_nonspecific_type(T);is_nonspecific_type(L)),!,fail. -type_violation(T,L):- T\=L. - - -not_arg_violation(Depth,Self,Arg,Type):- - arg_conform(Depth,Self,Arg,Type), - \+ arg_violation(Depth,Self,Arg,Type). - - -ignored_args_conform(Depth,Self,A,L):- ( \+ iz_conz(Args); \+ iz_conz(List)), !. -ignored_args_conform(Depth,Self,A,L):- maplist(ignored_arg_conform(Depth,Self),A,L). -ignored_arg_conform(Depth,Self,A,L):- nonvar(L), is_nonspecific_type(L),!. -ignored_arg_conform(Depth,Self,A,L):- get_type(Depth,Self,A,T), type_conform(T,L),!. -ignored_arg_conform(Depth,Self,_,_):- !. - -args_conform(_Dpth,_Slf,Args,List):- ( \+ iz_conz(Args); \+ iz_conz(List)), !. -args_conform(Depth,Self,[A|Args],[L|List]):- - arg_conform(Depth,Self,A,L), args_conform(Depth,Self,Args,List). - -arg_conform(_Dpth,_Slf,_A,L):- nonvar(L), is_nonspecific_type(L),!. - arg_conform(Depth,Self,A,L):- get_type(Depth,Self,A,T), type_conform(T,L),!. -%arg_conform(_Dpth,_Slf,_,_). -%arg_conform(Depth,Self,A,_):- get_type(Depth,Self,A,_),!. - -type_conform(T,L):- T=L,!. -type_conform(T,L):- \+ \+ (is_nonspecific_type(T);is_nonspecific_type(L)),!. -type_conform(T,L):- can_assign(T,L). - -is_nonspecific_type(Var):- var(Var),!. -is_nonspecific_type('%Undefined%'). -is_nonspecific_type([]). -is_nonspecific_type('Atom'). -is_nonspecific_type('Any'). - -get_types(Depth,Self,Var,TypeSet):- - setof(Type,get_type_each(Depth,Self,Var,Type),TypeSet). - -get_type_equals(_Depth,_Self,Var,TypeO):- var(Var),var(TypeO),!. -get_type_equals(Depth,Self,Var,TypeO):- get_type(Depth,Self,Var,TypeO). - -%if_or_else(get_type(Depth,Self,Val,Type),Type='%Undefined%'), - -get_type(Depth,Self,Val,TypeO):- - no_repeats_var(NoRepeatType), - get_type_each(Depth,Self,Val,Type), - NoRepeatType=Type, - Type=TypeO, - (return_only_first_type->!;true). - -return_only_first_type:- true_flag. - -is_space_type(Space,is_asserted_space):- was_asserted_space(Space),!. -is_space_type(Space,Test):- no_repeats(Test,space_type_method(Test,_,_)),call(Test,Space),!. - -is_state_type(State,Test):- no_repeats(Test,state_type_method(Test,_,_)),call(Test,State),!. - -%is_dynaspace(Expr):- \+ is_list(Expr), callable(Expr), is_space_type(Expr,_). -is_dynaspace(S):- var(S),!,fail. -is_dynaspace(S):- was_asserted_space(S). -is_dynaspace(S):- py_named_space(S). -is_dynaspace(S):- typed_list(S,'hyperon::space::DynSpace',_). -% notrace( is_space_type(Expr,_)),!. - - - -get_type_each(_Dpth,_Slf,Expr,'hyperon::space::DynSpace'):- is_dynaspace(Expr),!. -get_type_each(Depth,Self,Val,Type):- \+ integer(Depth),!,get_type_each(10,Self,Val,Type). -get_type_each(Depth,_Slf,_Type,_):- Depth<1,!, fail. -%get_type(Depth,Self,Val,Type):- is_debugging(eval), -% ftrace(get_type_each(Depth,Self,Val,Type)), -% fail. -get_type_each(Depth,Self,Expr,['StateMonad',Type]):- - notrace( is_valid_nb_state(Expr)),!, - if_or_else(state_decltype(Expr,Type),nonvar(Type)), - ('get-state'(Expr,Val),!,Depth2 is Depth-1, - get_value_type(Depth2,Self,Val,Type)). - -get_type_each(_Dpth,Self,Var,Type):- var(Var),!, - get_attr(Var,metta_type,Self=TypeList),member(Type,TypeList). - -get_type_each(Depth,Self,Val,Type):- \+ compound(Val),!, get_type_nc(Depth,Self,Val,Type). - -get_type_each(Depth,Self,Val,Type):- - ignore(check_bad_type(Depth,Self,Val)), - if_or_else((get_type_cmpd(Depth,Self,Val,Type,How),trace_get_type(How,Type,gt(Val))), - (trace_get_type('FAILED','',gt(Val)),fail)). - - -have_some_defs(Depth,Self,Val):- - \+ \+ - ([H|Args] = Val, - metta_type(Eq,H,[Ar|ArgTypes]),Ar=='->', - append(ParamTypes,[RType],ArgTypes), - length(ParamTypes,Len), - len_or_unbound(Args,ALen), - Len = ALen). - -check_bad_type(_Depth,_Self,Val):- \+ is_list(Val),!. -check_bad_type(Depth,Self,Val):- \+ have_some_defs(Depth,Self,Val),!, - trace_get_type(checking_childs,Val,check),!, - maplist(check_bad_type(Depth,Self),Val). -check_bad_type(Depth,Self,Val):- - maplist(check_bad_type(Depth,Self),Val), - check_bad_type2(Depth,Self,Val). - -check_bad_type2(Depth,Self,Val):- Val= [Op|Args], - typed_expression(Depth,Self,[Op|Args],ArgTypes,RType), - trace_get_type(type_sig(Op),ArgTypes,RType), - ignored_args_conform(Depth,Self,Args,ArgTypes), - (args_violation(Depth,Self,Args,ArgTypes) -> - (trace_get_type(bad_type,args_violation(Args,ArgTypes),check),fail); - (trace_get_type(conformed,no_args_violation(Args,ArgTypes),check),true)). - -typed_expression(Depth,Self,[Op|Args],ArgTypes,RType):- - len_or_unbound(Args,Len), - get_operator_typedef1(Self,Op,Len,ArgTypes,RType). - -badly_typed_expression(Depth,Self,[Op|Args]):- - typed_expression(Depth,Self,[Op|Args],ArgTypes,RType), - can_assign(RetType,RType), - args_violation(Depth,Self,Args,ArgTypes), - !. - -trace_get_type(How,Type,Val):- - color_g_mesg('#7f2f2f', - w_indent(3,format('<-- ~@ <- ~@ < ~@',[wsf(How),wsf(Type),wsf(Val)]))),!. -wsf(T):- with_indents(false,write_src(T)). - -get_type_nc(_Dpth,Self,Op,Type):- metta_type(Self,Op,Type). -get_type_nc(Dpth,Slf,Val,Type):- symbol(Val),!,get_type_symb(Dpth,Slf,Val,Type). -get_type_nc(_Dpth,_Slf,Val,'String'):- string(Val),!. -%get_type_nc(_Dpth,_Slf,Val,Type):- py_is_object(Val),py_type(Val,Type). -get_type_nc(_Dpth,_Slf,Val,'Number'):- number(Val). -get_type_nc(_Dpth,_Slf,Val,'Integer'):- integer(Val),!, specialize_number. -get_type_nc(_Dpth,_Slf,Val,'Decimal'):- float(Val),!, specialize_number. -get_type_nc(_Dpth,_Slf,Val,'Rational'):- rational(Val),!. - -specialize_number:- false_flag. - -get_type_symb(_Dpth,_Slf,Val,'Bool'):- (Val=='False';Val=='True'). -get_type_symb(_Dpth,_Slf,Val,'Type'):- is_decl_type(Val). -get_type_symb(_Dpth,_Slf,Val,Type):- symbolic_list_concat([Type,_|_],'@',Val). -get_type_symb(_Dpth,_Slf,Val,Type):- symbolic_list_concat([Type,_|_],':',Val). -get_type_symb(Depth,Self,Op,Type):- % defined symbol - Depth2 is Depth-1, eval_args(Depth2,Self,Op,Val),Op\=@=Val,!, - get_type(Depth2,Self,Val,Type). - -get_dict_type(_Vl,Type,TypeO):- nonvar(Type),TypeO=Type. -get_dict_type(Val,_,Type):- get_dict(Val,type,Type). -get_dict_type(Val,_,TypeO):- get_dict(Val,class,Type). -get_dict_type(Val,_,TypeO):- get_dict(Val,types,TypeL), - is_list(TypeL),member(Type,TypeL). - - -%get_type_cmpd(_Dpth,Self,Op,Type):- copy_term(Op,Copy), -% metta_type(Self,Op,Type), Op=@=Copy. -get_type_cmpd(Depth,Self,NC,Type,nc):- \+ compound(NC),!, get_type(Depth,Self,NC,Type). -get_type_cmpd(_Dpth,_Slf,Val,Type,char):- Val='#\\'(_),Type='Char'. -get_type_cmpd(_Dpth,_Slf,Val,Type,dict):- is_dict(Val,Type), - get_dict_type(Val,Type,TypeO). - -% Curried Op -get_type_cmpd(Depth,Self,[[Op|Args]|Arg],Type,curried):- - symbol(Op), - Depth2 is Depth-1, - get_type_cmpd(Depth2,Self,[Op|Args],Type1), - get_type(Depth2,Self,Arg,ArgType), - ignore(sub_var(ArgType,Type1)->true; - (sub_term(ST,Type1),var(ST),ST=ArgType)), - last(Type1,Type). - - - -get_type_cmpd(Depth,Self,[Op|Args],Type,ac(Op,[P|Arams],RetType)):- symbol(Op), - len_or_unbound(Args,Len), - get_operator_typedef1(Self,Op,Len,[P|Arams],RetType), - % Fills in type variables when possible - ignored_args_conform(Depth,Self,Args,[P|Arams]), - % \+ maplist(var,Arams), - % unitests: arg violations should return () - (\+ args_violation(Depth,Self,Args,[P|Arams])), - Type=RetType. - -get_type_cmpd(_Dpth,_Slf,Cmpd,Type,typed_list):- - typed_list(Cmpd,Type,_List). - - /* - get_type_cmpd(Depth,Self,[Op|Expr],Type,not_bat):- - symbol(Op), - maplist(get_type(Depth,Self),Expr,Types), - [Op|Types]\=@=[Op|Expr], - \+ badly_typed_expression(Depth,Self,[Op|Expr]), - metta_type(Self,[Op|Types],Type). - */ -get_type_cmpd(Depth,Self,EvalMe,Type,eval_first):- - needs_eval(EvalMe), - Depth2 is Depth-1, - eval_args(Depth2,Self,EvalMe,Val), - \+ needs_eval(Val), - get_type(Depth2,Self,Val,Type). - -get_type_cmpd(Depth,Self,List,Types,maplist(get_type)):- fail, - List\==[], - is_list(List), - Depth2 is Depth-1, - maplist(get_type_no_fn_or_self(Depth2,Self),List,Types), - List \=@= Types. - -get_type_cmpd(_Dpth,_Slf,_Cmpd,[],unknown). - -non_param_spec(Type):- var(Type), attvar(Type), !. -non_param_spec(Type):- var(Type), !, freeze(Type,non_param_spec(Type)). -non_param_spec([H|_]):- !, H \== '->'. -non_param_spec(_). - -get_type_no_fn_or_self(Depth2,Self,Val,Type):- - non_param_spec(Type),get_type(Depth2,Self,Val,Type),!. -get_type_no_fn_or_self(_Dpth,_Slf,Val,Val). - - - -state_decltype(Expr,Type):- functor(Expr,_,A), - arg(A,Expr,Type),once(var(Type);is_decl_type(Type)). - - -get_value_type(_Dpth,_Slf,Var,'%Undefined%'):- var(Var),!. -get_value_type(_Dpth,_Slf,Val,'Number'):- number(Val),!. -get_value_type(_Dpth,_Slf,Val,T):- get_type(_Dpth,_Slf,Val,T), T\==[], T\=='%Undefined%',!. -get_value_type(_Dpth,_Slf,Val,T):- get_metatype(Val,T). - -/* - -get_value_type(Depth,Self,EvalMe,Type):- needs_eval(EvalMe), - eval_args(Depth,Self,EvalMe,Val), \+ needs_eval(Val),!, - get_value_type(Depth,Self,Val,Type). - -get_value_type(_Dpth,Self,[Fn|_],Type):- symbol(Fn),metta_type(Self,Fn,List),last_element(List,Type), nonvar(Type), - is_type(Type). -get_value_type(_Dpth,Self,List,Type):- is_list(List),metta_type(Self,List,LType),last_element(LType,Type), nonvar(Type), - is_type(Type). - -get_value_type(Depth,_Slf,Type,Type):- Depth<1,!. -get_value_type(_Dpth,Self,List,Type):- is_list(List),metta_type(Self,Type,['->'|List]). -get_value_type(Depth,Self,List,Types):- List\==[], is_list(List),Depth2 is Depth-1,maplist(get_value_type(Depth2,Self),List,Types). -get_value_type(_Dpth,Self,Fn,Type):- symbol(Fn),metta_type(Self,Fn,Type),!. -%get_value_type(Depth,Self,Fn,Type):- nonvar(Fn),metta_type(Self,Fn,Type2),Depth2 is Depth-1,get_value_type(Depth2,Self,Type2,Type). -%get_value_type(Depth,Self,Fn,Type):- Depth>0,nonvar(Fn),metta_type(Self,Type,Fn),!. %,!,last_element(List,Type). - -%get_value_type(Depth,Self,Expr,Type):-Depth2 is Depth-1, -% eval_args(Depth2,Self,Expr,Val), -% Expr\=@=Val,get_value_type(Depth2,Self,Val,Type). - - -get_value_type(_Dpth,_Slf,Val,'String'):- string(Val),!. -get_value_type(_Dpth,_Slf,Val,Type):- is_decl_type(Val),Type=Val. -get_value_type(_Dpth,_Slf,Val,'Bool'):- (Val=='False';Val=='True'),!. -% get_value_type(_Dpth,_Slf,Val,'Symbol'):- symbol(Val). -%get_value_type(Depth,_Slf,Cmpd,Type):- compound(Cmpd), functor(Cmpd,Type,1),!. -%get_value_type(_Dpth,_Slf,Cmpd,Type):- \+ ground(Cmpd),!,Type=[]. -%get_value_type(_Dpth,_Slf,_,'%Undefined%'):- fail. -%get_value_type(Depth,Self,Val,Type):- Depth2 is Depth-1, get_type_equals(Depth2,Self,Val,Type). -*/ - - -as_prolog(I,O):- as_prolog(10,'&self',I,O). -as_prolog(_Dpth,_Slf,I,O):- \+ iz_conz(I),!,I=O. -as_prolog(Depth,Self,[Cons,H,T],[HH|TT]):- Cons=='Cons',!,as_prolog(Depth,Self,H,HH),as_prolog(Depth,Self,T,TT). -as_prolog(Depth,Self,[List,H|T],O):- List=='::',!,maplist(as_prolog(Depth,Self),[H|T],L),!, O = L. -as_prolog(Depth,Self,[At,H|T],O):- At=='@',!,maplist(as_prolog(Depth,Self),[H|T],[HH|L]),atom(H),!, O =.. [HH|L]. -as_prolog(Depth,Self,I,O):- is_list(I),!,maplist(as_prolog(Depth,Self),I,O). -as_prolog(_Dpth,_Slf,I,I). - - -try_adjust_arg_types(_Eq,RetType,Depth,Self,Params,X,Y):- - as_prolog(Depth,Self,X,M), - args_conform(Depth,Self,M,Params),!, - set_type(Depth,Self,Y,RetType), - into_typed_args(Depth,Self,Params,M,Y). -%adjust_args(Eq,RetType,Depth,Self,_,X,Y):- is_list(X), !, maplist(eval_args(Depth,Self),X,Y). -%adjust_args(Eq,RetType,Depth,Self,_,X,Y):- is_list(X), !, maplist(as_prolog(Depth,Self),X,Y),!. - -adjust_args_9(Eq,RetType,Res,NewRes,Depth,Self,Op,X,Y):- - adjust_args(Eq,RetType,Res,NewRes,Depth,Self,Op,X,Y). - -adjust_args(_Eq,_RetType,Res,Res,_Dpth,Self,F,X,Y):- (X==[] ; - is_special_op(Self,F); \+ iz_conz(X)),!,Y=X. -adjust_args(Eq,RetType,Res,NewRes,Depth,Self,Op,X,Y):- - if_or_else(adjust_argsA(Eq,RetType,Res,NewRes,Depth,Self,Op,X,Y), - adjust_argsB(Eq,RetType,Res,NewRes,Depth,Self,Op,X,Y)). - -adjust_argsA(Eq,RetType,Res,NewRes,Depth,Self,Op,X,Y):- - len_or_unbound(X,Len), - get_operator_typedef(Self,Op,Len,ParamTypes,RRetType), - (nonvar(NewRes)->CRes=NewRes;CRes=Res), - RRetType = RetType, - args_conform(Depth,Self,[CRes|X],[RRetType|ParamTypes]), - into_typed_args(Depth,Self,[RRetType|ParamTypes],[Res|X],[NewRes|Y]). - -adjust_argsB(Eq,_RetType,Res,Res,Depth,Self,_,Args,Adjusted):- is_list(Args),!, - maplist(eval_1_arg(Eq,_,Depth,Self),Args,Adjusted). -adjust_argsB(_Eq,_RetType,Res,Res,Depth,Self,_,X,Y):- as_prolog(Depth,Self,X,Y),!. - -eval_1_arg(Eq,ReturnType,Depth,Self,Arg,Adjusted):- - if_or_else(eval(Eq,ReturnType,Depth,Self,Arg,Adjusted),Arg=Adjusted). - -into_typed_args(_Dpth,_Slf,T,M,Y):- (\+ iz_conz(T); \+ iz_conz(M)),!, M=Y. -into_typed_args(Depth,Self,[T|TT],[M|MM],[Y|YY]):- - into_typed_arg(Depth,Self,T,M,Y), - into_typed_args(Depth,Self,TT,MM,YY). - -into_typed_arg(_Dpth,Self,T,M,Y):- var(M),!,Y=M, nop(put_attr(M,metta_type,Self=T)). -into_typed_arg(Depth,Self,T,M,Y):- into_typed_arg0(Depth,Self,T,M,Y)*->true;M=Y. - -into_typed_arg0(Depth,Self,T,M,Y):- var(T), !, - must_det_ll((get_type(Depth,Self,M,T), - (wants_eval_kind(T)->eval_args(Depth,Self,M,Y);Y=M))). - -into_typed_arg0(Depth,Self,T,M,Y):- is_pro_eval_kind(T),!,eval_args(Depth,Self,M,Y). -into_typed_arg0(Depth,Self,T,M,Y):- ground(M),!, \+ arg_violation(Depth,Self,M,T),Y=M. -into_typed_arg0(_Dpth,_Slf,T,M,Y):- is_non_eval_kind(T),!,M=Y. -into_typed_arg0(Depth,Self,_,M,Y):- eval_args(Depth,Self,M,Y). - -wants_eval_kind(T):- nonvar(T), is_pro_eval_kind(T),!. -wants_eval_kind(_):- true. - -metta_type:attr_unify_hook(Self=TypeList,NewValue):- attvar(NewValue),!,put_attr(NewValue,metta_type,Self=TypeList). -metta_type:attr_unify_hook(Self=TypeList,NewValue):- - get_type(20,Self,NewValue,Was), - can_assign(Was,Type). - -%set_type(Depth,Self,Var,Type):- nop(set_type(Depth,Self,Var,Type)),!. -set_type(Depth,Self,Var,Type):- nop(set_type(Depth,Self,Var,Type)),!. -set_type(Depth,Self,Var,Type):- - get_types(Depth,Self,Var,TypeL), - add_type(Depth,Self,Var,TypeL,Type). - -add_type(_Depth,_Self, Var,_TypeL,_Type):- - \+ nonvar(Var),!. -add_type(_Depth,_Self,_Var,TypeL,Type):- - \+ \+ (member(E,TypeL),E==Type),!. -add_type(_Depth,Self,_Var,TypeL,Type):- - append([Type],TypeL,TypeList), - put_attr(Var,metta_type,Self=TypeList). - - -can_assign(Was,Type):- Was=Type,!. -can_assign(Was,Type):- (is_nonspecific_type(Was);is_nonspecific_type(Type)),!. -can_assign(Was,Type):- \+ cant_assign_to(Was,Type). -%can_assign(_Ws,_Typ). - -cant_assign_to(Was,Type):- cant_assign(Was,Type),!. -cant_assign_to(Type,Was):- cant_assign(Was,Type),!. -cant_assign(A,B):- \+ A \= B, !, fail. -cant_assign(Number,String):- formated_data_type(Number),formated_data_type(String), Number\==String. -cant_assign(Number,Other):- formated_data_type(Number), symbol(Other), Number\==Other. - -is_non_eval_kind(Type):- is_nonspecific_type(Type),!. -is_non_eval_kind('Atom'). - -formated_data_type('Number'). -formated_data_type('Symbol'). -formated_data_type('Bool'). -formated_data_type('Char'). -formated_data_type('String'). -formated_data_type([List|_]):- List=='List'. - -is_pro_eval_kind(SDT):- formated_data_type(SDT). - -is_feo_f('Cons'). - -is_seo_f('{...}'). -is_seo_f('[...]'). -is_seo_f('{}'). -is_seo_f('[]'). -is_seo_f('StateMonad'). -is_seo_f('State'). -is_seo_f('Event'). -is_seo_f('Concept'). -is_seo_f(N):- number(N),!. - -%is_user_defined_goal(Self,[H|_]):- is_user_defined_head(Eq,Self,H). - -is_user_defined_head(Other,H):- is_user_defined_head(=,Other,H). -is_user_defined_head(Eq,Other,H):- mnotrace(is_user_defined_head0(Eq,Other,H)). -is_user_defined_head0(Eq,Other,[H|_]):- !, nonvar(H),!, is_user_defined_head_f(Eq,Other,H). -is_user_defined_head0(Eq,Other,H):- callable(H),!,functor(H,F,_), is_user_defined_head_f(Eq,Other,F). -is_user_defined_head0(Eq,Other,H):- is_user_defined_head_f(Eq,Other,H). - -is_user_defined_head_f(Other,H):- is_user_defined_head_f(=,Other,H). -is_user_defined_head_f(Eq,Other,H):- is_user_defined_head_f1(Eq,Other,H). -is_user_defined_head_f(Eq,Other,H):- is_user_defined_head_f1(Eq,Other,[H|_]). - -%is_user_defined_head_f1(Eq,Other,H):- metta_type(Other,H,_). -%s_user_defined_head_f1(Other,H):- get_metta_atom(Eq,Other,[H|_]). -is_user_defined_head_f1(Other,H):- is_user_defined_head_f1(=,Other,H). -is_user_defined_head_f1(Eq,Other,H):- metta_defn(Eq,Other,[H|_],_). -%is_user_defined_head_f(Eq,_,H):- is_metta_builtin(H). - - - -is_special_op(Op):- current_self(Self),is_special_op(Self,Op). - -is_special_op(_Slf,F):- \+ atom(F), \+ var(F), !, fail. -%is_special_op(Self,Op):- get_operator_typedef(Self,Op,Params,_RetType), -% maplist(is_non_eval_kind,Params). -is_special_op(_Slf,Op):- is_special_builtin(Op). - - - -get_operator_typedef(Self,Op,ParamTypes,RetType):- - len_or_unbound(ParamTypes,Len), - get_operator_typedef(Self,Op,Len,ParamTypes,RetType). - -:- dynamic(get_operator_typedef0/5). -get_operator_typedef(Self,Op,Len,ParamTypes,RetType):- - len_or_unbound(ParamTypes,Len), - if_or_else(get_operator_typedef0(Self,Op,Len,ParamTypes,RetType), - if_or_else(get_operator_typedef1(Self,Op,Len,ParamTypes,RetType), - get_operator_typedef2(Self,Op,Len,ParamTypes,RetType))). - -get_operator_typedef1(Self,Op,Len,ParamTypes,RetType):- - len_or_unbound(ParamTypes,Len), - if_t(nonvar(ParamTypes),append(ParamTypes,[RetType],List)), - metta_type(Self,Op,['->'|List]), - if_t(var(ParamTypes),append(ParamTypes,[RetType],List)), - assert(get_operator_typedef0(Self,Op,Len,ParamTypes,RetType)). -get_operator_typedef2(Self,Op,Len,ParamTypes,RetType):- - ignore('Any'=RetType), - maplist(is_eval_kind,ParamTypes), - assert(get_operator_typedef0(Self,Op,Len,ParamTypes,'Any2')). - %nop(wdmsg(missing(get_operator_typedef2(Self,Op,ParamTypes,RetType)))),!,fail. - -is_eval_kind(ParamType):- ignore(ParamType='Any3'). - -is_metta_data_functor(Eq,F):- - current_self(Self),is_metta_data_functor(Eq,Self,F). - -:- if( \+ current_predicate(get_operator_typedef/4)). -get_operator_typedef(Self,Op,ParamTypes,RetType):- - get_operator_typedef(Self,Op,_,ParamTypes,RetType). -:- endif. - -:- if( \+ current_predicate(get_operator_typedef1/4)). -get_operator_typedef1(Self,Op,ParamTypes,RetType):- - get_operator_typedef1(Self,Op,_,ParamTypes,RetType). -:- endif. - -:- if( \+ current_predicate(get_operator_typedef/5)). -get_operator_typedef(Self,Op,_,ParamTypes,RetType):- - get_operator_typedef(Self,Op,ParamTypes,RetType). -:- endif. - - -is_special_builtin('case'). -is_special_builtin(':'). - -%is_special_builtin('='). -is_special_builtin('->'). -is_special_builtin('bind!'). -%is_special_builtin('new-space'). -is_special_builtin('let'). -is_special_builtin('let*'). -is_special_builtin('if'). -is_special_builtin('rtrace'). -is_special_builtin('or'). -is_special_builtin('and'). -is_special_builtin('not'). -is_special_builtin('match'). -is_special_builtin('call'). -is_special_builtin('let'). -is_special_builtin('let*'). -is_special_builtin('nop'). -is_special_builtin('assertEqual'). -is_special_builtin('assertEqualToResult'). -is_special_builtin('collapse'). -is_special_builtin('superpose'). -%is_special_builtin('=='). - -is_metta_builtin(Special):- is_special_builtin(Special). - -is_metta_builtin('=='). -is_metta_builtin(F):- once(atom(F);var(F)), current_op(_,yfx,F). -is_metta_builtin('println!'). -is_metta_builtin('transfer!'). -is_metta_builtin('compile!'). -is_metta_builtin('+'). -is_metta_builtin('-'). -is_metta_builtin('*'). -is_metta_builtin('/'). -is_metta_builtin('%'). -is_metta_builtin('=='). -is_metta_builtin('<'). -is_metta_builtin('>'). -is_metta_builtin('all'). -is_metta_builtin('import!'). -is_metta_builtin('pragma!'). - -% Comparison Operators in Prolog -% is_comp_op('=', 2). % Unification -is_comp_op('\\=', 2). % Not unifiable -is_comp_op('==', 2). % Strict equality -is_comp_op('\\==', 2). % Strict inequality -is_comp_op('@<', 2). % Term is before -is_comp_op('@=<', 2). % Term is before or equal -is_comp_op('@>', 2). % Term is after -is_comp_op('@>=', 2). % Term is after or equal -is_comp_op('=<', 2). % Less than or equal -is_comp_op('<', 2). % Less than -is_comp_op('>=', 2). % Greater than or equal -is_comp_op('>', 2). % Greater than -is_comp_op('is', 2). % Arithmetic equality -is_comp_op('=:=', 2). % Arithmetic exact equality -is_comp_op('=\\=', 2). % Arithmetic inequality - -% Arithmetic Operations -is_math_op('*', 2, exists). % Multiplication -is_math_op('**', 2, exists). % Exponentiation -is_math_op('+', 1, exists). % Unary Plus -is_math_op('+', 2, exists). % Addition -is_math_op('-', 1, exists). % Unary Minus -is_math_op('-', 2, exists). % Subtraction -is_math_op('.', 2, exists). % Array Indexing or Member Access (Depends on Context) -is_math_op('/', 2, exists). % Division -is_math_op('//', 2, exists). % Floor Division -is_math_op('///', 2, exists). % Alternative Division Operator (Language Specific) -is_math_op('/\\', 2, exists). % Bitwise AND -is_math_op('<<', 2, exists). % Bitwise Left Shift -is_math_op('>>', 2, exists). % Bitwise Right Shift -is_math_op('\\', 1, exists). % Bitwise NOT -is_math_op('\\/', 2, exists). % Bitwise OR -is_math_op('^', 2, exists). % Bitwise XOR -is_math_op('abs', 1, exists). % Absolute Value -is_math_op('acos', 1, exists). % Arc Cosine -is_math_op('acosh', 1, exists). % Hyperbolic Arc Cosine -is_math_op('asin', 1, exists). % Arc Sine -is_math_op('asinh', 1, exists). % Hyperbolic Arc Sine -is_math_op('atan', 1, exists). % Arc Tangent -is_math_op('atan2', 2, exists). % Two-Argument Arc Tangent -is_math_op('atanh', 1, exists). % Hyperbolic Arc Tangent -is_math_op('cbrt', 1, exists). % Cube Root -is_math_op('ceil', 1, exists). % Ceiling Function -is_math_op('ceiling', 1, exists). % Ceiling Value -is_math_op('cmpr', 2, exists). % Compare Two Values (Language Specific) -is_math_op('copysign', 2, exists). % Copy the Sign of a Number -is_math_op('cos', 1, exists). % Cosine Function -is_math_op('cosh', 1, exists). % Hyperbolic Cosine -is_math_op('cputime', 0, exists). % CPU Time -is_math_op('degrees', 1, exists). % Convert Radians to Degrees -is_math_op('denominator', 1, exists). % Get Denominator of Rational Number -is_math_op('div', 2, exists). % Integer Division -is_math_op('e', 0, exists). % Euler's Number -is_math_op('epsilon', 0, exists). % Machine Epsilon -is_math_op('erf', 1, exists). % Error Function -is_math_op('erfc', 1, exists). % Complementary Error Function -is_math_op('eval', 1, exists). % Evaluate Expression -is_math_op('exp', 1, exists). % Exponential Function -is_math_op('expm1', 1, exists). % exp(x) - 1 -is_math_op('fabs', 1, exists). % Absolute Value (Floating-Point) -is_math_op('float', 1, exists). % Convert Rational to Float -is_math_op('float_fractional_part', 1, exists). % Fractional Part of Float -is_math_op('float_integer_part', 1, exists). % Integer Part of Float -is_math_op('floor', 1, exists). % Floor Value -is_math_op('fmod', 2, exists). % Floating-Point Modulo Operation -is_math_op('frexp', 2, exists). % Get Mantissa and Exponent -is_math_op('fsum', 1, exists). % Accurate Floating Point Sum -is_math_op('gamma', 1, exists). % Gamma Function -is_math_op('gcd', 2, exists). % Greatest Common Divisor -is_math_op('getbit', 2, exists). % Get Bit at Position -is_math_op('hypot', 2, exists). % Euclidean Norm, Square Root of Sum of Squares -is_math_op('inf', 0, exists). % Positive Infinity -is_math_op('integer', 1, exists). % Convert Float to Integer -is_math_op('isinf', 1, exists). % Check for Infinity -is_math_op('isnan', 1, exists). % Check for Not a Number -is_math_op('lcm', 2, exists). % Least Common Multiple -is_math_op('ldexp', 2, exists). % Load Exponent of a Floating Point Number -is_math_op('lgamma', 1, exists). % Log Gamma -is_math_op('log', 1, exists). % Logarithm Base e -is_math_op('log10', 1, exists). % Base 10 Logarithm -is_math_op('log1p', 1, exists). % log(1 + x) -is_math_op('log2', 1, exists). % Base 2 Logarithm -is_math_op('lsb', 1, exists). % Least Significant Bit -is_math_op('max', 2, exists). % Maximum of Two Values -is_math_op('maxr', 2, exists). % Maximum Rational Number (Language Specific) -is_math_op('min', 2, exists). % Minimum of Two Values -is_math_op('minr', 2, exists). % Minimum Rational Number (Language Specific) -is_math_op('mod', 2, exists). % Modulo Operation -is_math_op('modf', 2, exists). % Return Fractional and Integer Parts -is_math_op('msb', 1, exists). % Most Significant Bit -is_math_op('nan', 0, exists). % Not a Number -is_math_op('nexttoward', 2, exists). % Next Representable Floating-Point Value -is_math_op('numerator', 1, exists). % Get Numerator of Rational Number -is_math_op('pi', 0, exists). % Pi -is_math_op('popcount', 1, exists). % Count of Set Bits -is_math_op('pow', 2, exists). % Exponentiation -is_math_op('powm', 3, exists). % Modulo Exponentiation -is_math_op('radians', 1, exists). % Convert Degrees to Radians -is_math_op('remainder', 2, exists). % Floating-Point Remainder -is_math_op('remquo', 3, exists). % Remainder and Part of Quotient -is_math_op('round', 1, exists). % Round to Nearest Integer -is_math_op('roundeven', 1, exists). % Round to Nearest Even Integer -is_math_op('setbit', 2, exists). % Set Bit at Position -is_math_op('signbit', 1, exists). % Sign Bit of Number -is_math_op('sin', 1, exists). % Sine Function -is_math_op('sinh', 1, exists). % Hyperbolic Sine -is_math_op('sqrt', 1, exists). % Square Root -is_math_op('tan', 1, exists). % Tangent Function -is_math_op('tanh', 1, exists). % Hyperbolic Tangent -is_math_op('testbit', 2, exists). % Test Bit at Position -is_math_op('trunc', 1, exists). % Truncate Decimal to Integer -is_math_op('ulogb', 1, exists). % Unbiased Exponent of a Floating-Point Value -is_math_op('xor', 2, exists). % Exclusive OR -is_math_op('zerop', 1, exists). % Test for Zero - -%:- load_pfc_file('metta_ontology.pl.pfc'). - - diff --git a/.Attic/metta_lang/stdlib.metta b/.Attic/metta_lang/stdlib.metta deleted file mode 100755 index 27015103010..00000000000 --- a/.Attic/metta_lang/stdlib.metta +++ /dev/null @@ -1,694 +0,0 @@ -(@doc = - (@desc "A symbol used to define reduction rules for expressions.") - (@params ( - (@param "Pattern to be matched against expression to be reduced") - (@param "Result of reduction or transformation of the first pattern"))) - (@return "Not reduced itself unless custom equalities over equalities are added") ) -(: = (-> $t $t Atom)) - -(@doc cons-atom - (@desc "Constructs an expression using two arguments") - (@params ( - (@param "Head of an expression") - (@param "Tail of an expression"))) - (@return "New expression consists of two input arguments")) - -(@doc println! - (@desc "Prints a line of text to the console") - (@params ( - (@param "Expression/atom to be printed out"))) - (@return "Unit atom")) - -(@doc format-args - (@desc "Fills {} symbols in the input expression with atoms from the second expression. E.g. (format-args (Probability of {} is {}%) (head 50)) gives [(Probability of head is 50%)]. Atoms in the second input value could be variables") - (@params ( - (@param "Expression with {} symbols to be replaced") - (@param "Atoms to be placed inside expression instead of {}"))) - (@return "Expression with replaced {} with atoms")) - -(@doc trace! - (@desc "Prints its first argument and returns second. Both arguments will be evaluated before processing") - (@params ( - (@param "Atom to print") - (@param "Atom to return"))) - (@return "Evaluated second input")) - -(@doc nop - (@desc "Outputs unit atom for any input") - (@params ( - (@param "Anything"))) - (@return "Unit atom")) - -(@doc let - (@desc "Let function is utilized to establish temporary variable bindings within an expression. It allows introducing variables (first argument), assign values to them (second argument), and then use these values within the scope of the let block") - (@params ( - (@param "Variable name (or several variables inside brackets ())") - (@param "Expression to be bound to variable (it is being reduced before bind)") - (@param "Expression which will be reduced and in which variable (first argument) could be used"))) - (@return "Result of third argument's evaluation")) - -(@doc let* - (@desc "Same as let, but first argument is a tuple containing tuples of variables and their bindings, e.g. (($v (+ 1 2)) ($v2 (* 5 6)))") - (@params ( - (@param "Tuple of tuples with variables and their bindings") - (@param "Expression which will be reduced and in which variable (first argument) could be used"))) - (@return "Result of second argument's evaluation")) - - -; TODO: Type is used here, but there is no definition for the -> type -; constructor for instance, thus in practice it matches because -> has -; %Undefined% type. We need to assign proper type to -> and other type -; constructors but it is not possible until we support vararg types. -(@doc is-function-type - (@desc "Function checks if input type is a function type") - (@params ( - (@param "Type notation"))) - (@return "True if input type notation is a function type, False - otherwise")) -(: is-function-type (-> Type Bool)) -(= (is-function-type $type) - (let $type-meta (get-metatype $type) - (case $type-meta ( - (Expression - (let $first (car-atom $type) - (if (== $first ->) True False) )) - ($_ False) )))) -(@doc if - (@desc "Replace itself by one of the arguments depending on condition.") - (@params ( - (@param "Boolean condition") - (@param "Result when condition is True") - (@param "Result when condition is False"))) - (@return "Second or third argument") ) -(: if (-> Bool Atom Atom $t)) -(= (if True $then $else) $then) -(= (if False $then $else) $else) - -(@doc ErrorType (@desc "Type of the atom which contains error")) -(: ErrorType Type) - -(@doc Error - (@desc "Error constructor") - (@params ( - (@param "Atom which contains error") - (@param "Error message, can be one of the reserved symbols: BadType, IncorrectNumberOfArguments"))) - (@return "Error atom")) -(: Error (-> Atom Atom ErrorType)) - -(@doc add-reduct - (@desc "Adds atom into the atomspace reducing it first") - (@params ( - (@param "Atomspace to add atom into") - (@param "Atom to add"))) - (@return "Unit atom")) -(: add-reduct (-> hyperon::space::DynSpace %Undefined% (->))) -(= (add-reduct $dst $atom) (add-atom $dst $atom)) - - -(@doc car-atom - (@desc "Extracts the first atom of an expression as a tuple") - (@params ( - (@param "Expression"))) - (@return "First atom of an expression")) - -(@doc cdr-atom - (@desc "Extracts the tail of an expression (all except first atom)") - (@params ( - (@param "Expression"))) - (@return "Tail of an expression")) -(@doc quote - (@desc "Prevents atom from being reduced") - (@params ( - (@param "Atom"))) - (@return "Quoted atom")) -(: quote (-> Atom Atom)) - -(@doc unify - (@desc "Matches two first arguments and returns third argument if they are matched and forth argument otherwise") - (@params ( - (@param "First atom to unify with") - (@param "Second atom to unify with") - (@param "Result if two atoms unified successfully") - (@param "Result otherwise"))) - (@return "Third argument when first two atoms are matched of forth one otherwise")) -(: unify (-> Atom Atom Atom Atom %Undefined%)) -(= (unify $a $a $then $else) $then) -(= (unify $a $b $then $else) - (case (unify-or-empty $a $b) ((Empty $else))) ) -(: unify-or-empty (-> Atom Atom Atom)) -(= (unify-or-empty $a $a) unified) -(= (unify-or-empty $a $b) (empty)) - -(@doc empty - (@desc "Cuts evaluation of the non-deterministic branch and removes it from the result") - (@params ()) - (@return "Nothing")) -(: empty (-> %Undefined%)) -(= (empty) (let a b never-happens)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Documentation formatting functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(@doc @doc - (@desc "Used for documentation purposes. Function documentation starts with @doc") - (@params ( - (@param "Function name") - (@param "Function description. Starts with @desc") - (@param "(Optional) parameters description starting with @params which should contain one or more @param symbols") - (@param "(Optional) description of what function will return. Starts with @return"))) - (@return "Function documentation using @doc-formal")) -(: @doc (-> Atom DocDescription DocInformal)) -(: @doc (-> Atom DocDescription DocParameters DocReturnInformal DocInformal)) - -(@doc @desc - (@desc "Used for documentation purposes. Description of function starts with @desc as a part of @doc") - (@params ( - (@param "String containing function description"))) - (@return "Function description")) -(: @desc (-> String DocDescription)) - -(@doc @param - (@desc "Used for documentation purposes. Description of function parameter starts with @param as a part of @params which is a part of @doc") - (@params ( - (@param "String containing parameter description"))) - (@return "Parameter description")) -(: @param (-> String DocParameterInformal)) -(: @param (-> DocType DocDescription DocParameter)) - -(@doc @return - (@desc "Used for documentation purposes. Description of function return value starts with @return as a part of @doc") - (@params ( - (@param "String containing return value description"))) - (@return "Return value description")) -(: @return (-> String DocReturnInformal)) -(: @return (-> DocType DocDescription DocReturn)) - -(@doc @doc-formal - (@desc "Used for documentation purposes. get-doc returns documentation starting with @doc-formal symbol. @doc-formal contains 6 or 4 parameters depending on the entity being described (functions being described using 6 parameters, atoms - 4 parameters)") - (@params ( - (@param "Function/Atom name for which documentation is to be displayed. Format (@item name)") - (@param "Contains (@kind function) or (@kind atom) depends on entity which documentation is displayed") - (@param "Contains type notation of function/atom") - (@param "Function/atom description") - (@param "(Functions only). Description of function parameters") - (@param "(Functions only). Description of function's return value"))) - (@return "Expression containing full documentation on function")) -(: @doc-formal (-> DocItem DocKindFunction DocType DocDescription DocParameters DocReturn DocFormal)) -(: @doc-formal (-> DocItem DocKindAtom DocType DocDescription DocFormal)) - -(@doc @item - (@desc "Used for documentation purposes. Converts atom/function's name to DocItem") - (@params ( - (@param "Atom/Function name to be documented"))) - (@return "(@item Atom) entity")) -(: @item (-> Atom DocItem)) - -(@doc (@kind function) - (@desc "Used for documentation purposes. Shows type of entity to be documented. (@kind function) in this case")) -(: (@kind function) DocKindFunction) - -(@doc (@kind atom) - (@desc "Used for documentation purposes. Shows type of entity to be documented. (@kind atom) in this case")) -(: (@kind atom) DocKindAtom) - -(@doc @type - (@desc "Used for documentation purposes. Converts atom/function's type to DocType") - (@params ( - (@param "Atom/Function type to be documented"))) - (@return "(@type Type) entity")) -(: @type (-> Type DocType)) - -(@doc @params - (@desc "Used for function documentation purposes. Contains several @param entities with description of each @param") - (@params ( - (@param "Several (@param ...) entities"))) - (@return "DocParameters containing description of all parameters of function in form of (@params ((@param ...) (@param ...) ...))")) -(: @params (-> Expression DocParameters)) - -(@doc get-doc - (@desc "Returns documentation for the given Atom/Function") - (@params ( - (@param "Atom/Function name for which documentation is needed"))) - (@return "Documentation for the given atom/function")) -(: get-doc (-> Atom Atom)) -(= (get-doc $atom) - (let $meta-type (get-metatype $atom) - (case $meta-type ( - (Expression (get-doc-atom $atom)) - ($_ (get-doc-single-atom $atom)) )))) - -(@doc get-doc-single-atom - (@desc "Function used by get-doc to get documentation on either function or atom. It checks if input name is the name of function or atom and calls correspondent function") - (@params ( - (@param "Atom/Function name for which documentation is needed"))) - (@return "Documentation for the given atom/function")) -(: get-doc-single-atom (-> Atom Atom)) -(= (get-doc-single-atom $atom) - (let $top-space (mod-space! top) - (let $type (get-type-space $top-space $atom) - (if (is-function-type $type) - (get-doc-function $atom $type) - (get-doc-atom $atom))))) - -(@doc get-doc-function - (@desc "Function used by get-doc-single-atom to get documentation on a function. It returns documentation on a function if it exists or default documentation with no description otherwise") - (@params ( - (@param "Function name for which documentation is needed") - (@param "Type notation for this function"))) - (@return "Documentation for the given function")) -(: get-doc-function (-> Atom Type Atom)) -(= (get-doc-function $name $type) - (let $top-space (mod-space! top) - (unify $top-space (@doc $name $desc (@params $params) $ret) - (let $type' (if (== $type %Undefined%) (undefined-doc-function-type $params) (cdr-atom $type)) - (let ($params' $ret') (get-doc-params $params $ret $type') - (@doc-formal (@item $name) (@kind function) (@type $type) $desc (@params $params') $ret'))) - (@doc-formal (@item $name) (@kind function) (@type $type) (@desc "No documentation")) ))) - -(@doc undefined-doc-function-type - (@desc "Function used by get-doc-single-atom in case of absence of function's type notation") - (@params ( - (@param "List of parameters for the function we want to get documentation for"))) - (@return "List of %Undefined% number of which depends on input list size. So for two parameters function will return (%Undefined% %Undefined% %Undefined%)")) -(: undefined-doc-function-type (-> Expression Type)) -(= (undefined-doc-function-type $params) - (if (== () $params) (%Undefined%) - (let $params-tail (cdr-atom $params) - (let $tail (undefined-doc-function-type $params-tail) - (cons-atom %Undefined% $tail) )))) - -(@doc get-doc-params - (@desc "Function used by get-doc-function to get function's parameters documentation (including return value)") - (@params ( - (@param "List of parameters in form of ((@param Description) (@param Description)...)") - (@param "Return value's description in form of (@return Description)") - (@param "Type notation without -> starting symbol e.g. (Atom Atom Atom)"))) - (@return "United list of params and return value each augmented with its type. E.g. (((@param (@type Atom) (@desc Description)) (@param (@type Atom) (@desc Description2))) (@return (@type Atom) (@desc Description)))")) -(: get-doc-params (-> Expression Atom Expression (Expression Atom))) -(= (get-doc-params $params $ret $types) - (let $head-type (car-atom $types) - (let $tail-types (cdr-atom $types) - (if (== () $params) - (let (@return $ret-desc) $ret - (() (@return (@type $head-type) (@desc $ret-desc))) ) - (let (@param $param-desc) (car-atom $params) - (let $tail-params (cdr-atom $params) - (let ($params' $result-ret) (get-doc-params $tail-params $ret $tail-types) - (let $result-params (cons-atom (@param (@type $head-type) (@desc $param-desc)) $params') - ($result-params $result-ret) )))))))) - -(@doc get-doc-atom - (@desc "Function used by get-doc (in case of input type Expression) and get-doc-single-atom (in case input value is not a function) to get documentation on input value") - (@params ( - (@param "Atom's name to get documentation for"))) - (@return "Documentation on input Atom")) -(: get-doc-atom (-> Atom Atom)) -(= (get-doc-atom $atom) - (let $top-space (mod-space! top) - (let $type (get-type-space $top-space $atom) - (unify $top-space (@doc $atom $desc) - (@doc-formal (@item $atom) (@kind atom) (@type $type) $desc) - (unify $top-space (@doc $atom $desc' (@params $params) $ret) - (get-doc-function $atom %Undefined%) - (@doc-formal (@item $atom) (@kind atom) (@type $type) (@desc "No documentation")) ))))) - -(@doc help! - (@desc "Function prints documentation for the input atom.") - (@params ( - (@param "Input to get documentation for"))) - (@return "Unit atom")) -(: help! (-> Atom (->))) -(= (help! $atom) - (case (get-doc $atom) ( - ((@doc-formal (@item $item) (@kind function) (@type $type) (@desc $descr) - (@params $params) - (@return (@type $ret-type) (@desc $ret-desc))) - (let () (println! (format-args "Function {}: {} {}" ($item $type $descr))) - (let () (println! (format-args "Parameters:" ())) - (let () (for-each-in-atom $params help-param!) - (let () (println! (format-args "Return: (type {}) {}" ($ret-type $ret-desc))) - () ))))) - ((@doc-formal (@item $item) (@kind function) (@type $type) (@desc $descr)) - (let () (println! (format-args "Function {} (type {}) {}" ($item $type $descr))) - () )) - ((@doc-formal (@item $item) (@kind atom) (@type $type) (@desc $descr)) - (let () (println! (format-args "Atom {}: {} {}" ($item $type $descr))) - () )) - ($other (Error $other "Cannot match @doc-formal structure") )))) - -(@doc help-param! - (@desc "Function used by function help! to output parameters using println!") - (@params ( - (@param "Parameters list"))) - (@return "Unit atom")) -(: help-param! (-> Atom (->))) -(= (help-param! $param) - (let (@param (@type $type) (@desc $desc)) $param - (println! (format-args " {} {}" ((type $type) $desc))) )) - -(@doc for-each-in-atom - (@desc "Applies function passed as a second argument to each atom inside first argument") - (@params ( - (@param "Expression to each atom in which function will be applied") - (@param "Function to apply"))) - (@return "Unit atom")) -(: for-each-in-atom (-> Expression Atom (->))) -(= (for-each-in-atom $expr $func) - (if (noreduce-eq $expr ()) - () - (let $head (car-atom $expr) - (let $tail (cdr-atom $expr) - (let $_ ($func $head) - (for-each-in-atom $tail $func) ))))) - -(@doc noreduce-eq - (@desc "Checks equality of two atoms without reducing them") - (@params ( - (@param "First atom") - (@param "Second atom"))) - (@return "True if not reduced atoms are equal, False - otherwise")) -(: noreduce-eq (-> Atom Atom Bool)) -(= (noreduce-eq $a $b) (== (quote $a) (quote $b))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Grounded function's documentation -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(@doc add-atom - (@desc "Adds atom into the atomspace without reducing it") - (@params ( - (@param "Atomspace to add atom into") - (@param "Atom to add"))) - (@return "Unit atom")) - -(@doc match - (@desc "Searches for all declared atoms corresponding to the given pattern (second argument) and produces the output pattern (third argument)") - (@params ( - (@param "A grounded atom referencing a Space") - (@param "Pattern atom to be matched") - (@param "Output pattern typically containing variables from the input pattern"))) - (@return "If match was successfull it outputs pattern (third argument) with filled variables (if any were present in pattern) using matched pattern (second argument). Nothing - otherwise")) - -(@doc bind! - (@desc "Registers a new token which is replaced with an atom during the parsing of the rest of the program") - (@params ( - (@param "Token name") - (@param "Atom, which is associated with the token after reduction"))) - (@return "Unit atom")) - -(@doc new-space - (@desc "Creates new Atomspace which could be used further in the program as a separate from &self Atomspace") - (@params ()) - (@return "Reference to a new space")) - -(@doc remove-atom - (@desc "Removes atom from the input Atomspace") - (@params ( - (@param "Reference to the space from which the Atom needs to be removed") - (@param "Atom to be removed"))) - (@return "Unit atom")) - -(@doc get-atoms - (@desc "Shows all atoms in the input Atomspace") - (@params ( - (@param "Reference to the space"))) - (@return "List of all atoms in the input space")) - -(@doc new-state - (@desc "Creates a new state atom wrapping its argument") - (@params ( - (@param "Atom to be wrapped"))) - (@return "Returns (State $value) where $value is an argument to a new-state")) - -(@doc change-state! - (@desc "Changes input state's wrapped atom to another value (second argument). E.g. (change-state! (State 5) 6) -> (State 6)") - (@params ( - (@param "State created by new-state function") - (@param "Atom which will replace wrapped atom in the input state"))) - (@return "State with replaced wrapped atom")) - -(@doc get-state - (@desc "Gets a state as an argument and returns its wrapped atom. E.g. (get-state (State 5)) -> 5") - (@params ( - (@param "State"))) - (@return "Atom wrapped by state")) - -(@doc get-metatype - (@desc "Returns metatype of the input atom") - (@params ( - (@param "Atom to get metatype for"))) - (@return "Metatype of input atom")) - -(@doc register-module! - (@desc "Takes a file system path (first argument) and loads the module into the runner") - (@params ( - (@param "File system path"))) - (@return "Unit atom")) - -(@doc mod-space! - (@desc "Returns the space of the module (first argument) and tries to load the module if it is not loaded into the module system") - (@params ( - (@param "Module name"))) - (@return "Space name")) - -(@doc print-mods! - (@desc "Prints all modules with their correspondent spaces") - (@params ()) - (@return "Unit atom")) - -(@doc sealed - (@desc "Replaces all occurrences of any var from var list (first argument) inside atom (second argument) by unique variable. Can be used to create a locally scoped variables") - (@params ( - (@param "Variable list e.g. ($x $y)") - (@param "Atom which uses those variables"))) - (@return "Second argument but with variables being replaced with unique variables")) - -(@doc assertEqual - (@desc "Compares (sets of) results of evaluation of two expressions") - (@params ( - (@param "First expression") - (@param "Second expression"))) - (@return "Unit atom if both expression after evaluation is equal, error - otherwise")) - -(@doc assertEqualToResult - (@desc "Same as assertEqual but it doesn't evaluate second argument. Second argument is considered as a set of values of the first argument's evaluation") - (@params ( - (@param "First expression (it will be evaluated)") - (@param "Second expression (it won't be evaluated)"))) - (@return "Unit atom if both expression after evaluation is equal, error - otherwise")) - -(@doc collapse - (@desc "Converts a nondeterministic result into a tuple") - (@params ( - (@param "Atom which will be evaluated"))) - (@return "Tuple")) - -(@doc capture - (@desc "Wraps an atom and capture the current space") - (@params ( - (@param "Function name which space need to be captured"))) - (@return "Function")) - -(@doc case - (@desc "Subsequently tests multiple pattern-matching conditions (second argument) for the given value (first argument)") - (@params ( - (@param "Atom (it will be evaluated)") - (@param "Tuple of pairs mapping condition patterns to results"))) - (@return "Result of evaluating of Atom bound to met condition")) - - - -(@doc superpose - (@desc "Turns a tuple (first argument) into a nondeterministic result") - (@params ( - (@param "Tuple to be converted"))) - (@return "Argument converted to nondeterministic result")) - -(@doc get-type - (@desc "Returns type notation of input atom") - (@params ( - (@param "Atom to get type for"))) - (@return "Type notation or %Undefined% if there is no type for input Atom")) - -(@doc get-type-space - (@desc "Returns type notation of input Atom (second argument) relative to a specified atomspace (first argument)") - (@params ( - (@param "Atomspace where type notation for input atom will be searched") - (@param "Atom to get type for"))) - (@return "Type notation or %Undefined% if there is no type for input Atom in provided atomspace")) - -(@doc import! - (@desc "Imports module using its relative path (second argument) and binds it to the token (first argument) which will represent imported atomspace. If first argument is &self then everything will be imported to current atomspace") - (@params ( - (@param "Symbol, which is turned into the token for accessing the imported module") - (@param "Module name"))) - (@return "Unit atom")) - -(@doc include - (@desc "Works just like import! but with &self as a first argument. So everything from input file will be included in the current atomspace and evaluated") - (@params ( - (@param "Name of metta script to import"))) - (@return "Unit atom")) - - -(@doc pragma! - (@desc "Changes global key's (first argument) value to a new one (second argument)") - (@params ( - (@param "Key's name") - (@param "New value"))) - (@return "Unit atom")) - - -; TODO: Segmentation fault (core dumped) when calling !(help &self) -;(@doc &self -; (@desc "Returns reference to the current atomspace") -; (@params ()) -; (@return "Reference to the current atomspace")) - -; TODO: get-doc/help! not working for + -(@doc + - (@desc "Sums two numbers") - (@params ( - (@param "Addend") - (@param "Augend"))) - (@return "Sum")) - -; TODO: get-doc/help! not working for - -(@doc - - (@desc "Subtracts second argument from first one") - (@params ( - (@param "Minuend") - (@param "Deductible"))) - (@return "Difference")) - -; TODO: get-doc/help! not working for * -(@doc * - (@desc "Multiplies two numbers") - (@params ( - (@param "Multiplier") - (@param "Multiplicand"))) - (@return "Product")) - -; TODO: get-doc/help! not working for / -(@doc / - (@desc "Divides first argument by second one") - (@params ( - (@param "Dividend") - (@param "Divisor"))) - (@return "Fraction")) - -; TODO: get-doc/help! not working for % -(@doc % - (@desc "Modulo operator. It returns remainder of dividing first argument by second argument") - (@params ( - (@param "Dividend") - (@param "Divisor"))) - (@return "Remainder")) - -; TODO: get-doc/help! not working for < -(@doc < - (@desc "Less than. Checks if first argument is less than second one") - (@params ( - (@param "First number") - (@param "Second number"))) - (@return "True if first argument is less than second, False - otherwise")) - -; TODO: get-doc/help! not working for > -(@doc > - (@desc "Greater than. Checks if first argument is greater than second one") - (@params ( - (@param "First number") - (@param "Second number"))) - (@return "True if first argument is greater than second, False - otherwise")) - -; TODO: get-doc/help! not working for <= -(@doc <= - (@desc "Less than or equal. Checks if first argument is less than or equal to second one") - (@params ( - (@param "First number") - (@param "Second number"))) - (@return "True if first argument is less than or equal to second, False - otherwise")) - -; TODO: get-doc/help! not working for >= -(@doc >= - (@desc "Greater than or equal. Checks if first argument is greater than or equal to second one") - (@params ( - (@param "First number") - (@param "Second number"))) - (@return "True if first argument is greater than or equal to second, False - otherwise")) - -; TODO: get-doc/help! not working for == -(@doc == - (@desc "Checks equality for two arguments of the same type") - (@params ( - (@param "First argument") - (@param "Second argument"))) - (@return "Returns True if two arguments are equal, False - otherwise. If arguments are of different type function returns Error currently")) - -; TODO: get-doc/help! not working for and -(@doc and - (@desc "Logical conjunction of two arguments") - (@params ( - (@param "First argument") - (@param "Second argument"))) - (@return "Returns True if both arguments are True, False - otherwise")) - -; TODO: get-doc/help! not working for or -(@doc or - (@desc "Logical disjunction of two arguments") - (@params ( - (@param "First argument") - (@param "Second argument"))) - (@return "True if any of input arguments is True, False - otherwise")) - -; TODO: get-doc/help! not working for not -(@doc not - (@desc "Negation") - (@params ( - (@param "Argument"))) - (@return "Negates boolean input argument (False -> True, True -> False)")) - -(@doc xor - (@desc "Exclusive disjunction of two arguments") - (@params ( - (@param "First argument") - (@param "Second argument"))) - (@return "Return values are the same as logical disjunction, but when both arguments are True xor will return False")) - -(@doc flip - (@desc "Produces random boolean value") - (@params ()) - (@return "Random boolean value")) - -(@doc unique - (@desc "Function takes non-deterministic input (first argument) and returns only unique entities. E.g. (unique (superpose (a b c d d))) -> [a, b, c, d]") - (@params ( - (@param "Non-deterministic set of values"))) - (@return "Unique values from input set")) - -(@doc union - (@desc "Function takes two non-deterministic inputs (first and second argument) and returns their union. E.g. (union (superpose (a b b c)) (superpose (b c c d))) -> [a, b, b, c, b, c, c, d]") - (@params ( - (@param "Non-deterministic set of values") - (@param "Another non-deterministic set of values"))) - (@return "Union of sets")) - -(@doc intersection - (@desc "Function takes two non-deterministic inputs (first and second argument) and returns their intersection. E.g. (intersection (superpose (a b c c)) (superpose (b c c c d))) -> [b, c, c]") - (@params ( - (@param "Non-deterministic set of values") - (@param "Another non-deterministic set of values"))) - (@return "Intersection of sets")) - -(@doc subtraction - (@desc "Function takes two non-deterministic inputs (first and second argument) and returns their subtraction. E.g. !(subtraction (superpose (a b b c)) (superpose (b c c d))) -> [a, b]") - (@params ( - (@param "Non-deterministic set of values") - (@param "Another non-deterministic set of values"))) - (@return "Subtraction of sets")) - -(@doc git-module! - (@desc "Provides access to module in a remote git repo, from within MeTTa code. Similar to `register-module!`, this op will bypass the catalog search") - (@params ( - (@param "URL to github repo"))) - (@return "Unit atom")) \ No newline at end of file diff --git a/.Attic/metta_lang/stdlib_minimal.metta b/.Attic/metta_lang/stdlib_minimal.metta deleted file mode 100755 index a732581cebc..00000000000 --- a/.Attic/metta_lang/stdlib_minimal.metta +++ /dev/null @@ -1,1001 +0,0 @@ -(@doc = - (@desc "A symbol used to define reduction rules for expressions.") - (@params ( - (@param "Pattern to be matched against expression to be reduced") - (@param "Result of reduction or transformation of the first pattern") )) - (@return "Not reduced itself unless custom equalities over equalities are added") ) -(: = (-> $t $t Atom)) - -(@doc ErrorType (@desc "Type of the atom which contains error")) -(: ErrorType Type) - -(@doc Error - (@desc "Error constructor") - (@params ( - (@param "Atom which contains error") - (@param "Error message, can be one of the reserved symbols: BadType, IncorrectNumberOfArguments"))) - (@return "Instance of the error atom")) -(: Error (-> Atom Atom ErrorType)) - -(@doc return - (@desc "Returns value from the (function ...) expression") - (@params ( - (@param "Value to be returned"))) - (@return "Passed argument")) -(: return (-> $t $t)) - -(@doc function - (@desc "Evaluates the argument until it becomes (return ). Then (function (return )) is reduced to the .") - (@params ( - (@param "Atom to be evaluated"))) - (@return "Result of atom's evaluation")) -(: function (-> Atom Atom)) - -(@doc eval - (@desc "Evaluates input atom, makes one step of the evaluation") - (@params ( - (@param "Atom to be evaluated, can be reduced via equality expression (= ...) or by calling a grounded function"))) - (@return "Result of evaluation")) -(: eval (-> Atom Atom)) - -(@doc chain - (@desc "Evaluates first argument, binds it to the variable (second argument) and then evaluates third argument which contains (or not) mentioned variable") - (@params ( - (@param "Atom to be evaluated") - (@param "Variable") - (@param "Atom which will be evaluated at the end"))) - (@return "Result of evaluating third input argument")) -(: chain (-> Atom Variable Atom Atom)) - -(@doc unify - (@desc "Matches two first arguments and returns third argument if they are matched and forth argument otherwise") - (@params ( - (@param "First atom to unify with") - (@param "Second atom to unify with") - (@param "Result if two atoms unified successfully") - (@param "Result otherwise"))) - (@return "Third argument when first two atoms are matched of forth one otherwise")) -(: unify (-> Atom Atom Atom Atom Atom)) - -(@doc cons-atom - (@desc "Constructs an expression using two arguments") - (@params ( - (@param "Head of an expression") - (@param "Tail of an expression"))) - (@return "New expression consists of two input arguments")) -(: cons-atom (-> Atom Expression Expression)) - -(@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 ( - (@param "Expression"))) - (@return "Deconsed expression")) -(: decons-atom (-> Expression Expression)) - -(@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.") - (@params ( - (@param "Atom to be evaluated"))) - (@return "All alternative evaluations")) -(: collapse-bind (-> Atom Expression)) - -(@doc superpose-bind - (@desc "Complement to the collapse-bind. It takes result of collapse-bind (first argument) and returns only result atoms without bindings") - (@params ( - (@param "Expression in form (Atom Binding)"))) - (@return "Non-deterministic list of Atoms")) -(: superpose-bind (-> Expression Atom)) - -(@doc metta - (@desc "Run MeTTa interpreter on atom.") - (@params ( - (@param "Atom to be interpreted") - (@param "Type of input atom") - (@param "Atomspace where intepretation should take place"))) - (@return "Result of interpretation")) -(: metta (-> Atom Type Grounded Atom)) - -(@doc id - (@desc "Returns its argument") - (@params ( - (@param "Input argument"))) - (@return "Input argument")) -(: id (-> Atom Atom)) -(= (id $x) $x) - -(@doc atom-subst - (@desc "Substitutes variable passed as a second argument in the third argument by the first argument") - (@params ( - (@param "Value to use for replacement") - (@param "Variable to replace") - (@param "Template to replace variable by the value"))) - (@return "Template with substituted variable")) -(: atom-subst (-> Atom Variable Atom Atom)) -(= (atom-subst $atom $var $templ) - (function (chain (eval (id $atom)) $var (return $templ))) ) - -(@doc if-decons-expr - (@desc "Checks if first argument is non empty expression. If so gets tail and head from the first argument and returns forth argument using head and tail values. Returns fifth argument otherwise.") - (@params ( - (@param "Expression to be deconstructed") - (@param "Head variable") - (@param "Tail variable") - (@param "Template to return if first argument is a non-empty expression") - (@param "Default value to return otherwise"))) - (@return "Either template with head and tail replaced by values or default value")) -(: if-decons-expr (-> Expression Variable Variable Atom Atom Atom)) -(= (if-decons-expr $atom $head $tail $then $else) - (function (eval (if-equal $atom () - (return $else) - (chain (decons-atom $atom) $list - (unify $list ($head $tail) (return $then) (return $else)) ))))) - -(@doc if-error - (@desc "Checks if first argument is an error atom. Returns second argument if so or third argument otherwise.") - (@params ( - (@param "Atom to be checked for the error") - (@param "Value to return if first argument is an error") - (@param "Value to return otherwise"))) - (@return "Second or third argument")) -(: if-error (-> Atom Atom Atom Atom)) -(= (if-error $atom $then $else) - (function (chain (eval (get-metatype $atom)) $meta - (eval (if-equal $meta Expression - (eval (if-equal $atom () - (return $else) - (chain (decons-atom $atom) $list - (unify $list ($head $tail) - (eval (if-equal $head Error (return $then) (return $else))) - (return $else) )))) - (return $else) ))))) - -(@doc return-on-error - (@desc "Returns first argument if it is Empty or an error. Returns second argument otherwise.") - (@params ( - (@param "Previous evaluation result") - (@param "Atom for further evaluation"))) - (@return "Return previous result if it is an error or Empty or continue evaluation")) -(: return-on-error (-> Atom Atom Atom)) -(= (return-on-error $atom $then) - (function (eval (if-equal $atom Empty (return (return Empty)) - (eval (if-error $atom (return (return $atom)) - (return $then) )))))) - -; Difference between `switch` and `case` is a way how they interpret `Empty` -; result. `CaseOp` interprets first argument inside itself and then manually -; checks whether result is empty. `switch` is interpreted in a context of -; main interpreter. Minimal interpreter correctly passes `Empty` as an -; argument to the `switch` but when `switch` is called from MeTTa interpreter -; (for example user evaluates `!(switch (unify A B ok Empty) ...)` then -; emptiness of the first argument is checked by interpreter and it will -; break execution when `Empty` is returned. -(@doc switch - (@desc "Subsequently tests multiple pattern-matching conditions (second argument) for the given value (first argument)") - (@params ( - (@param "Atom to be matched with patterns") - (@param "Tuple of pairs mapping condition patterns to results"))) - (@return "Result which corresponds to the pattern which is matched with the passed atom first")) - - -(: switch (-> %Undefined% Expression Atom)) -(= (switch $atom $cases) - (function (chain (decons-atom $cases) $list - (chain (eval (switch-internal $atom $list)) $res - (chain (eval (if-equal $res NotReducible Empty $res)) $x (return $x)) )))) - -(@doc switch-internal - (@desc "This function is being called inside switch function to test one of the cases and it calls switch once again if current condition is not met") - (@params ( - (@param "Atom (it will be evaluated)") - (@param "Deconsed tuple of pairs mapping condition patterns to results"))) - (@return "Result of evaluating of Atom bound to met condition")) -(= (switch-internal $atom (($pattern $template) $tail)) - (function (unify $atom $pattern - (return $template) - (chain (eval (switch $atom $tail)) $ret (return $ret)) ))) - - - - -; TODO: Type is used here, but there is no definition for the -> type -; constructor for instance, thus in practice it matches because -> has -; %Undefined% type. We need to assign proper type to -> and other type -; constructors but it is not possible until we support vararg types. -(@doc is-function - (@desc "Function checks if input type is a function type") - (@params ( - (@param "Type atom"))) - (@return "True if type is a function type, False - otherwise")) -(: is-function (-> Type Bool)) -(= (is-function $type) - (function (chain (eval (get-metatype $type)) $meta - (eval (switch ($type $meta) ( - (($type Expression) - (eval (if-decons-expr $type $head $_tail - (unify $head -> (return True) (return False)) - (return (Error (is-function $type) "is-function non-empty expression as an argument")) ))) - (($type $meta) (return False)) - )))))) - -(@doc type-cast - (@desc "Casts atom passed as a first argument to the type passed as a second argument using space as a context") - (@params ( - (@param "Atom to be casted") - (@param "Type to cast atom to") - (@param "Context atomspace"))) - (@return "Atom if casting is successful, (Error ... BadType) otherwise")) -(= (type-cast $atom $type $space) - (function (chain (eval (get-metatype $atom)) $meta - (eval (if-equal $type $meta - (return $atom) - (chain (eval (collapse-bind (eval (get-type $atom $space)))) $collapsed - (chain (eval (map-atom $collapsed $pair (eval (first-from-pair $pair)))) $actual-types - (chain (eval (foldl-atom $actual-types False $a $b (eval (match-type-or $a $b $type)))) $is-some-comp - (eval (if $is-some-comp - (return $atom) - (return (Error $atom BadType)) )))))))))) - -(@doc match-types - (@desc "Checks if two types can be unified and returns third argument if so, fourth - otherwise") - (@params ( - (@param "First type") - (@param "Second type") - (@param "Atom to be returned if types can be unified") - (@param "Atom to be returned if types cannot be unified"))) - (@return "Third or fourth argument")) -(= (match-types $type1 $type2 $then $else) - (function (eval (if-equal $type1 %Undefined% - (return $then) - (eval (if-equal $type2 %Undefined% - (return $then) - (eval (if-equal $type1 Atom - (return $then) - (eval (if-equal $type2 Atom - (return $then) - (unify $type1 $type2 (return $then) (return $else)) )))))))))) - -(@doc first-from-pair - (@desc "Gets a pair as a first argument and returns first atom from pair") - (@params ( - (@param "Pair"))) - (@return "First atom from a pair")) -(= (first-from-pair $pair) - (function - (unify $pair ($first $second) - (return $first) - (return (Error (first-from-pair $pair) "incorrect pair format"))))) - -(@doc match-type-or - (@desc "Checks if two types (second and third arguments) can be unified and returns result of OR operation between first argument and type checking result") - (@params ( - (@param "Boolean value") - (@param "First type") - (@param "Second type"))) - (@return "True or False")) -(= (match-type-or $folded $next $type) - (function - (chain (eval (match-types $next $type True False)) $matched - (chain (eval (or $folded $matched)) $or (return $or)) ))) - -(@doc filter-atom - (@desc "Function takes list of atoms (first argument), variable (second argument) and filter predicate (third argument) and returns list with items which passed filter. E.g. (filter-atom (1 2 3 4) $v (eval (> $v 2))) will give (3 4)") - (@params ( - (@param "List of atoms") - (@param "Variable") - (@param "Filter predicate"))) - (@return "Filtered list")) -(: filter-atom (-> Expression Variable Atom Expression)) -(= (filter-atom $list $var $filter) - (function (eval (if-decons-expr $list $head $tail - (chain (eval (filter-atom $tail $var $filter)) $tail-filtered - (chain (eval (atom-subst $head $var $filter)) $filter-expr - (chain $filter-expr $is-filtered - (eval (if $is-filtered - (chain (cons-atom $head $tail-filtered) $res (return $res)) - (return $tail-filtered) ))))) - (return ()) )))) - -(@doc map-atom - (@desc "Function takes list of atoms (first argument), variable to be used inside (second variable) and an expression which will be evaluated for each atom in list (third argument). Expression should contain variable. So e.g. (map-atom (1 2 3 4) $v (eval (+ $v 1))) will give (2 3 4 5)") - (@params ( - (@param "List of atoms") - (@param "Variable name") - (@param "Template using variable"))) - (@return "Result of evaluating template for each atom in a list")) -(: map-atom (-> Expression Variable Atom Expression)) -(= (map-atom $list $var $map) - (function (eval (if-decons-expr $list $head $tail - (chain (eval (map-atom $tail $var $map)) $tail-mapped - (chain (eval (atom-subst $head $var $map)) $map-expr - (chain $map-expr $head-mapped - (chain (cons-atom $head-mapped $tail-mapped) $res (return $res)) ))) - (return ()) )))) - -(@doc foldl-atom - (@desc "Function takes list of values (first argument), initial value (second argument) and operation (fifth argument) and applies it consequently to the list of values, using init value as a start. It also takes two variables (third and fourth argument) to use them inside") - (@params ( - (@param "List of values") - (@param "Init value") - (@param "Variable") - (@param "Variable") - (@param "Operation"))) - (@return "Result of applying operation to the list of values")) -(: foldl-atom (-> Expression Atom Variable Variable Atom Atom)) -(= (foldl-atom $list $init $a $b $op) - (function (eval (if-decons-expr $list $head $tail - (chain (eval (atom-subst $init $a $op)) $op-init - (chain (eval (atom-subst $head $b $op-init)) $op-head - (chain $op-head $head-folded - (chain (eval (foldl-atom $tail $head-folded $a $b $op)) $res (return $res)) ))) - (return $init) )))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Standard library written in MeTTa ; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(@doc if-equal - (@desc "Checks if first two arguments are equal and evaluates third argument if equal, fourth argument - otherwise") - (@params ( - (@param "First argument") - (@param "Second argument") - (@param "Atom to be evaluated if arguments are equal") - (@param "Atom to be evaluated if arguments are not equal"))) - (@return "Evaluated third or fourth argument")) - - -(@doc if - (@desc "Replace itself by one of the arguments depending on condition.") - (@params ( - (@param "Boolean condition") - (@param "Result when condition is True") - (@param "Result when condition is False"))) - (@return "Second or third argument") ) -(: if (-> Bool Atom Atom $t)) -(= (if True $then $else) $then) -(= (if False $then $else) $else) - -; TODO: help! not working for operations which are defined in both Python and -; Rust standard library: or, and, not -(@doc or - (@desc "Logical disjunction of two arguments") - (@params ( - (@param "First argument") - (@param "Second argument"))) - (@return "True if any of input arguments is True, False - otherwise")) -(: or (-> Bool Bool Bool)) -(= (or False False) False) -(= (or False True) True) -(= (or True False) True) -(= (or True True) True) - -(@doc and - (@desc "Logical conjunction of two arguments") - (@params ( - (@param "First argument") - (@param "Second argument"))) - (@return "Returns True if both arguments are True, False - otherwise")) -(: and (-> Bool Bool Bool)) -(= (and False False) False) -(= (and False True) False) -(= (and True False) False) -(= (and True True) True) - -(@doc not - (@desc "Logical negation") - (@params ( - (@param "Argument"))) - (@return "Negates boolean input argument (False -> True, True -> False)")) -(: not (-> Bool Bool)) -(= (not True) False) -(= (not False) True) - -(@doc let - (@desc "Unify two first argument and apply result of the unification on third argument. Second argument is evaluated before unification.") - (@params ( - (@param "First atom to be unified") - (@param "Second atom to be unified") - (@param "Expression which will be evaluated if two first arguments can be unified"))) - (@return "Third argument or Empty")) -(: let (-> Atom %Undefined% Atom %Undefined%)) -(= (let $pattern $atom $template) - (unify $atom $pattern $template Empty)) - -(@doc let* - (@desc "Same as let but inputs list of pairs of atoms to be unified. For example (let* (($v1 (+ 1 2)) ($v2 (* 5 6))) (+ $v1 $v2))") - (@params ( - (@param "List of pairs, atoms in each pair to be unified") - (@param "Expression which will be evaluated if each pair can be unified"))) - (@return "Second argument or Empty")) -(: let* (-> Expression Atom %Undefined%)) -(= (let* $pairs $template) - (eval (if-decons-expr $pairs ($pattern $atom) $tail - (let $pattern $atom (let* $tail $template)) - $template ))) - -(@doc add-reduct - (@desc "Reduces atom (second argument) and adds it into the atomspace (first argument)") - (@params ( - (@param "Atomspace to add atom into") - (@param "Atom to add"))) - (@return "Unit atom")) -(: add-reduct (-> Grounded %Undefined% (->))) -(= (add-reduct $dst $atom) (add-atom $dst $atom)) - -(@doc car-atom - (@desc "Extracts the first atom of an expression as a tuple") - (@params ( - (@param "Expression"))) - (@return "First atom of an expression")) -(: car-atom (-> Expression Atom)) -(= (car-atom $atom) - (eval (if-decons-expr $atom $head $_ - $head - (Error (car-atom $atom) "car-atom expects a non-empty expression as an argument") ))) - -(@doc cdr-atom - (@desc "Extracts the tail of an expression (all except first atom)") - (@params ( - (@param "Expression"))) - (@return "Tail of an expression")) -(: cdr-atom (-> Expression Expression)) -(= (cdr-atom $atom) - (eval (if-decons-expr $atom $_ $tail - $tail - (Error (cdr-atom $atom) "cdr-atom expects a non-empty expression as an argument") ))) - -(@doc quote - (@desc "Prevents atom from being reduced") - (@params ( - (@param "Atom"))) - (@return "Quoted atom")) -(: quote (-> Atom Atom)) -(= (quote $atom) NotReducible) - -(@doc unquote - (@desc "Unquotes quoted atom, e.g. (unquote (quote $x)) returns $x") - (@params ( - (@param "Quoted atom"))) - (@return "Unquoted atom")) -(: unquote (-> %Undefined% %Undefined%)) -(= (unquote (quote $atom)) $atom) - -; TODO: there is no way to define operation which consumes any number of -; arguments and returns unit -(@doc nop - (@desc "Outputs unit atom") - (@params ()) - (@return "Unit atom")) -(= (nop) ()) -(= (nop $x) ()) - -; TODO: MINIMAL added for compatibility, remove after migration -(@doc empty - (@desc "Cuts evaluation of the non-deterministic branch and removes it from the result") - (@params ()) - (@return "Nothing")) -(= (empty) Empty) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Documentation formatting functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(@doc @doc - (@desc "Used for documentation purposes. Function documentation starts with @doc") - (@params ( - (@param "Function name") - (@param "Function description. Starts with @desc") - (@param "(Optional) parameters description starting with @params which should contain one or more @param symbols") - (@param "(Optional) description of what function will return. Starts with @return"))) - (@return "Function documentation using @doc-formal")) -(: @doc (-> Atom DocDescription DocInformal)) -(: @doc (-> Atom DocDescription DocParameters DocReturnInformal DocInformal)) - -(@doc @desc - (@desc "Used for documentation purposes. Description of function starts with @desc as a part of @doc") - (@params ( - (@param "String containing function description"))) - (@return "Function description")) -(: @desc (-> String DocDescription)) - -(@doc @param - (@desc "Used for documentation purposes. Description of function parameter starts with @param as a part of @params which is a part of @doc") - (@params ( - (@param "String containing parameter description"))) - (@return "Parameter description")) -(: @param (-> String DocParameterInformal)) -(: @param (-> DocType DocDescription DocParameter)) - -(@doc @return - (@desc "Used for documentation purposes. Description of function return value starts with @return as a part of @doc") - (@params ( - (@param "String containing return value description"))) - (@return "Return value description")) -(: @return (-> String DocReturnInformal)) -(: @return (-> DocType DocDescription DocReturn)) - -(@doc @doc-formal - (@desc "Used for documentation purposes. get-doc returns documentation starting with @doc-formal symbol. @doc-formal contains 6 or 4 parameters depending on the entity being described (functions being described using 6 parameters, atoms - 4 parameters)") - (@params ( - (@param "Function/Atom name for which documentation is to be displayed. Format (@item name)") - (@param "Contains (@kind function) or (@kind atom) depends on entity which documentation is displayed") - (@param "Contains type notation of function/atom") - (@param "Function/atom description") - (@param "(Functions only). Description of function parameters") - (@param "(Functions only). Description of function's return value"))) - (@return "Expression containing full documentation on function")) -(: @doc-formal (-> DocItem DocKindFunction DocType DocDescription DocParameters DocReturn DocFormal)) -(: @doc-formal (-> DocItem DocKindAtom DocType DocDescription DocFormal)) - -(@doc @item - (@desc "Used for documentation purposes. Converts atom/function's name to DocItem") - (@params ( - (@param "Atom/Function name to be documented"))) - (@return "(@item Atom) entity")) -(: @item (-> Atom DocItem)) - -; TODO: help! gives two outputs -;Atom (@kind function): (%Undefined% (-> Atom Atom)) Used for documentation purposes. Shows type of entity to be documented. (@kind function) in this case -;Atom (@kind function): DocKindFunction Used for documentation purposes. Shows type of entity to be documented. (@kind function) in this case -(@doc (@kind function) - (@desc "Used for documentation purposes. Shows type of entity to be documented. (@kind function) in this case")) -(: (@kind function) DocKindFunction) - -(@doc (@kind atom) - (@desc "Used for documentation purposes. Shows type of entity to be documented. (@kind atom) in this case")) -(: (@kind atom) DocKindAtom) - -(@doc @type - (@desc "Used for documentation purposes. Converts atom/function's type to DocType") - (@params ( - (@param "Atom/Function type to be documented"))) - (@return "(@type Type) entity")) -(: @type (-> Type DocType)) - -(@doc @params - (@desc "Used for function documentation purposes. Contains several @param entities with description of each @param") - (@params ( - (@param "Several (@param ...) entities"))) - (@return "DocParameters containing description of all parameters of function in form of (@params ((@param ...) (@param ...) ...))")) -(: @params (-> Expression DocParameters)) - -(@doc get-doc - (@desc "Returns documentation for the given Atom/Function") - (@params ( - (@param "Atom/Function name for which documentation is needed"))) - (@return "Documentation for the given atom/function")) -(: get-doc (-> Atom Atom)) -(= (get-doc $atom) - (let $meta-type (get-metatype $atom) - (case $meta-type ( - (Expression (get-doc-atom $atom)) - ($_ (get-doc-single-atom $atom)) )))) - -(@doc get-doc-single-atom - (@desc "Function used by get-doc to get documentation on either function or atom. It checks if input name is the name of function or atom and calls correspondent function") - (@params ( - (@param "Atom/Function name for which documentation is needed"))) - (@return "Documentation for the given atom/function")) -(: get-doc-single-atom (-> Atom Atom)) -(= (get-doc-single-atom $atom) - (let $top-space (mod-space! top) - (let $type (get-type-space $top-space $atom) - (if (is-function $type) - (get-doc-function $atom $type) - (get-doc-atom $atom) )))) - -(@doc get-doc-function - (@desc "Function used by get-doc-single-atom to get documentation on a function. It returns documentation on a function if it exists or default documentation with no description otherwise") - (@params ( - (@param "Function name for which documentation is needed") - (@param "Type notation for this function"))) - (@return "Documentation for the given function")) -(: get-doc-function (-> Atom Type Atom)) -(= (get-doc-function $name $type) - (let $top-space (mod-space! top) - (unify $top-space (@doc $name $desc (@params $params) $ret) - (let $type' (if (== $type %Undefined%) (undefined-doc-function-type $params) (cdr-atom $type)) - (let ($params' $ret') (get-doc-params $params $ret $type') - (@doc-formal (@item $name) (@kind function) (@type $type) $desc (@params $params') $ret'))) - (@doc-formal (@item $name) (@kind function) (@type $type) (@desc "No documentation")) ))) - -(@doc undefined-doc-function-type - (@desc "Function used by get-doc-single-atom in case of absence of function's type notation") - (@params ( - (@param "List of parameters for the function we want to get documentation for"))) - (@return "List of %Undefined% number of which depends on input list size. So for two parameters function will return (%Undefined% %Undefined% %Undefined%)")) -(: undefined-doc-function-type (-> Expression Type)) -(= (undefined-doc-function-type $params) - (if (== () $params) (%Undefined%) - (let $params-tail (cdr-atom $params) - (let $tail (undefined-doc-function-type $params-tail) - (cons-atom %Undefined% $tail) )))) - -(@doc get-doc-params - (@desc "Function used by get-doc-function to get function's parameters documentation (including return value)") - (@params ( - (@param "List of parameters in form of ((@param Description) (@param Description)...)") - (@param "Return value's description in form of (@return Description)") - (@param "Type notation without -> starting symbol e.g. (Atom Atom Atom)"))) - (@return "United list of params and return value each augmented with its type. E.g. (((@param (@type Atom) (@desc Description)) (@param (@type Atom) (@desc Description2))) (@return (@type Atom) (@desc Description)))")) -(: get-doc-params (-> Expression Atom Expression (Expression Atom))) -(= (get-doc-params $params $ret $types) - (let $head-type (car-atom $types) - (let $tail-types (cdr-atom $types) - (if (== () $params) - (let (@return $ret-desc) $ret - (() (@return (@type $head-type) (@desc $ret-desc))) ) - (let (@param $param-desc) (car-atom $params) - (let $tail-params (cdr-atom $params) - (let ($params' $result-ret) (get-doc-params $tail-params $ret $tail-types) - (let $result-params (cons-atom (@param (@type $head-type) (@desc $param-desc)) $params') - ($result-params $result-ret) )))))))) - -(@doc get-doc-atom - (@desc "Function used by get-doc (in case of input type Expression) and get-doc-single-atom (in case input value is not a function) to get documentation on input value") - (@params ( - (@param "Atom's name to get documentation for"))) - (@return "Documentation on input Atom")) -(: get-doc-atom (-> Atom Atom)) -(= (get-doc-atom $atom) - (let $top-space (mod-space! top) - (let $type (get-type-space $top-space $atom) - (unify $top-space (@doc $atom $desc) - (@doc-formal (@item $atom) (@kind atom) (@type $type) $desc) - (unify $top-space (@doc $atom $desc' (@params $params) $ret) - (get-doc-function $atom %Undefined%) - (@doc-formal (@item $atom) (@kind atom) (@type $type) (@desc "No documentation")) ))))) - -(@doc help! - (@desc "Function prints documentation for the input atom.") - (@params ( - (@param "Input to get documentation for"))) - (@return "Unit atom")) -(: help! (-> Atom (->))) -(= (help! $atom) - (case (get-doc $atom) ( - ((@doc-formal (@item $item) (@kind function) (@type $type) (@desc $descr) - (@params $params) - (@return (@type $ret-type) (@desc $ret-desc))) - (let () (println! (format-args "Function {}: {} {}" ($item $type $descr))) - (let () (println! (format-args "Parameters:" ())) - (let () (for-each-in-atom $params help-param!) - (let () (println! (format-args "Return: (type {}) {}" ($ret-type $ret-desc))) - () ))))) - ((@doc-formal (@item $item) (@kind function) (@type $type) (@desc $descr)) - (let () (println! (format-args "Function {} (type {}) {}" ($item $type $descr))) - () )) - ((@doc-formal (@item $item) (@kind atom) (@type $type) (@desc $descr)) - (let () (println! (format-args "Atom {}: {} {}" ($item $type $descr))) - () )) - ($other (Error $other "Cannot match @doc-formal structure") )))) - -(@doc help-param! - (@desc "Function used by function help! to output parameters using println!") - (@params ( - (@param "Parameters list"))) - (@return "Unit atom")) -(: help-param! (-> Atom (->))) -(= (help-param! $param) - (let (@param (@type $type) (@desc $desc)) $param - (println! (format-args " {} {}" ((type $type) $desc))) )) - -(@doc for-each-in-atom - (@desc "Applies function passed as a second argument to each atom inside first argument") - (@params ( - (@param "Expression to each atom in which function will be applied") - (@param "Function to apply"))) - (@return "Unit atom")) -(: for-each-in-atom (-> Expression Atom (->))) -(= (for-each-in-atom $expr $func) - (if (noreduce-eq $expr ()) - () - (let $head (car-atom $expr) - (let $tail (cdr-atom $expr) - (let $_ ($func $head) - (for-each-in-atom $tail $func) ))))) - -(@doc noreduce-eq - (@desc "Checks equality of two atoms without reducing them") - (@params ( - (@param "First atom") - (@param "Second atom"))) - (@return "True if not reduced atoms are equal, False - otherwise")) -(: noreduce-eq (-> Atom Atom Bool)) -(= (noreduce-eq $a $b) (== (quote $a) (quote $b))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Grounded function's documentation -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(@doc add-atom - (@desc "Adds atom into the atomspace without reducing it") - (@params ( - (@param "Atomspace to add atom into") - (@param "Atom to add"))) - (@return "Unit atom")) - -(@doc new-space - (@desc "Creates new Atomspace which could be used further in the program as a separate from &self Atomspace") - (@params ()) - (@return "Reference to a new space")) - -(@doc remove-atom - (@desc "Removes atom from the input Atomspace") - (@params ( - (@param "Reference to the space from which the Atom needs to be removed") - (@param "Atom to be removed"))) - (@return "Unit atom")) - -(@doc get-atoms - (@desc "Shows all atoms in the input Atomspace") - (@params ( - (@param "Reference to the space"))) - (@return "List of all atoms in the input space")) - -(@doc new-state - (@desc "Creates a new state atom wrapping its argument") - (@params ( - (@param "Atom to be wrapped"))) - (@return "Returns (State $value) where $value is an argument to a new-state")) - -(@doc change-state! - (@desc "Changes input state's wrapped atom to another value (second argument). E.g. (change-state! (State 5) 6) -> (State 6)") - (@params ( - (@param "State created by new-state function") - (@param "Atom which will replace wrapped atom in the input state"))) - (@return "State with replaced wrapped atom")) - -(@doc get-state - (@desc "Gets a state as an argument and returns its wrapped atom. E.g. (get-state (State 5)) -> 5") - (@params ( - (@param "State"))) - (@return "Atom wrapped by state")) - -(@doc get-type - (@desc "Returns type notation of input atom") - (@params ( - (@param "Atom to get type for"))) - (@return "Type notation or %Undefined% if there is no type for input Atom")) - -(@doc get-type-space - (@desc "Returns type notation of input Atom (second argument) relative to a specified atomspace (first argument)") - (@params ( - (@param "Atomspace where type notation for input atom will be searched") - (@param "Atom to get type for"))) - (@return "Type notation or %Undefined% if there is no type for input Atom in provided atomspace")) - -(@doc get-metatype - (@desc "Returns metatype of the input atom") - (@params ( - (@param "Atom to get metatype for"))) - (@return "Metatype of input atom")) - -(@doc match - (@desc "Searches for all declared atoms corresponding to the given pattern (second argument) inside space (first argument) and returns the output template (third argument)") - (@params ( - (@param "Atomspace to search pattern") - (@param "Pattern atom to be searched") - (@param "Output template typically containing variables from the input pattern"))) - (@return "If match was successfull it outputs template (third argument) with filled variables (if any were present in pattern) using matched pattern (second argument). Empty - otherwise")) - -(@doc register-module! - (@desc "Takes a file system path (first argument) and loads the module into the runner") - (@params ( - (@param "File system path"))) - (@return "Unit atom")) - -(@doc mod-space! - (@desc "Returns the space of the module (first argument) and tries to load the module if it is not loaded into the module system") - (@params ( - (@param "Module name"))) - (@return "Space name")) - -(@doc print-mods! - (@desc "Prints all modules with their correspondent spaces") - (@params ()) - (@return "Unit atom")) - -(@doc assertEqual - (@desc "Compares (sets of) results of evaluation of two expressions") - (@params ( - (@param "First expression") - (@param "Second expression"))) - (@return "Unit atom if both expression after evaluation is equal, error - otherwise")) - -(@doc assertEqualToResult - (@desc "Same as assertEqual but it doesn't evaluate second argument. Second argument is considered as a set of values of the first argument's evaluation") - (@params ( - (@param "First expression (it will be evaluated)") - (@param "Second expression (it won't be evaluated)"))) - (@return "Unit atom if both expression after evaluation is equal, error - otherwise")) - -(@doc collapse - (@desc "Converts a nondeterministic result into a tuple") - (@params ( - (@param "Atom which will be evaluated"))) - (@return "Tuple")) - -(@doc capture - (@desc "Wraps an atom and capture the current space") - (@params ( - (@param "Function name which space need to be captured"))) - (@return "Function")) - -(@doc case - (@desc "Subsequently tests multiple pattern-matching conditions (second argument) for the given value (first argument)") - (@params ( - (@param "Atom (it will be evaluated)") - (@param "Tuple of pairs mapping condition patterns to results"))) - (@return "Result of evaluating of Atom bound to met condition")) - - -(@doc superpose - (@desc "Turns a tuple (first argument) into a nondeterministic result") - (@params ( - (@param "Tuple to be converted"))) - (@return "Argument converted to nondeterministic result")) - - -(@doc pragma! - (@desc "Changes global key's (first argument) value to a new one (second argument)") - (@params ( - (@param "Key's name") - (@param "New value"))) - (@return "Unit atom")) - -(@doc import! - (@desc "Imports module using its relative path (second argument) and binds it to the token (first argument) which will represent imported atomspace. If first argument is &self then everything will be imported to current atomspace") - (@params ( - (@param "Symbol, which is turned into the token for accessing the imported module") - (@param "Module name"))) - (@return "Unit atom")) - -(@doc include - (@desc "Works just like import! but with &self as a first argument. So everything from input file will be included in the current atomspace and evaluated") - (@params ( - (@param "Name of metta script to import"))) - (@return "Unit atom")) - -(@doc bind! - (@desc "Registers a new token which is replaced with an atom during the parsing of the rest of the program") - (@params ( - (@param "Token name") - (@param "Atom, which is associated with the token after reduction"))) - (@return "Unit atom")) - -(@doc trace! - (@desc "Prints its first argument and returns second. Both arguments will be evaluated before processing") - (@params ( - (@param "Atom to print") - (@param "Atom to return"))) - (@return "Evaluated second input")) - -(@doc println! - (@desc "Prints a line of text to the console") - (@params ( - (@param "Expression/atom to be printed out"))) - (@return "Unit atom")) - -(@doc format-args - (@desc "Fills {} symbols in the input expression with atoms from the second expression. E.g. (format-args (Probability of {} is {}%) (head 50)) gives [(Probability of head is 50%)]. Atoms in the second input value could be variables") - (@params ( - (@param "Expression with {} symbols to be replaced") - (@param "Atoms to be placed inside expression instead of {}"))) - (@return "Expression with replaced {} with atoms")) - -(@doc sealed - (@desc "Replaces all occurrences of any var from var list (first argument) inside atom (second argument) by unique variable. Can be used to create a locally scoped variables") - (@params ( - (@param "Variable list e.g. ($x $y)") - (@param "Atom which uses those variables"))) - (@return "Second argument but with variables being replaced with unique variables")) - -; TODO: help! not working for &self (segmentation fault) -;(@doc &self -; (@desc "Returns reference to the current atomspace") -; (@params ()) -; (@return "Reference to the current atomspace")) - -; TODO: help! not working for operations which are defined in both Python and -; Rust standard library: +, -, *, /, %, <, >, <=, >=, == -(@doc + - (@desc "Sums two numbers") - (@params ( - (@param "Addend") - (@param "Augend"))) - (@return "Sum")) - -(@doc - - (@desc "Subtracts second argument from first one") - (@params ( - (@param "Minuend") - (@param "Deductible"))) - (@return "Difference")) - -(@doc * - (@desc "Multiplies two numbers") - (@params ( - (@param "Multiplier") - (@param "Multiplicand"))) - (@return "Product")) - -(@doc / - (@desc "Divides first argument by second one") - (@params ( - (@param "Dividend") - (@param "Divisor"))) - (@return "Fraction")) - -(@doc % - (@desc "Modulo operator. It returns remainder of dividing first argument by second argument") - (@params ( - (@param "Dividend") - (@param "Divisor"))) - (@return "Remainder")) - -(@doc < - (@desc "Less than. Checks if first argument is less than second one") - (@params ( - (@param "First number") - (@param "Second number"))) - (@return "True if first argument is less than second, False - otherwise")) - -(@doc > - (@desc "Greater than. Checks if first argument is greater than second one") - (@params ( - (@param "First number") - (@param "Second number"))) - (@return "True if first argument is greater than second, False - otherwise")) - -(@doc <= - (@desc "Less than or equal. Checks if first argument is less than or equal to second one") - (@params ( - (@param "First number") - (@param "Second number"))) - (@return "True if first argument is less than or equal to second, False - otherwise")) - -(@doc >= - (@desc "Greater than or equal. Checks if first argument is greater than or equal to second one") - (@params ( - (@param "First number") - (@param "Second number"))) - (@return "True if first argument is greater than or equal to second, False - otherwise")) - -(@doc == - (@desc "Checks equality for two arguments of the same type") - (@params ( - (@param "First argument") - (@param "Second argument"))) - (@return "Returns True if two arguments are equal, False - otherwise. If arguments are of different type function returns Error currently")) - -(@doc unique - (@desc "Function takes non-deterministic input (first argument) and returns only unique entities. E.g. (unique (superpose (a b c d d))) -> [a, b, c, d]") - (@params ( - (@param "Non-deterministic set of values"))) - (@return "Unique values from input set")) - -(@doc union - (@desc "Function takes two non-deterministic inputs (first and second argument) and returns their union. E.g. (union (superpose (a b b c)) (superpose (b c c d))) -> [a, b, b, c, b, c, c, d]") - (@params ( - (@param "Non-deterministic set of values") - (@param "Another non-deterministic set of values"))) - (@return "Union of sets")) - -(@doc intersection - (@desc "Function takes two non-deterministic inputs (first and second argument) and returns their intersection. E.g. (intersection (superpose (a b c c)) (superpose (b c c c d))) -> [b, c, c]") - (@params ( - (@param "Non-deterministic set of values") - (@param "Another non-deterministic set of values"))) - (@return "Intersection of sets")) - -(@doc subtraction - (@desc "Function takes two non-deterministic inputs (first and second argument) and returns their subtraction. E.g. !(subtraction (superpose (a b b c)) (superpose (b c c d))) -> [a, b]") - (@params ( - (@param "Non-deterministic set of values") - (@param "Another non-deterministic set of values"))) - (@return "Subtraction of sets")) - -(@doc git-module! - (@desc "Provides access to module in a remote git repo, from within MeTTa code. Similar to `register-module!`, this op will bypass the catalog search") - (@params ( - (@param "URL to github repo"))) - (@return "Unit atom")) diff --git a/.Attic/metta_lang/swi_flybase.pl b/.Attic/metta_lang/swi_flybase.pl deleted file mode 100755 index 12a4e619ce4..00000000000 --- a/.Attic/metta_lang/swi_flybase.pl +++ /dev/null @@ -1,2 +0,0 @@ - -:- ensure_loaded(flybase_main). \ No newline at end of file diff --git a/.Attic/rust-wam/metta_prelude.pl b/.Attic/rust-wam/metta_prelude.pl deleted file mode 100755 index f78038781bf..00000000000 --- a/.Attic/rust-wam/metta_prelude.pl +++ /dev/null @@ -1,242 +0,0 @@ -%;`$then`, `$else` should be of `Atom` type to avoid evaluation -%; and infinite cycle in inference -metta_type('&self',if,[ ->, 'Bool','Atom','Atom',_]). -metta_defn('&self',[if,'True',A,_],A). -metta_defn('&self',[if,'False',_,A],A). -metta_type('&self','Error',[->,'Atom','Atom','ErrorType']). -metta_defn('&self',['if-non-empty-expression',A,B,C],[ chain, - [ eval, - ['get-metatype',A]], - D, - [ eval, - [ 'if-equal', D,'Expression', - [ eval, - [ 'if-equal', A, [], C, B]], - C]]]). -metta_defn('&self',[ 'if-decons', A,B,C,D, - E],[ eval, - [ 'if-non-empty-expression', - A, - [ chain, - [decons,A], - F, - [ match, - F, - [B,C], D,E]], - E]]). -metta_defn('&self',['if-empty',A,B,C],[ eval, - [ 'if-equal', A,'Empty',B,C]]). -metta_defn('&self',['if-error',A,B,C],[ eval, - [ 'if-decons', A,D,_, - [ eval, - [ 'if-equal', D,'Error',B,C]], - C]]). -metta_defn('&self',['return-on-error',A,B],[ eval, - [ 'if-empty', A,'Empty', - [ eval, - ['if-error',A,A,B]]]]). -metta_defn('&self',[car,A],[ eval, - [ 'if-decons', A,B,_,B, - [ 'Error', - [car,A], - '$STRING'("car expects a non-empty expression as an argument")]]]). -metta_defn('&self',[switch,A,B],[ chain, - [decons,B], - C, - [ eval, - ['switch-internal',A,C]]]). -metta_defn('&self',[ 'switch-internal', - A, - [ [B,C], - D]],[ match, A,B,C, - [ eval, - [switch,A,D]]]). -metta_defn('&self',[subst,A,B,C],[ match, A,B,C, - [ 'Error', - [subst,A,B,C], - '$STRING'("subst expects a variable as a second argument")]]). -metta_defn('&self',[reduce,A,B,C],[ chain, - [eval,A], - D, - [ eval, - [ 'if-error', D,D, - [ eval, - [ 'if-empty', - D, - [ eval, - [subst,A,B,C]], - [ eval, - [reduce,D,B,C]]]]]]]). -metta_defn('&self',['type-cast',A,B,C],[ chain, - [ eval, - ['get-type',A,C]], - D, - [ eval, - [ switch, - [D,B], - [ [ ['%Undefined%',E], - A], - [ [E,'%Undefined%'], - A], - [ [B,E], - A], - [ E, - ['Error',A,'BadType']]]]]]). -metta_defn('&self',['is-function',A],[ chain, - [ eval, - ['get-metatype',A]], - B, - [ eval, - [ switch, - [A,B], - [ [ [C,'Expression'], - [ chain, - [ eval, - [car,A]], - D, - [ match, D,->,'True','False']]], - [C,'False']]]]]). -metta_defn('&self',[interpret,A,B,C],[ chain, - [ eval, - ['get-metatype',A]], - D, - [ eval, - [ switch, - [B,D], - [ [ ['Atom',_], - A], - [ [D,D], - A], - [ [E,'Variable'], - A], - [ [E,'Symbol'], - [ eval, - ['type-cast',A,B,C]]], - [ [E,'Grounded'], - [ eval, - ['type-cast',A,B,C]]], - [ [E,'Expression'], - [ eval, - ['interpret-expression',A,B,C]]]]]]]). -metta_defn('&self',['interpret-expression',A,B,C],[ eval, - [ 'if-decons', A,D,_, - [ chain, - [ eval, - ['get-type',D,C]], - E, - [ chain, - [ eval, - ['is-function',E]], - F, - [ match, F,'True', - [ chain, - [ eval, - ['interpret-func',A,E,C]], - G, - [ eval, - [call,G,B,C]]], - [ chain, - [ eval, - ['interpret-tuple',A,C]], - G, - [ eval, - [call,G,B,C]]]]]], - [ eval, - ['type-cast',A,B,C]]]]). -metta_defn('&self',['interpret-func',A,B,C],[ eval, - [ 'if-decons', A,D,E, - [ chain, - [ eval, - [interpret,D,B,C]], - F, - [ eval, - [ 'return-on-error', - F, - [ eval, - [ 'if-decons', B,_,G, - [ chain, - [ eval, - [ 'interpret-args', A,E,G, - C]], - H, - [ eval, - [ 'return-on-error', - H, - [cons,F,H]]]], - [ 'Error', B,'$STRING'("Function type expected")]]]]]], - [ 'Error', - A, - '$STRING'("Non-empty expression atom is expected")]]]). -metta_defn('&self',[ 'interpret-args', A,B,C,D],[ match, - B, - [], - [ match, - C, - [_], - [], - ['Error',A,'BadType']], - [ eval, - [ 'if-decons', B,E,F, - [ eval, - [ 'if-decons', C,G,H, - [ chain, - [ eval, - [interpret,E,G,D]], - I, - [ eval, - [ 'if-equal', I,E, - [ eval, - [ 'interpret-args-tail', A,I,F, - H,D]], - [ eval, - [ 'return-on-error', - I, - [ eval, - [ 'interpret-args-tail', A,I,F, - H,D]]]]]]], - ['Error',A,'BadType']]], - [ 'Error', - [ 'interpret-atom', A,B,C, - D], - '$STRING'("Non-empty expression atom is expected")]]]]). -%; check that head was changed otherwise Error or Empty in the head -%; can be just an argument which is passed by intention -metta_defn('&self',[ 'interpret-args-tail', A,B,C,D, - E],[ chain, - [ eval, - [ 'interpret-args', A,C,D,E]], - F, - [ eval, - [ 'return-on-error', - F, - [cons,B,F]]]]). -metta_defn('&self',['interpret-tuple',A,B],[ match, - A, - [], - A, - [ eval, - [ 'if-decons', A,C,D, - [ chain, - [ eval, - [interpret,C,'%Undefined%',B]], - E, - [ chain, - [ eval, - ['interpret-tuple',D,B]], - F, - [cons,E,F]]], - [ 'Error', - ['interpret-tuple',A,B], - '$STRING'("Non-empty expression atom is expected as an argument")]]]]). -metta_defn('&self',[call,A,B,C],[ chain, - [eval,A], - D, - [ eval, - [ 'if-empty', D,A, - [ eval, - [ 'if-error', D,D, - [ eval, - [interpret,D,B,C]]]]]]]). -% 1,264,919 inferences, 0.139 CPU in 0.140 seconds (99% CPU, 9074539 Lips) -% (= metta_prelude.metta 0) - From d99ee14ce9605397e280bb8d1973021a82bd18be Mon Sep 17 00:00:00 2001 From: logicmoo Date: Fri, 30 Aug 2024 00:20:07 -0700 Subject: [PATCH 67/77] removed more unused files --- .Attic/metta_lang/metta_corelib.pl | 304 ------------------------ .Attic/metta_lang/metta_data.pl | 55 ----- .Attic/metta_lang/metta_interp.pl | 5 +- .Attic/metta_lang/metta_loader.pl | 19 ++ .Attic/metta_lang/metta_printer.pl | 3 + .Attic/metta_lang/metta_server.pl | 5 +- .Attic/metta_lang/metta_types.pl | 13 + .Attic/metta_lang/stdlib_mettalog.metta | 53 ++++- 8 files changed, 92 insertions(+), 365 deletions(-) delete mode 100755 .Attic/metta_lang/metta_corelib.pl delete mode 100755 .Attic/metta_lang/metta_data.pl diff --git a/.Attic/metta_lang/metta_corelib.pl b/.Attic/metta_lang/metta_corelib.pl deleted file mode 100755 index 4c98d63977b..00000000000 --- a/.Attic/metta_lang/metta_corelib.pl +++ /dev/null @@ -1,304 +0,0 @@ -/* - * 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. - */ - -:- discontiguous metta_atom_corelib_types/1. - -:- dynamic(using_corelib_file/0). - - -metta_atom_corelib_defn( [=, ['car-atom', A], [eval, ['if-decons', A, B, _, B, ['Error', ['car-atom', A], "car-atom expects a non-empty expression as an argument"]]]]). -metta_atom_corelib_defn( [=, ['cdr-atom', A], [eval, ['if-decons', A, _, B, B, ['Error', ['cdr-atom', A], "cdr-atom expects a non-empty expression as an argument"]]]]). -metta_atom_corelib_defn( [=, ['filter-atom', A, B, C], [function, [eval, ['if-decons', A, D, E, [chain, [eval, ['filter-atom', E, B, C]], F, [chain, [eval, [apply, D, B, C]], G, [chain, G, H, [eval, [if, H, [chain, [cons, D, F], I, [return, I]], [return, F]]]]]], [return, []]]]]]). -metta_atom_corelib_defn( [=, ['foldl-atom', A, B, C, D, E], [function, [eval, ['if-decons', A, F, G, [chain, [eval, [apply, B, C, E]], H, [chain, [eval, [apply, F, D, H]], I, [chain, I, J, [chain, [eval, ['foldl-atom', G, J, C, D, E]], K, [return, K]]]]], [return, B]]]]]). -metta_atom_corelib_defn( [=, ['if-decons', A, B, C, D, E], [eval, ['if-non-empty-expression', A, [chain, [decons, A], F, [match, F, [B, C], D, E]], E]]]). -metta_atom_corelib_defn( [=, ['if-decons', A, B, C, D, E], [function, [eval, ['if-non-empty-expression', A, [chain, [decons, A], F, [unify, F, [B, C], [return, D], [return, E]]], [return, E]]]]]). -metta_atom_corelib_defn( [=, ['if-empty', A, B, C], [eval, ['if-equal', A, 'Empty', B, C]]]). -metta_atom_corelib_defn( [=, ['if-empty', A, B, C], [function, [eval, ['if-equal', A, 'Empty', [return, B], [return, C]]]]]). -metta_atom_corelib_defn( [=, ['if-error', A, B, C], [eval, ['if-decons', A, D, _, [eval, ['if-equal', D, 'Error', B, C]], C]]]). -metta_atom_corelib_defn( [=, ['if-error', A, B, C], [function, [eval, ['if-decons', A, D, _, [eval, ['if-equal', D, 'Error', [return, B], [return, C]]], [return, C]]]]]). -metta_atom_corelib_defn( [=, ['if-non-empty-expression', A, B, C], [chain, [eval, ['get-metatype', A]], D, [eval, ['if-equal', D, 'Expression', [eval, ['if-equal', A, [], C, B]], C]]]]). -metta_atom_corelib_defn( [=, ['if-non-empty-expression', A, B, C], [function, [chain, [eval, ['get-metatype', A]], D, [eval, ['if-equal', D, 'Expression', [eval, ['if-equal', A, [], [return, C], [return, B]]], [return, C]]]]]]). -metta_atom_corelib_defn( [=, ['if-not-reducible', A, B, C], [function, [eval, ['if-equal', A, 'NotReducible', [return, B], [return, C]]]]]). -metta_atom_corelib_defn( [=, ['interpret-args', A, B, C, D, E], [function, [unify, B, [], [eval, ['if-decons', C, F, _, [eval, ['match-types', F, D, [return, []], [return, ['Error', A, 'BadType']]]], [return, ['Error', ['interpret-args', A, B, C, D, E], "interpret-args expects a non-empty value for $arg-types argument"]]]], [eval, ['if-decons', B, G, H, [eval, ['if-decons', C, I, J, [chain, [eval, [interpret, G, I, E]], K, [eval, ['if-equal', K, G, [chain, [eval, ['interpret-args-tail', A, K, H, J, D, E]], L, [return, L]], [eval, ['return-on-error', K, [chain, [eval, ['interpret-args-tail', A, K, H, J, D, E]], L, [return, L]]]]]]], [return, ['Error', A, 'BadType']]]], [return, ['Error', ['interpret-atom', A, B, C, E], "Non-empty expression atom is expected"]]]]]]]). -metta_atom_corelib_defn( [=, ['interpret-args', A, B, C, D], [match, B, [], [match, C, [_], [], ['Error', A, 'BadType']], [eval, ['if-decons', B, E, F, [eval, ['if-decons', C, G, H, [chain, [eval, [interpret, E, G, D]], I, [eval, ['if-equal', I, E, [eval, ['interpret-args-tail', A, I, F, H, D]], [eval, ['return-on-error', I, [eval, ['interpret-args-tail', A, I, F, H, D]]]]]]], ['Error', A, 'BadType']]], ['Error', ['interpret-atom', A, B, C, D], "Non-empty expression atom is expected"]]]]]). -metta_atom_corelib_defn( [=, ['interpret-args-tail', A, B, C, D, E, F], [function, [chain, [eval, ['interpret-args', A, C, D, E, F]], G, [eval, ['return-on-error', G, [chain, [cons, B, G], H, [return, H]]]]]]]). -metta_atom_corelib_defn( [=, ['interpret-args-tail', A, B, C, D, E], [chain, [eval, ['interpret-args', A, C, D, E]], F, [eval, ['return-on-error', F, [cons, B, F]]]]]). -metta_atom_corelib_defn( [=, ['interpret-expression', A, B, C], [eval, ['if-decons', A, D, _, [chain, [eval, ['get-type', D, C]], E, [chain, [eval, ['is-function', E]], F, [match, F, 'True', [chain, [eval, ['interpret-func', A, E, C]], G, [eval, [call, G, B, C]]], [chain, [eval, ['interpret-tuple', A, C]], G, [eval, [call, G, B, C]]]]]], [eval, ['type-cast', A, B, C]]]]]). -metta_atom_corelib_defn( [=, ['interpret-expression', A, B, C], [function, [eval, ['if-decons', A, D, _, [chain, [eval, ['get-type', D, C]], E, [chain, [eval, ['is-function', E]], F, [unify, F, 'True', [chain, [eval, ['interpret-func', A, E, B, C]], G, [chain, [eval, ['metta-call', G, B, C]], H, [return, H]]], [chain, [eval, ['interpret-tuple', A, C]], G, [chain, [eval, ['metta-call', G, B, C]], H, [return, H]]]]]], [chain, [eval, ['type-cast', A, B, C]], H, [return, H]]]]]]). -metta_atom_corelib_defn( [=, ['interpret-func', A, B, C, D], [function, [eval, ['if-decons', A, E, F, [chain, [eval, [interpret, E, B, D]], G, [eval, ['return-on-error', G, [eval, ['if-decons', B, _, H, [chain, [eval, ['interpret-args', A, F, H, C, D]], I, [eval, ['return-on-error', I, [chain, [cons, G, I], J, [return, J]]]]], [return, ['Error', B, "Function type expected"]]]]]]], [return, ['Error', A, "Non-empty expression atom is expected"]]]]]]). -metta_atom_corelib_defn( [=, ['interpret-func', A, B, C], [eval, ['if-decons', A, D, E, [chain, [eval, [interpret, D, B, C]], F, [eval, ['return-on-error', F, [eval, ['if-decons', B, _, G, [chain, [eval, ['interpret-args', A, E, G, C]], H, [eval, ['return-on-error', H, [cons, F, H]]]], ['Error', B, "Function type expected"]]]]]], ['Error', A, "Non-empty expression atom is expected"]]]]). -metta_atom_corelib_defn( [=, ['interpret-tuple', A, B], [function, [unify, A, [], [return, A], [eval, ['if-decons', A, C, D, [chain, [eval, [interpret, C, '%Undefined%', B]], E, [eval, ['if-empty', E, [return, 'Empty'], [chain, [eval, ['interpret-tuple', D, B]], F, [eval, ['if-empty', F, [return, 'Empty'], [chain, [cons, E, F], G, [return, G]]]]]]]], [return, ['Error', ['interpret-tuple', A, B], "Non-empty expression atom is expected as an argument"]]]]]]]). -metta_atom_corelib_defn( [=, ['interpret-tuple', A, B], [match, A, [], A, [eval, ['if-decons', A, C, D, [chain, [eval, [interpret, C, '%Undefined%', B]], E, [chain, [eval, ['interpret-tuple', D, B]], F, [cons, E, F]]], ['Error', ['interpret-tuple', A, B], "Non-empty expression atom is expected as an argument"]]]]]). -metta_atom_corelib_defn( [=, ['is-function', A], [chain, [eval, ['get-metatype', A]], B, [eval, [switch, [A, B], [[[_, 'Expression'], [chain, [eval, [car, A]], C, [match, C, ->, 'True', 'False']]], [_, 'False']]]]]]). -metta_atom_corelib_defn( [=, ['is-function', A], [function, [chain, [eval, ['get-metatype', A]], B, [eval, [switch, [A, B], [[[_, 'Expression'], [eval, ['if-decons', A, C, _, [unify, C, ->, [return, 'True'], [return, 'False']], [return, ['Error', ['is-function', A], "is-function non-empty expression as an argument"]]]]], [_, [return, 'False']]]]]]]]). -metta_atom_corelib_defn( [=, ['let*', A, B], [eval, ['if-decons', A, [C, D], E, [let, C, D, ['let*', E, B]], B]]]). -metta_atom_corelib_defn( [=, ['map-atom', A, B, C], [function, [eval, ['if-decons', A, D, E, [chain, [eval, ['map-atom', E, B, C]], F, [chain, [eval, [apply, D, B, C]], G, [chain, G, H, [chain, [cons, H, F], I, [return, I]]]]], [return, []]]]]]). -metta_atom_corelib_defn( [=, ['match-types', A, B, C, D], [function, [eval, ['if-equal', A, '%Undefined%', [return, C], [eval, ['if-equal', B, '%Undefined%', [return, C], [eval, ['if-equal', A, 'Atom', [return, C], [eval, ['if-equal', B, 'Atom', [return, C], [unify, A, B, [return, C], [return, D]]]]]]]]]]]]). -metta_atom_corelib_defn( [=, ['metta-call', A, B, C], [function, [eval, ['if-error', A, [return, A], [chain, [eval, A], D, [eval, ['if-not-reducible', D, [return, A], [eval, ['if-empty', D, [return, 'Empty'], [eval, ['if-error', D, [return, D], [chain, [eval, [interpret, D, B, C]], E, [return, E]]]]]]]]]]]]]). -metta_atom_corelib_defn( [=, ['return-on-error', A, B], [eval, ['if-empty', A, 'Empty', [eval, ['if-error', A, A, B]]]]]). -metta_atom_corelib_defn( [=, ['return-on-error', A, B], [function, [eval, ['if-empty', A, [return, [return, 'Empty']], [eval, ['if-error', A, [return, [return, A]], [return, B]]]]]]]). -metta_atom_corelib_defn( [=, ['switch-internal', A, [[B, C], D]], [function, [unify, A, B, [return, C], [chain, [eval, [switch, A, D]], E, [return, E]]]]]). -metta_atom_corelib_defn( [=, ['switch-internal', A, [[B, C], D]], [match, A, B, C, [eval, [switch, A, D]]]]). -metta_atom_corelib_defn( [=, ['type-cast', A, B, C], [chain, [eval, ['get-type', A, C]], D, [eval, [switch, [D, B], [[['%Undefined%', _], A], [[_, '%Undefined%'], A], [[B, _], A], [_, ['Error', A, 'BadType']]]]]]]). -metta_atom_corelib_defn( [=, ['type-cast', A, B, C], [function, [chain, [eval, ['get-metatype', A]], D, [eval, ['if-equal', B, D, [return, A], [chain, [eval, ['collapse-get-type', A, C]], E, [chain, [eval, ['foldl-atom', E, 'False', F, G, [chain, [eval, ['match-types', G, B, 'True', 'False']], H, [chain, [eval, [or, F, H]], I, I]]]], J, [eval, [if, J, [return, A], [return, ['Error', A, 'BadType']]]]]]]]]]]). -metta_atom_corelib_defn( [=, [and, 'False', 'False'], 'False']). -metta_atom_corelib_defn( [=, [and, 'False', 'True'], 'False']). -metta_atom_corelib_defn( [=, [and, 'True', 'False'], 'False']). -metta_atom_corelib_defn( [=, [and, 'True', 'True'], 'True']). -metta_atom_corelib_defn( [=, [apply, A, B, C], [function, [chain, [eval, [id, A]], B, [return, C]]]]). -metta_atom_corelib_defn( [=, [call, A, B, C], [chain, [eval, A], D, [eval, ['if-empty', D, A, [eval, ['if-error', D, D, [eval, [interpret, D, B, C]]]]]]]]). -metta_atom_corelib_defn( [=, [car, A], [eval, ['if-decons', A, B, _, B, ['Error', [car, A], "car expects a non-empty expression as an argument"]]]]). -metta_atom_corelib_defn( [=, [id, A], A]). -metta_atom_corelib_defn( [=, [if, 'False', _, A], A]). -metta_atom_corelib_defn( [=, [if, 'True', A, _], A]). -metta_atom_corelib_defn( [=, [interpret, A, B, C], [chain, [eval, ['get-metatype', A]], D, [eval, [switch, [B, D], [[['Atom', _], A], [[D, D], A], [[E, 'Variable'], A], [[E, 'Symbol'], [eval, ['type-cast', A, B, C]]], [[E, 'Grounded'], [eval, ['type-cast', A, B, C]]], [[E, 'Expression'], [eval, ['interpret-expression', A, B, C]]]]]]]]). -metta_atom_corelib_defn( [=, [interpret, A, B, C], [function, [chain, [eval, ['get-metatype', A]], D, [eval, ['if-equal', B, 'Atom', [return, A], [eval, ['if-equal', B, D, [return, A], [eval, [switch, [B, D], [[[E, 'Variable'], [return, A]], [[E, 'Symbol'], [chain, [eval, ['type-cast', A, B, C]], F, [return, F]]], [[E, 'Grounded'], [chain, [eval, ['type-cast', A, B, C]], F, [return, F]]], [[E, 'Expression'], [chain, [eval, ['interpret-expression', A, B, C]], F, [return, F]]]]]]]]]]]]]). -metta_atom_corelib_defn( [=, [let, A, B, C], [unify, B, A, C, 'Empty']]). -metta_atom_corelib_defn( [=, [match, A, B, C], [unify, B, A, C, 'Empty']]). -metta_atom_corelib_defn( [=, [nop, _], []]). -metta_atom_corelib_defn( [=, [nop], []]). -metta_atom_corelib_defn( [=, [or, 'False', 'False'], 'False']). -metta_atom_corelib_defn( [=, [or, 'False', 'True'], 'True']). -metta_atom_corelib_defn( [=, [or, 'True', 'False'], 'True']). -metta_atom_corelib_defn( [=, [or, 'True', 'True'], 'True']). -metta_atom_corelib_defn( [=, [xor, 'False', 'False'], 'False']). -metta_atom_corelib_defn( [=, [xor, 'False', 'True'], 'True']). -metta_atom_corelib_defn( [=, [xor, 'True', 'False'], 'True']). -metta_atom_corelib_defn( [=, [xor, 'True', 'True'], 'False']). -metta_atom_corelib_defn( [=, [quote, _], 'NotReducible']). -metta_atom_corelib_defn( [=, [reduce, A, B, C], [chain, [eval, A], D, [eval, ['if-error', D, D, [eval, ['if-empty', D, [eval, [subst, A, B, C]], [eval, [reduce, D, B, C]]]]]]]]). -metta_atom_corelib_defn( [=, [subst, A, B, C], [match, A, B, C, ['Error', [subst, A, B, C], "subst expects a variable as a second argument"]]]). -metta_atom_corelib_defn( [=, [switch, A, B], [chain, [decons, B], C, [eval, ['switch-internal', A, C]]]]). -metta_atom_corelib_defn( [=, [switch, A, B], [function, [chain, [decons, B], C, [chain, [eval, ['switch-internal', A, C]], D, [chain, [eval, ['if-not-reducible', D, 'Empty', D]], E, [return, E]]]]]]). -metta_atom_corelib_defn( [=, [unquote, [quote, A]], A]). - -is_absorbed_return_type(Params,Var):- var(Var),!, \+ sub_var(Var,Params). -is_absorbed_return_type(_,'Bool'). -is_absorbed_return_type(_,[Ar]):- !, Ar == (->). -is_absorbed_return_type(_,'EmptyType'). -is_absorbed_return_type(_,'ReturnType'). -is_absorbed_return_type(_,X):- is_self_return(X). - -is_self_return('ErrorType'). - -is_non_absorbed_return_type(Params,Var):- - \+ is_absorbed_return_type(Params,Var). - -metta_atom_corelib_types( [:, 'ErrorType', 'Type']). -metta_atom_corelib_types( [:, 'ReturnType', 'Type']). - -metta_atom_corelib_types( [:, 'Error', [->, 'Atom', 'Atom', 'ErrorType']]). - -metta_atom_corelib_types( [:, 'add-atom', [->, 'hyperon::space::DynSpace', 'Atom', [->]]]). -metta_atom_corelib_types( [:, 'car-atom', [->, 'Expression', 'Atom']]). -metta_atom_corelib_types( [:, 'cdr-atom', [->, 'Expression', 'Expression']]). -metta_atom_corelib_types( [:, 'filter-atom', [->, 'Expression', 'Variable', 'Atom', 'Expression']]). -metta_atom_corelib_types( [:, 'foldl-atom', [->, 'Expression', 'Atom', 'Variable', 'Variable', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'get-atoms', [->, 'hyperon::space::DynSpace', 'Atom']]). -metta_atom_corelib_types( [:, 'if-decons', [->, 'Atom', 'Variable', 'Variable', 'Atom', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'if-empty', [->, 'Atom', 'Atom', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'if-error', [->, 'Atom', 'Atom', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'if-non-empty-expression', [->, 'Atom', 'Atom', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'if-not-reducible', [->, 'Atom', 'Atom', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'let*', [->, 'Expression', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'map-atom', [->, 'Expression', 'Variable', 'Atom', 'Expression']]). -metta_atom_corelib_types( [:, 'remove-atom', [->, 'hyperon::space::DynSpace', 'Atom', [->]]]). -metta_atom_corelib_types( [:, 'return-on-error', [->, 'Atom', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, and, [->, 'Bool', 'Bool', 'Bool']]). -metta_atom_corelib_types( [:, apply, [->, 'Atom', 'Variable', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, chain, [->, 'Atom', 'Variable', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, cons, [->, 'Atom', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, decons, [->, 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, empty, [->, '%Undefined%']]). -metta_atom_corelib_types( [:, eval, [->, 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, function, [->, 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, id, [->, 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, if, [->, 'Bool', 'Atom', 'Atom', _]]). -metta_atom_corelib_types( [:, let, [->, 'Atom', '%Undefined%', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, match, [->, 'Atom', 'Atom', 'Atom', '%Undefined%']]). -metta_atom_corelib_types( [:, or, [->, 'Bool', 'Bool', 'Bool']]). -metta_atom_corelib_types( [:, xor, [->, 'Bool', 'Bool', 'Bool']]). -metta_atom_corelib_types( [:, quote, [->, 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, return, [->, 'Atom', 'ReturnType']]). -metta_atom_corelib_types( [:, switch, [->, '%Undefined%', 'Expression', 'Atom']]). -metta_atom_corelib_types( [:, unify, [->, 'Atom', 'Atom', 'Atom', 'Atom', '%Undefined%']]). -metta_atom_corelib_types( [:, unify, [->, 'Atom', 'Atom', 'Atom', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, unquote, [->, '%Undefined%', '%Undefined%']]). -% metta_atom_corelib_types( [:, stringToChars [-> 'Atom' 'Expression']]). -% metta_atom_corelib_types( [:, charsToString [-> 'Expression' 'Atom']]). -% metta_atom_corelib_types( [:, format-args [-> 'Atom' 'Expression' 'Atom']]). - -metta_atom_corelib_types( [:, 'unique', [->, 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'subtraction', [->, 'Atom', 'Atom', 'Atom']]). - -metta_atom_corelib_types( [:, 'get-metatype', [->, 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'get-type0', [->, 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'get-ftype', [->, 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'get-type', [->, 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'get-type', [->, 'Atom', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, '==', [->, T, T, 'Bool']]). -metta_atom_corelib_types( [:, ':', '%Undefined%']). - -metta_atom_corelib_types( [:, 'function-arity', [->, 'Symbol', 'Number']]). -metta_atom_corelib_types( [:, 'predicate-arity', [->, 'Symbol', 'Number']]). - - -metta_atom_corelib(X):- metta_atom_corelib_types(X). -metta_atom_corelib(X):- metta_atom_corelib1(X), \+ clause_asserted(metta_atom_corelib_types(X)). -metta_atom_corelib(X):- - metta_atom_corelib2(X), \+ clause_asserted(metta_atom_corelib_types(X)), - \+ clause_asserted(metta_atom_corelib1(X)). - - -op_decl('pragma!', [ 'Atom', 'Atom'], [->]). -op_decl('=', [ 'Atom', 'Atom'], '%Undefined%'). - -op_decl('match', [ 'hyperon::space::DynSpace', 'Atom', 'Atom'], '%Undefined%'). -op_decl('remove-atom', [ 'hyperon::space::DynSpace', 'Atom'], [->]). -op_decl('add-atom', [ 'hyperon::space::DynSpace', 'Atom'], [->]). -op_decl('get-atoms', [ 'hyperon::space::DynSpace' ], 'Atom'). - -op_decl('get-state', [[ 'StateMonad', Type]],Type). -op_decl('change-state!', [[ 'StateMonad',Type],Type],[ 'StateMonad',Type]). -op_decl('new-state', [Type], ['StateMonad',Type ]). - -op_decl('car-atom', [ 'Expression' ], 'Atom'). -op_decl('cdr-atom', [ 'Expression' ], 'Expression'). - -op_decl(let, [ 'Atom', '%Undefined%', 'Atom' ], 'Atom'). -op_decl('let*', [ 'Expression', 'Atom' ], 'Atom'). - -op_decl(and, [ 'Bool', 'Bool' ], 'Bool'). -op_decl(or, [ 'Bool', 'Bool' ], 'Bool'). -op_decl(xor, [ 'Bool', 'Bool' ], 'Bool'). -op_decl(case, [ 'Expression', 'Atom' ], 'Atom'). - -op_decl(apply, [ 'Atom', 'Variable', 'Atom' ], 'Atom'). -op_decl(chain, [ 'Atom', 'Variable', 'Atom' ], 'Atom'). -op_decl('filter-atom', [ 'Expression', 'Variable', 'Atom' ], 'Expression'). -op_decl('foldl-atom', [ 'Expression', 'Atom', 'Variable', 'Variable', 'Atom' ], 'Atom'). -op_decl('map-atom', [ 'Expression', 'Variable', 'Atom' ], 'Expression'). -op_decl(quote, [ 'Atom' ], 'Atom'). -op_decl('if-decons', [ 'Atom', 'Variable', 'Variable', 'Atom', 'Atom' ], 'Atom'). -op_decl('if-empty', [ 'Atom', 'Atom', 'Atom' ], 'Atom'). -op_decl('if-error', [ 'Atom', 'Atom', 'Atom' ], 'Atom'). -op_decl('if-non-empty-expression', [ 'Atom', 'Atom', 'Atom' ], 'Atom'). -op_decl('if-not-reducible', [ 'Atom', 'Atom', 'Atom' ], 'Atom'). -op_decl(return, [ 'Atom' ], 'ReturnType'). -op_decl('return-on-error', [ 'Atom', 'Atom'], 'Atom'). -op_decl(unquote, [ '%Undefined%'], '%Undefined%'). -op_decl(cons, [ 'Atom', 'Atom' ], 'Atom'). -op_decl(decons, [ 'Atom' ], 'Atom'). -op_decl(empty, [], '%Undefined%'). -op_decl('Error', [ 'Atom', 'Atom' ], 'ErrorType'). -op_decl(function, [ 'Atom' ], 'Atom'). -op_decl(id, [ 'Atom' ], 'Atom'). -op_decl(unify, [ 'Atom', 'Atom', 'Atom', 'Atom' ], 'Atom'). - -op_decl(eval, [ 'Atom' ], 'Atom'). -op_decl(unify, [ 'Atom', 'Atom', 'Atom', 'Atom'], '%Undefined%'). -op_decl(if, [ 'Bool', 'Atom', 'Atom'], _T). -op_decl('%', [ 'Number', 'Number' ], 'Number'). -op_decl('*', [ 'Number', 'Number' ], 'Number'). -op_decl('-', [ 'Number', 'Number' ], 'Number'). -op_decl('+', [ 'Number', 'Number' ], 'Number'). -op_decl('<', [ 'Number', 'Number' ], 'Bool'). -op_decl('>', [ 'Number', 'Number' ], 'Bool'). -op_decl('<=', [ 'Number', 'Number' ], 'Bool'). -op_decl('>=', [ 'Number', 'Number' ], 'Bool'). - -op_decl(combine, [ X, X], X). - -op_decl('bind!', ['Symbol','%Undefined%'], [->]). -op_decl('import!', ['hyperon::space::DynSpace','Atom'], [->]). -op_decl('get-type', ['Atom'], 'Type'). - -op_decl(Op,Params,ReturnType):- - (metta_atom_corelib_types([':', Op, [->|List]]); - metta_atom_corelib2([':', Op, [->|List]])), - append(Params,[ReturnType],List), - \+ clause(op_decl(Op,Params,ReturnType),true). - -type_decl('Any'). -type_decl('Atom'). -type_decl('Bool'). -type_decl('ErrorType'). -type_decl('Expression'). -type_decl('Number'). -type_decl('ReturnType'). -type_decl('hyperon::space::DynSpace'). -type_decl('Symbol'). -type_decl('StateMonad'). -type_decl('Type'). -type_decl('%Undefined%'). -type_decl('Variable'). - - -%:- dynamic(get_metta_atom/2). -%:- multifile(asserted_metta/4). -%:- dynamic(asserted_metta/4). -% metta_atom_corelib_types(_):-!,fail. - -metta_atom_corelib1([':', Type, 'Type']):- type_decl(Type). - -metta_atom_corelib1([':', Op, [->|List]]):- - op_decl(Op,Params,ReturnType), append(Params,[ReturnType],List). - -metta_atom_corelib2([=,['If','True',_then],_then]). -metta_atom_corelib2([=,['If','False',_Then],[let,X,0,[let,X,1,X]]]). -metta_atom_corelib2([=,['If',_cond,_then,_else],[if,_cond,_then,_else]]). -metta_atom_corelib2(['PredicateArity','PredicateArity',2]). -metta_atom_corelib2(['PredicateArity',':',2]). -metta_atom_corelib2([=,[':',R,'P1'],['PredicateArity',R,1]]). -metta_atom_corelib2([':',':','SrcPredicate']). -metta_atom_corelib2([':','PredicateArity',[->,'Symbol','Number']]). -metta_atom_corelib2([':','If','SrcFunction']). -metta_atom_corelib2([':','If',[->,'Bool','Atom','Atom','Atom']]). -metta_atom_corelib2([':','If',[->,'Bool','Atom','Atom']]). -% 'If'(_cond, _then, _else, A) ':'- eval_true(_cond) *-> eval(_then, A); eval(_else, A). -% 'If'(_cond, _then, A) ':'- eval_true(_cond), eval(_then, A). - - - -:- dynamic(metta_atom_asserted_deduced/2). -:- multifile(metta_atom_asserted_deduced/2). -metta_atom_asserted_deduced('&corelib', Term):- metta_atom_corelib_types(Term). - -use_corelib_file:- using_corelib_file,!. -use_corelib_file:- asserta(using_corelib_file), fail. -use_corelib_file:- load_corelib_file, generate_interpreter_stubs. - -generate_interpreter_stubs:- - forall(metta_type('&corelib',Symb,Def), - gen_interp_stubs('&corelib',Symb,Def)). - -load_corelib_file:- is_metta_src_dir(Dir), really_use_corelib_file(Dir,'corelib.metta'),!. -load_corelib_file:- is_metta_src_dir(Dir), really_use_corelib_file(Dir,'stdlib_mettalog.metta'),!. -% !(import! &corelib "src/canary/stdlib_mettalog.metta") -really_use_corelib_file(Dir,File):- absolute_file_name(File,Filename,[relative_to(Dir)]), - locally(nb_setval(may_use_fast_buffer,t), - locally(nb_setval(suspend_answers,true), - with_output_to(string(_),include_metta_directory_file('&corelib',Dir,Filename)))). - -%:- initialization(use_corelib_file). - - diff --git a/.Attic/metta_lang/metta_data.pl b/.Attic/metta_lang/metta_data.pl deleted file mode 100755 index de0ac7e0ad3..00000000000 --- a/.Attic/metta_lang/metta_data.pl +++ /dev/null @@ -1,55 +0,0 @@ -/* - * 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. - */ - -:- ensure_loaded(metta_pfc_base). -:- ensure_loaded(metta_pfc_support). diff --git a/.Attic/metta_lang/metta_interp.pl b/.Attic/metta_lang/metta_interp.pl index c9de92fe74b..aa087700ebc 100755 --- a/.Attic/metta_lang/metta_interp.pl +++ b/.Attic/metta_lang/metta_interp.pl @@ -473,8 +473,9 @@ :- ensure_loaded(metta_utils). -:- ensure_loaded(metta_data). %:- ensure_loaded(mettalog('metta_ontology.pfc.pl')). +:- ensure_loaded(metta_pfc_base). +:- ensure_loaded(metta_pfc_support). :- ensure_loaded(metta_compiler). :- ensure_loaded(metta_convert). :- ensure_loaded(metta_types). @@ -1000,7 +1001,6 @@ metta_atom_asserted_deduced(X,Y), \+ clause(metta_atom_asserted(X,Y),true). - %get_metta_atom(Eq,KB, [F|List]):- KB='&flybase',fb_pred(F, Len), length(List,Len),apply(F,List). @@ -1026,7 +1026,6 @@ metta_atom_asserted('&flybase','&corelib'). metta_atom_asserted('&catalog','&corelib'). metta_atom_asserted('&catalog','&stdlib'). -:- ensure_loaded(metta_corelib). /* 'mod-space'(top,'&self'). diff --git a/.Attic/metta_lang/metta_loader.pl b/.Attic/metta_lang/metta_loader.pl index 483a6ff4a7b..5f2a0b50767 100755 --- a/.Attic/metta_lang/metta_loader.pl +++ b/.Attic/metta_lang/metta_loader.pl @@ -1151,3 +1151,22 @@ fail. % Continue looping until between/3 fails progress_bar_example. +:- dynamic(using_corelib_file/0). + + +use_corelib_file:- using_corelib_file,!. +use_corelib_file:- asserta(using_corelib_file), fail. +use_corelib_file:- load_corelib_file, generate_interpreter_stubs. + +generate_interpreter_stubs:- + forall(metta_type('&corelib',Symb,Def), + gen_interp_stubs('&corelib',Symb,Def)). + +load_corelib_file:- is_metta_src_dir(Dir), really_use_corelib_file(Dir,'corelib.metta'),!. +load_corelib_file:- is_metta_src_dir(Dir), really_use_corelib_file(Dir,'stdlib_mettalog.metta'),!. +% !(import! &corelib "src/canary/stdlib_mettalog.metta") +really_use_corelib_file(Dir,File):- absolute_file_name(File,Filename,[relative_to(Dir)]), + locally(nb_setval(may_use_fast_buffer,t), + locally(nb_setval(suspend_answers,true), + with_output_to(string(_),include_metta_directory_file('&corelib',Dir,Filename)))). + diff --git a/.Attic/metta_lang/metta_printer.pl b/.Attic/metta_lang/metta_printer.pl index db7ef40bcbf..74979ba1e02 100755 --- a/.Attic/metta_lang/metta_printer.pl +++ b/.Attic/metta_lang/metta_printer.pl @@ -146,6 +146,9 @@ %write_src(V):- !, \+ \+ quietly(pp_sex(V)),!. write_src(V):- \+ \+ notrace(pp_sex(V)),!. +write_src_woi_ln(X):- + format('~N'),write_src_woi(X),format('~N'). + pp_sex(V):- pp_sexi(V),!. % Various 'write_src' and 'pp_sex' rules are handling the writing of the source, diff --git a/.Attic/metta_lang/metta_server.pl b/.Attic/metta_lang/metta_server.pl index 343d2a5afcd..ef4591ce794 100755 --- a/.Attic/metta_lang/metta_server.pl +++ b/.Attic/metta_lang/metta_server.pl @@ -140,7 +140,10 @@ tcp_open_socket(Socket, Stream). % Helper to send goal and receive response -send_term(Stream, MeTTa) :- write_canonical(Stream, MeTTa),writeln(Stream, '.'), flush_output(Stream). +send_term(Stream, MeTTa) :- + write_canonical(Stream, MeTTa), + writeln(Stream, '.'), + flush_output(Stream). recv_term(Stream, MeTTa) :- read_term(Stream, MeTTa, []). diff --git a/.Attic/metta_lang/metta_types.pl b/.Attic/metta_lang/metta_types.pl index eed02ea09f3..a94a7f93da8 100755 --- a/.Attic/metta_lang/metta_types.pl +++ b/.Attic/metta_lang/metta_types.pl @@ -583,6 +583,19 @@ is_seo_f('Concept'). is_seo_f(N):- number(N),!. +is_absorbed_return_type(Params,Var):- var(Var),!, \+ sub_var(Var,Params). +is_absorbed_return_type(_,'Bool'). +is_absorbed_return_type(_,[Ar]):- !, Ar == (->). +is_absorbed_return_type(_,'EmptyType'). +is_absorbed_return_type(_,'ReturnType'). +is_absorbed_return_type(_,X):- is_self_return(X). + +is_self_return('ErrorType'). + +is_non_absorbed_return_type(Params,Var):- + \+ is_absorbed_return_type(Params,Var). + + %is_user_defined_goal(Self,[H|_]):- is_user_defined_head(Eq,Self,H). is_user_defined_head(Other,H):- is_user_defined_head(=,Other,H). diff --git a/.Attic/metta_lang/stdlib_mettalog.metta b/.Attic/metta_lang/stdlib_mettalog.metta index 931b8b8d472..ebbb6459698 100755 --- a/.Attic/metta_lang/stdlib_mettalog.metta +++ b/.Attic/metta_lang/stdlib_mettalog.metta @@ -1,3 +1,50 @@ +(: Any Type) +(: Atom Type) +(: Bool Type) +(: Expression Type) +(: Number Type) +(: hyperon::space::DynSpace Type) +(: ReturnType Type) +(: Symbol Type) +(: StateMonad Type) +(: Type Type) +(: %Undefined% Type) +(: Variable Type) +(: if-decons (-> Atom Variable Variable Atom Atom Atom)) +(: if-empty (-> Atom Atom Atom Atom)) +(: if-non-empty-expression (-> Atom Atom Atom Atom)) +(: if-not-reducible (-> Atom Atom Atom Atom)) +;(: apply (-> Atom Variable Atom Atom)) +;(: cons (-> Atom Atom Atom)) +;(: decons (-> Atom Atom)) +(: xor (-> Bool Bool Bool)) +(: return (-> Atom ReturnType)) +(: switch (-> %Undefined% Expression Atom)) +(: unify (-> Atom Atom Atom Atom %Undefined%)) +(: get-type0 (-> Atom Atom)) +(: get-ftype (-> Atom Atom)) +(: : %Undefined%) +(: function-arity (-> Symbol Number)) +(: predicate-arity (-> Symbol Number)) +(: pragma! (-> Atom Atom (->))) +(: = (-> Atom Atom %Undefined%)) +(: match (-> hyperon::space::DynSpace Atom Atom %Undefined%)) +(: case (-> Expression Atom Atom)) +(: combine (-> $_4082 $_4082 $_4082)) +(: import! (-> hyperon::space::DynSpace Atom (->))) +(: get-type (-> Atom Type)) +(: PredicateArity (-> Symbol Number)) +(: If (-> Bool Atom Atom Atom)) +(: If (-> Bool Atom Atom)) +(= (If True $_3800) $_3800) +(= (If False $_3710) (let $_3728 0 (let $_3728 1 $_3728))) +(= (If $_3632 $_3638 $_3644) (if $_3632 $_3638 $_3644)) +(PredicateArity PredicateArity 2) +(PredicateArity : 2) +(= (: $_3524 P1) (PredicateArity $_3524 1)) +(: : SrcPredicate) +(: If SrcFunction) + ; Public MeTTa (@doc = (@desc "A symbol used to define reduction rules for expressions.") @@ -8,7 +55,7 @@ (: = (-> $t $t Atom)) ;; Implemented from Interpreters -(: ALT= (-> Atom Atom Atom)) +(: = (-> Atom Atom Atom)) ; Public MeTTa (@doc ErrorType (@desc "Type of the atom which contains error")) @@ -1060,7 +1107,9 @@ (@params ( (@param "Reference to the space"))) (@return "List of all atoms in the input space")) -(get-atoms (-> hyperon::space::DynSpace Atom)) + +(: get-atoms (-> hyperon::space::DynSpace Atom)) + ;; Implemented from Interpreters ;; Public MeTTa From fe8b5522350ac2c83aec5eabd7e7876ac3dafcf0 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Fri, 30 Aug 2024 00:46:47 -0700 Subject: [PATCH 68/77] canary_docme --- .Attic/canary_docme/metta_comp_templates.pl | 707 +++++ .Attic/canary_docme/metta_compiler.pl | 1433 +++++++++ .../canary_docme/metta_compiler_inlining.pl | 981 ++++++ .Attic/canary_docme/metta_convert.pl | 771 +++++ .Attic/canary_docme/metta_debug.pl | 2181 ++++++++++++++ .Attic/canary_docme/metta_eval.pl | 2622 +++++++++++++++++ .Attic/canary_docme/metta_interp.pl | 1814 ++++++++++++ .Attic/canary_docme/metta_loader.pl | 1172 ++++++++ .Attic/canary_docme/metta_mizer.pl | 695 +++++ .Attic/canary_docme/metta_ontology.pfc.pl | 475 +++ .Attic/canary_docme/metta_pfc_base.pl | 1811 ++++++++++++ .Attic/canary_docme/metta_pfc_support.pl | 662 +++++ .Attic/canary_docme/metta_printer.pl | 392 +++ .Attic/canary_docme/metta_python.pl | 1039 +++++++ .Attic/canary_docme/metta_reader.pl | 1711 +++++++++++ .Attic/canary_docme/metta_repl.pl | 695 +++++ .Attic/canary_docme/metta_server.pl | 536 ++++ .Attic/canary_docme/metta_space.pl | 669 +++++ .Attic/canary_docme/metta_subst.pl | 932 ++++++ .Attic/canary_docme/metta_testing.pl | 1244 ++++++++ .Attic/canary_docme/metta_threads.pl | 187 ++ .Attic/canary_docme/metta_types.pl | 809 +++++ .Attic/canary_docme/metta_utils.pl | 2561 ++++++++++++++++ .Attic/canary_docme/swi_support.pl | 190 ++ .Attic/metta_lang/metta_mizer.pl | 4 + 25 files changed, 26293 insertions(+) create mode 100644 .Attic/canary_docme/metta_comp_templates.pl create mode 100644 .Attic/canary_docme/metta_compiler.pl create mode 100644 .Attic/canary_docme/metta_compiler_inlining.pl create mode 100644 .Attic/canary_docme/metta_convert.pl create mode 100644 .Attic/canary_docme/metta_debug.pl create mode 100644 .Attic/canary_docme/metta_eval.pl create mode 100644 .Attic/canary_docme/metta_interp.pl create mode 100644 .Attic/canary_docme/metta_loader.pl create mode 100644 .Attic/canary_docme/metta_mizer.pl create mode 100644 .Attic/canary_docme/metta_ontology.pfc.pl create mode 100644 .Attic/canary_docme/metta_pfc_base.pl create mode 100644 .Attic/canary_docme/metta_pfc_support.pl create mode 100644 .Attic/canary_docme/metta_printer.pl create mode 100644 .Attic/canary_docme/metta_python.pl create mode 100644 .Attic/canary_docme/metta_reader.pl create mode 100644 .Attic/canary_docme/metta_repl.pl create mode 100644 .Attic/canary_docme/metta_server.pl create mode 100644 .Attic/canary_docme/metta_space.pl create mode 100644 .Attic/canary_docme/metta_subst.pl create mode 100644 .Attic/canary_docme/metta_testing.pl create mode 100644 .Attic/canary_docme/metta_threads.pl create mode 100644 .Attic/canary_docme/metta_types.pl create mode 100644 .Attic/canary_docme/metta_utils.pl create mode 100644 .Attic/canary_docme/swi_support.pl diff --git a/.Attic/canary_docme/metta_comp_templates.pl b/.Attic/canary_docme/metta_comp_templates.pl new file mode 100644 index 00000000000..f089052ec52 --- /dev/null +++ b/.Attic/canary_docme/metta_comp_templates.pl @@ -0,0 +1,707 @@ +/* + * 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. + */ + + + +% # 1. Length of a List +% % Normal Recursive +% prolog +len([], 0). +len([_|T], N) :- + len(T, X), + N is X + 1. +% + +% % With Accumulator +% prolog +len_acc(L, N) :- + len_acc(L, 0, N). + +len_acc([], Acc, Acc). +len_acc([_|T], Acc, N) :- + NewAcc is Acc + 1, + len_acc(T, NewAcc, N). +% + +% # 2. Sum of a List +% % Normal Recursive +% prolog +sum([], 0). +sum([H|T], S) :- + sum(T, X), + S is X + H. +% + +% % With Accumulator +% prolog +sum_acc(L, S) :- + sum_acc(L, 0, S). + +sum_acc([], Acc, Acc). +sum_acc([H|T], Acc, S) :- + NewAcc is Acc + H, + sum_acc(T, NewAcc, S). +% + +% # 3. Factorial +% % Normal Recursive +% prolog +factorial(0, 1). +factorial(N, F) :- + N > 0, + X is N - 1, + factorial(X, Y), + F is N * Y. +% + +% % With Accumulator +% prolog +factorial_acc(N, F) :- + factorial_acc(N, 1, F). + +factorial_acc(0, Acc, Acc). +factorial_acc(N, Acc, F) :- + N > 0, + NewAcc is Acc * N, + NewN is N - 1, + factorial_acc(NewN, NewAcc, F). +% + +% # 4. Reverse List +% % Normal Recursive +% prolog +reverse_list([], []). +reverse_list([H|T], R) :- + reverse_list(T, RevT), + append(RevT, [H], R). +% + +% % With Accumulator +% prolog +reverse_list_acc(L, R) :- + reverse_list_acc(L, [], R). + +reverse_list_acc([], Acc, Acc). +reverse_list_acc([H|T], Acc, R) :- + reverse_list_acc(T, [H|Acc], R). +% + +% # 5. Fibonacci +% % Normal Recursive +% prolog +fibonacci(0, 0). +fibonacci(1, 1). +fibonacci(N, F) :- + N > 1, + N1 is N - 1, + N2 is N - 2, + fibonacci(N1, F1), + fibonacci(N2, F2), + F is F1 + F2. +% + +% % With Accumulator +% prolog +fibonacci_acc(N, F) :- + fibonacci_acc(N, 0, 1, F). + +fibonacci_acc(0, A, _, A). +fibonacci_acc(N, A, B, F) :- + N > 0, + NewN is N - 1, + NewB is A + B, + fibonacci_acc(NewN, B, NewB, F). +% + + + +% 6. Find an Element in a List +% # Normal Recursive +% prolog +element_in_list(X, [X|_]). +element_in_list(X, [_|T]) :- element_in_list(X, T). +% + +% # With Accumulator +% prolog +element_in_list_acc(X, L) :- element_in_list_acc(X, L, false). + +element_in_list_acc(X, [], Acc) :- Acc. +element_in_list_acc(X, [X|_], _) :- true. +element_in_list_acc(X, [_|T], Acc) :- element_in_list_acc(X, T, Acc). +% + +% 7. Check if a List is a Palindrome +% # Normal Recursive +% prolog +is_palindrome(L) :- reverse(L, L). +% + +% # With Accumulator +% prolog +is_palindrome_acc(L) :- reverse_acc(L, [], L). + +reverse_acc([], Acc, Acc). +reverse_acc([H|T], Acc, R) :- reverse_acc(T, [H|Acc], R). +% + +% 8. Calculate the Product of All Elements in a List +% # Normal Recursive +% prolog +product_list([], 1). +product_list([H|T], P) :- + product_list(T, Temp), + P is H * Temp. +% + +% # With Accumulator +% prolog +product_list_acc(L, P) :- product_list_acc(L, 1, P). + +product_list_acc([], Acc, Acc). +product_list_acc([H|T], Acc, P) :- + NewAcc is Acc * H, + product_list_acc(T, NewAcc, P). +% + +% 9. Find the Nth Element of a List +% # Normal Recursive +% prolog +nth_element(1, [H|_], H). +nth_element(N, [_|T], X) :- + N > 1, + M is N - 1, + nth_element(M, T, X). +% + +% # With Accumulator +% prolog +nth_element_acc(N, L, X) :- nth_element_acc(N, L, 1, X). + +nth_element_acc(N, [H|_], N, H). +nth_element_acc(N, [_|T], Acc, X) :- + NewAcc is Acc + 1, + nth_element_acc(N, T, NewAcc, X). +% + +% 10. Count the Occurrences of an Element in a List +% # Normal Recursive +% prolog +count_occurrences(_, [], 0). +count_occurrences(X, [X|T], N) :- + count_occurrences(X, T, M), + N is M + 1. +count_occurrences(X, [Y|T], N) :- + X \= Y, + count_occurrences(X, T, N). +% + +% # With Accumulator +% prolog +count_occurrences_acc(X, L, N) :- count_occurrences_acc(X, L, 0, N). + +count_occurrences_acc(_, [], Acc, Acc). +count_occurrences_acc(X, [X|T], Acc, N) :- + NewAcc is Acc + 1, + count_occurrences_acc(X, T, NewAcc, N). +count_occurrences_acc(X, [Y|T], Acc, N) :- + X \= Y, + count_occurrences_acc(X, T, Acc, N). +% + +% 11. Calculate the Greatest Common Divisor of Two Numbers +% # Normal Recursive +% prolog +gcd(A, 0, A) :- A > 0. +gcd(A, B, GCD) :- + B > 0, + R is A mod B, + gcd(B, R, GCD). +% + +% # With Accumulator +% prolog +gcd_acc(A, B, GCD) :- gcd_acc(A, B, 1, GCD). + +gcd_acc(A, 0, Acc, Acc) :- A > 0. +gcd_acc(A, B, Acc, GCD) :- + B > 0, + R is A mod B, + NewAcc is B * Acc, + gcd_acc(B, R, NewAcc, GCD). +% + +% 12. Check if a Number is Prime +% # Normal Recursive +% prolog +is_prime(2). +is_prime(N) :- + N > 2, + \+ (between(2, sqrt(N), X), N mod X =:= 0). +% + +% # With Accumulator +% prolog +is_prime_acc(N) :- is_prime_acc(N, 2). + +is_prime_acc(2, 2). +is_prime_acc(N, Acc) :- + N > 2, + ( + (Acc * Acc > N, !); + (N mod Acc =\= 0, NewAcc is Acc + 1, is_prime_acc(N, NewAcc)) + ). +% + +% 13. Merge Two Sorted Lists into a Sorted List +% # Normal Recursive +% prolog +merge_sorted([], L, L). +merge_sorted(L, [], L). +merge_sorted([H1|T1], [H2|T2], [H1|M]) :- + H1 =< H2, + merge_sorted(T1, [H2|T2], M). +merge_sorted([H1|T1], [H2|T2], [H2|M]) :- + H1 > H2, + merge_sorted([H1|T1], T2, M). +% + +% # With Accumulator +% prolog +merge_sorted_acc(L1, L2, L) :- merge_sorted_acc(L1, L2, [], L). + +merge_sorted_acc([], L, Acc, L) :- reverse(Acc, L), !. +merge_sorted_acc(L, [], Acc, L) :- reverse(Acc, L), !. +merge_sorted_acc([H1|T1], [H2|T2], Acc, [H|M]) :- + H1 =< H2, + merge_sorted_acc(T1, [H2|T2], [H1|Acc], M). +merge_sorted_acc([H1|T1], [H2|T2], Acc, [H|M]) :- + H1 > H2, + merge_sorted_acc([H1|T1], T2, [H2|Acc], M). + +% + +% 14. Find the Last Element of a List +% # Normal Recursive +% prolog +last_element([H], H). +last_element([_|T], X) :- last_element(T, X). +% + +% # With Accumulator +% prolog +last_element_acc([H|T], X) :- last_element_acc(T, H, X). + +last_element_acc([], Acc, Acc). +last_element_acc([H|T], _, X) :- last_element_acc(T, H, X). +% + +% 15. Remove Duplicate Elements from a List +% # Normal Recursive +% prolog +remove_duplicates([], []). +remove_duplicates([H|T], [H|T1]) :- \+ member(H, T), remove_duplicates(T, T1). +remove_duplicates([_|T], T1) :- remove_duplicates(T, T1). +% + +% # With Accumulator +% prolog +remove_duplicates_acc(L, R) :- remove_duplicates_acc(L, [], R). + +remove_duplicates_acc([], Acc, Acc). +remove_duplicates_acc([H|T], Acc, R) :- + (member(H, Acc) -> remove_duplicates_acc(T, Acc, R); + remove_duplicates_acc(T, [H|Acc], R)). +% + +% 16. Check if a Binary Tree is Balanced +% # Normal Recursive +% prolog +is_balanced(null). +is_balanced(tree(L, _, R)) :- + height(L, Hl), + height(R, Hr), + D is Hl - Hr, + abs(D) =< 1, + is_balanced(L), + is_balanced(R). +% + +% # With Accumulator +% prolog +is_balanced_acc(T) :- is_balanced_acc(T, 0). + +is_balanced_acc(null, 0). +is_balanced_acc(tree(L, _, R), H) :- + is_balanced_acc(L, Hl), + is_balanced_acc(R, Hr), + D is Hl - Hr, + abs(D) =< 1, + H is max(Hl, Hr) + 1. +% + +% 17. Calculate the Height of a Binary Tree +% # Normal Recursive +% prolog +height(null, 0). +height(tree(L, _, R), H) :- + height(L, Hl), + height(R, Hr), + H is max(Hl, Hr) + 1. +% + +% # With Accumulator +% prolog +height_acc(T, H) :- height_acc(T, 0, H). + +height_acc(null, Acc, Acc). +height_acc(tree(L, _, R), Acc, H) :- + NewAcc is Acc + 1, + height_acc(L, NewAcc, Hl), + height_acc(R, NewAcc, Hr), + H is max(Hl, Hr). +% + +% 18. Search for an Element in a Binary Search Tree +% # Normal Recursive +% prolog +search_bst(tree(_, X, _), X). +search_bst(tree(L, Y, _), X) :- + X < Y, + search_bst(L, X). +search_bst(tree(_, Y, R), X) :- + X > Y, + search_bst(R, X). +% + +% # With Accumulator +% prolog +% The accumulator is not very useful here, as the search path is already determined by the BST property. +search_bst_acc(Tree, X) :- search_bst(Tree, X). +% + +% 19. Insert an Element into a Binary Search Tree +% # Normal Recursive +% prolog +insert_bst(null, X, tree(null, X, null)). +insert_bst(tree(L, Y, R), X, tree(L1, Y, R)) :- + X < Y, + insert_bst(L, X, L1). +insert_bst(tree(L, Y, R), X, tree(L, Y, R1)) :- + X > Y, + insert_bst(R, X, R1). +% + +% # With Accumulator +% prolog +% The accumulator is not very useful here, as the insertion path is already determined by the BST property. +insert_bst_acc(Tree, X, NewTree) :- insert_bst(Tree, X, NewTree). +% + +% 20. Delete an Element from a Binary Search Tree +% # Normal Recursive +% prolog +delete_bst(Tree, X, NewTree) :- + remove_bst(Tree, X, NewTree). + +remove_bst(tree(L, X, R), X, Merged) :- merge_trees(L, R, Merged), !. +remove_bst(tree(L, Y, R), X, tree(L1, Y, R)) :- + X < Y, + remove_bst(L, X, L1). +remove_bst(tree(L, Y, R), X, tree(L, Y, R1)) :- + X > Y, + remove_bst(R, X, R1). + +merge_trees(null, Tree, Tree). +merge_trees(Tree, null, Tree). +merge_trees(tree(L1, X, R1), tree(L2, Y, R2), tree(Merged, Y, R2)) :- + merge_trees(tree(L1, X, R1), L2, Merged). +% + +% # With Accumulator +% prolog +% The accumulator is not very useful here, as the deletion path is already determined by the BST property. +delete_bst_acc(Tree, X, NewTree) :- delete_bst(Tree, X, NewTree). +% + +% 21. Find the Lowest Common Ancestor in a Binary Search Tree +% # Normal Recursive +% prolog +lowest_common_ancestor(tree(_, Y, _), X, Z, Y) :- + X < Y, Z > Y; + X > Y, Z < Y. +lowest_common_ancestor(tree(L, Y, _), X, Z, LCA) :- + X < Y, Z < Y, + lowest_common_ancestor(L, X, Z, LCA). +lowest_common_ancestor(tree(_, Y, R), X, Z, LCA) :- + X > Y, Z > Y, + + + lowest_common_ancestor(R, X, Z, LCA). +% + +% # With Accumulator +% prolog +% The accumulator is not very useful here, as the search path is already determined by the BST property. +lowest_common_ancestor_acc(Tree, X, Z, LCA) :- lowest_common_ancestor(Tree, X, Z, LCA). +% + +% 22. Check if a Graph is Cyclic +% For graphs, it's better to represent them in a Prolog-friendly format, such as adjacency lists. I will use a representation where each node has a list of its neighbors. +% # Normal Recursive +% prolog +is_cyclic(Graph) :- + member(Vertex-_, Graph), + dfs(Vertex, Graph, [Vertex], _), !. + +dfs(Vertex, Graph, Visited, [Vertex|Visited]) :- + member(Vertex-Neighbors, Graph), + member(Neighbor, Neighbors), + member(Neighbor, Visited), !. +dfs(Vertex, Graph, Visited, FinalVisited) :- + member(Vertex-Neighbors, Graph), + member(Neighbor, Neighbors), + \+ member(Neighbor, Visited), + dfs(Neighbor, Graph, [Neighbor|Visited], FinalVisited). +% + +% # With Accumulator +% prolog +% Due to the way depth-first search works, a typical accumulator wouldn't be very effective. +% The visited list already acts like an accumulator. +is_cyclic_acc(Graph) :- is_cyclic(Graph). +% + +% 23. Perform a Depth-First Search on a Graph +% # Normal Recursive +% prolog +dfs_graph(Vertex, Graph) :- dfs_vertex(Vertex, Graph, []). + +dfs_vertex(Vertex, _, Visited) :- member(Vertex, Visited), !. +dfs_vertex(Vertex, Graph, Visited) :- + write(Vertex), nl, + member(Vertex-Neighbors, Graph), + dfs_neighbors(Neighbors, Graph, [Vertex|Visited]). + +dfs_neighbors([], _, _). +dfs_neighbors([Neighbor|Neighbors], Graph, Visited) :- + dfs_vertex(Neighbor, Graph, Visited), + dfs_neighbors(Neighbors, Graph, Visited). +% + +% # With Accumulator +% prolog +% The visited list acts as an accumulator. +dfs_graph_acc(Vertex, Graph) :- dfs_graph(Vertex, Graph). +% + +% 24. Perform a Breadth-First Search on a Graph +% # Normal Recursive +% prolog +bfs_graph(Vertex, Graph) :- + bfs([Vertex], Graph, [Vertex]). + +bfs([], _, _). +bfs([Vertex|Vertices], Graph, Visited) :- + write(Vertex), nl, + member(Vertex-Neighbors, Graph), + filter_unvisited(Neighbors, Visited, NewNeighbors, NewVisited), + append(Vertices, NewNeighbors, NewVertices), + bfs(NewVertices, Graph, NewVisited). + +filter_unvisited([], Visited, [], Visited). +filter_unvisited([Neighbor|Neighbors], Visited, NewNeighbors, NewVisited) :- + (member(Neighbor, Visited) -> + filter_unvisited(Neighbors, Visited, NewNeighbors, NewVisited); + filter_unvisited(Neighbors, [Neighbor|Visited], NewNeighbors, [Neighbor|NewVisited]) + ). +% + +% # With Accumulator +% prolog +% The visited list acts as an accumulator. +bfs_graph_acc(Vertex, Graph) :- bfs_graph(Vertex, Graph). +% + +% 25. Check if a Graph is Connected +% # Normal Recursive +% prolog +is_connected(Graph) :- + Graph = [Vertex-_|_], + dfs_graph(Vertex, Graph), + \+ (member(OtherVertex-_, Graph), \+ member(OtherVertex, Visited)), !. +% + +% # With Accumulator +% prolog +% The visited list acts as an accumulator. +is_connected_acc(Graph) :- is_connected(Graph). +% + +% 26. Find the Shortest Path between Two Nodes in a Graph +% # Normal Recursive +% prolog +shortest_path(Start, End, Graph, Path) :- + shortest_path([Start], End, Graph, [Start], Path). + +shortest_path(_, End, _, Visited, ReversePath) :- + reverse(ReversePath, [End|_]), !. +shortest_path(Vertices, End, Graph, Visited, Path) :- + adjacent_unvisited(Vertices, Graph, Visited, Adjacent), + append(Visited, Adjacent, NewVisited), + append(Vertices, Adjacent, NewVertices), + shortest_path(NewVertices, End, Graph, NewVisited, Path). +% + +% # With Accumulator +% prolog +% The visited list and the list of vertices to explore act as accumulators. +shortest_path_acc(Start, End, Graph, Path) :- shortest_path(Start, End, Graph, Path). +% + +% 27. Check if a String is a Palindrome +% # Normal Recursive +% prolog +is_string_palindrome(Str) :- string_chars(Str, Chars), is_palindrome(Chars). +% + +% # With Accumulator +% prolog +is_string_pal + +indrome_acc(Str) :- string_chars(Str, Chars), is_palindrome_acc(Chars, []). +% + +% 28. Compute the Edit Distance between Two Strings +% # Normal Recursive +% prolog +edit_distance([], [], 0). +edit_distance([_|T1], [], D) :- + edit_distance(T1, [], D1), + D is D1 + 1. +edit_distance([], [_|T2], D) :- + edit_distance([], T2, D1), + D is D1 + 1. +edit_distance([H1|T1], [H2|T2], D) :- + edit_distance(T1, T2, D1), + D is D1 + (H1 \= H2). +% + +% # With Accumulator +% prolog +edit_distance_acc(S1, S2, D) :- edit_distance_acc(S1, S2, 0, D). + +edit_distance_acc([], [], Acc, Acc). +edit_distance_acc([_|T1], [], Acc, D) :- NewAcc is Acc + 1, edit_distance_acc(T1, [], NewAcc, D). +edit_distance_acc([], [_|T2], Acc, D) :- NewAcc is Acc + 1, edit_distance_acc([], T2, NewAcc, D). +edit_distance_acc([H1|T1], [H2|T2], Acc, D) :- + NewAcc is Acc + (H1 \= H2), + edit_distance_acc(T1, T2, NewAcc, D). +% + +% 29. Find the Longest Common Subsequence of Two Strings +% # Normal Recursive +% prolog +lcs([], _, []). +lcs(_, [], []). +lcs([H|T1], [H|T2], [H|Lcs]) :- lcs(T1, T2, Lcs), !. +lcs(S1, [_|T2], Lcs) :- lcs(S1, T2, Lcs). +lcs([_|T1], S2, Lcs) :- lcs(T1, S2, Lcs). +% + +% # With Accumulator +% prolog +lcs_acc(S1, S2, Lcs) :- lcs_acc(S1, S2, [], Lcs). + +lcs_acc([], _, Acc, Lcs) :- reverse(Acc, Lcs). +lcs_acc(_, [], Acc, Lcs) :- reverse(Acc, Lcs). +lcs_acc([H|T1], [H|T2], Acc, Lcs) :- lcs_acc(T1, T2, [H|Acc], Lcs). +lcs_acc(S1, [_|T2], Acc, Lcs) :- lcs_acc(S1, T2, Acc, Lcs). +lcs_acc([_|T1], S2, Acc, Lcs) :- lcs_acc(T1, S2, Acc, Lcs). +% + +% 30. Find the Longest Common Substring of Two Strings +% # Normal Recursive +% prolog +longest_common_substring(S1, S2, Lcs) :- + findall(Sub, (substring(S1, Sub), substring(S2, Sub)), Subs), + longest_string(Subs, Lcs). + +substring(Str, Sub) :- + append(_, Rest, Str), + append(Sub, _, Rest). + +longest_string([H|T], Longest) :- + longest_string(T, H, Longest). + +longest_string([], Acc, Acc). +longest_string([H|T], Acc, Longest) :- + length(H, LenH), + length(Acc, LenAcc), + (LenH > LenAcc -> longest_string(T, H, Longest); longest_string(T, Acc, Longest)). +% + +% # With Accumulator +% prolog +longest_common_substring_acc(S1, S2, Lcs) :- + findall(Sub, (substring(S1, Sub), substring(S2, Sub)), Subs), + longest_string_acc(Subs, [], Lcs). + +longest_string_acc([], Acc, Acc). +longest_string_acc([H|T], Acc, Longest) :- + length(H, LenH), + length(Acc, LenAcc), + (LenH > LenAcc -> longest_string_acc(T, H, Longest); longest_string_acc(T, Acc, Longest)). +% + + diff --git a/.Attic/canary_docme/metta_compiler.pl b/.Attic/canary_docme/metta_compiler.pl new file mode 100644 index 00000000000..7dbc7fbe31d --- /dev/null +++ b/.Attic/canary_docme/metta_compiler.pl @@ -0,0 +1,1433 @@ +/* + * 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. + */ + +% Setting the file encoding to ISO-Latin-1 +:- encoding(iso_latin_1). +% Flushing the current output +:- flush_output. +% Setting the Rust backtrace to Full +:- setenv('RUST_BACKTRACE',full). +% Loading various library files +:- ensure_loaded(swi_support). +:- ensure_loaded(metta_testing). +:- ensure_loaded(metta_utils). +:- ensure_loaded(metta_reader). +:- ensure_loaded(metta_interp). +:- ensure_loaded(metta_space). +:- ensure_loaded(metta_compiler_inlining). +:- ensure_loaded(metta_mizer). +% ======================================= +% TODO move non flybase specific code between here and the compiler +%:- ensure_loaded(flybase_main). +% ======================================= +%:- set_option_value(encoding,utf8). + +:- dynamic(metta_compiled_predicate/2). +:- multifile(metta_compiled_predicate/2). +:- dynamic(metta_compiled_predicate/3). +:- multifile(metta_compiled_predicate/3). + + +w_cl(P1,F):- atom(F),!,w_cl(P1,F/_). +w_cl(P1,F/A):- atom(F),integer(A),!,functor(P,F,A),w_cl(P1,P). +w_cl(P1,F/A):- forall((current_predicate(F/A),A>0),w_cl(P1,F/A)). +w_cl(P1,P):- call(P1,P). + + + +dedupe_p1(P):- current_predicate(_,P), + forall((copy_term(P,P2), + clause(P,Bd,Ref), + clause(P2,Bd2,Ref2), Ref@', +% \+ file_decl_arity(F,_), length(Args,AA),!,A=AA. +function_arity(F,A):- current_self(KB), function_arity(KB,F,A). + + +defined_arity(F,A):- predicate_arity(F,A). +defined_arity(F,A):- current_predicate(F/A), \+ predicate_arity(F,_). + +% defined as (= .. .....) +decl_arity(F,A):- metta_atom_file_buffer([Eq,[FF|Len]|_]), + Eq=='=',nonvar(FF),F==FF,is_list(Len),length([FF|Len],A). + +import_arity(_,_):- fail, todo(metta_file_buffer(_Atom,_NamedVarsList,_Filename,_LineCount)). +is_data_functor(DataFunctor,DenotationalArity):- nonvar(DataFunctor), + metta_atom_file_buffer(['DataFunctor',DataFunctor,DenotationalArity]). +is_data_functor(F,_):- \+ import_arity(F,_), \+ decl_arity(F,_). + +% Certain constructs should not be converted to functions. +not_function(P):- symbol(P),!,not_function(P,0). +not_function(P):- callable(P),!,as_functor_args(P,F,A),not_function(F,A). +not_function(F,A):- is_arity_0(F,FF),!,not_function(FF,A). +not_function(!,0). +not_function(print,1). +not_function((':-'),2). +not_function((','),2). +not_function((';'),2). +not_function(('='),2). +not_function(('or'),2). + +not_function('a',0). +not_function('b',0). +not_function(F,A):- is_control_structure(F,A). +not_function(A,0):- symbol(A),!. +not_function('True',0). +not_function(F,A):- predicate_arity(F,A),AA is A+1, \+ decl_functional_predicate_arg(F,AA,_). + +needs_call_fr(P):- is_function(P,_Nth),as_functor_args(P,F,A),AA is A+1, \+ current_predicate(F/AA). + +is_control_structure(F,A):- symbol(F), atom_concat('if-',_,F),A>2. + +'=='(A, B, Res):- as_tf(equal_enough(A, B),Res). +'or'(G1,G2):- G1 *-> true ; G2. +'or'(G1,G2,Res):- as_tf((G1 ; G2),Res). + +% Function without arguments can be converted directly. +is_arity_0(AsFunction,F):- compound(AsFunction), compound_name_arity(AsFunction,F,0). + +% Determines whether a given term is a function and retrieves the position +% in the predicate where the function Result is stored/retrieved +is_function(AsFunction, _):- is_ftVar(AsFunction),!,fail. +is_function(AsFunction, _):- AsFunction=='$VAR',!, trace, fail. +is_function(AsFunction, Nth) :- is_arity_0(AsFunction,F), \+ not_function(F,0), !,Nth=1. +is_function(AsFunction, Nth) :- is_arity_0(AsFunction,_), !,Nth=1. +is_function([F|Function], Nth) :- + is_list(Function),length(Function,N), + functional_predicate_arg_maybe(F, N, Nth). + +is_function(AsFunction, Nth) :- + callable(AsFunction), + as_functor_args(AsFunction, Functor, A), + \+ not_function(Functor, A), + AA is A + 1, + functional_predicate_arg_maybe(Functor, AA, Nth). + +functional_predicate_arg_maybe(F, _, _):- \+ symbol(F),!,fail. +functional_predicate_arg_maybe(F, AA, Nth):- functional_predicate_arg(F, AA, Nth),!. +functional_predicate_arg_maybe(F, AA, _):- A is AA - 1,functional_predicate_arg(F,A,_),!,fail. +functional_predicate_arg_maybe(F, Nth, Nth):- asserta(decl_functional_predicate_arg(F, Nth, Nth)),!. + +% -------------------------------- +% FUNCTS_TO_PREDS EXPLANATION +% -------------------------------- + +% functs_to_preds is a predicate that converts all Term functions to their equivalent predicates. +% It takes three arguments - RetResult, which will hold the result of the function evaluation, +% Convert, which is the function that needs to be converted, and Converted, which will hold the equivalent predicate. +% Example: +% +% ?- functs_to_preds(RetResult, is(pi+pi), Converted). +% +% Converted = (pi(_A), +% +(_A, _A, _B), +% _C is _B, +% u_assign(_C, RetResult)). +% +functs_to_preds(I,OO):- + notrace(is_html->true; non_compat_io(color_g_mesg('yellow', (write_src(I),nl)))), + must_det_ll(functs_to_preds0(I,OO)),!. + +functs_to_preds0(I,OO):- \+ compound(I),!,OO=I. +%functs_to_preds0(I,OO):- data_term(I),!,OO=I. +functs_to_preds0(I,OO):- \+ is_conz(I), once(into_list_args(I,II)), I\=@=II, functs_to_preds(II,OO),!. +functs_to_preds0([Eq,H,B],OO):- Eq == '=', !, compile_for_assert(H, B, OO),!. +functs_to_preds0(=(H,B),OO):- !, compile_for_assert(H, B, OO),!. +functs_to_preds0(EqHB,OO):- compile_for_assert(EqHB,(X==X),OO),!. +functs_to_preds0(I,OO):- + must_det_ll(( + sexpr_s2p(I, M), + f2p(_,_,M,O), + expand_to_hb(O,H,B), + optimize_head_and_body(H,B,HH,BB),!, + OO = ':-'(HH,BB))). + +% ?- compile_for_exec(RetResult, is(pi+pi), Converted). + + +compile_for_exec(Res,I,O):- + %ignore(Res='$VAR'('RetResult')), + compile_for_exec0(Res,I,O),!. + +compile_for_exec0(Res,I,u_assign(I,Res)):- is_ftVar(I),!. +compile_for_exec0(Res,(:- I),O):- !, + compile_for_exec0(Res,I,O). +compile_for_exec0(Res,(?- I),O):- !, + compile_for_exec0(Res,I,O). +compile_for_exec0(Res,I,BB):- + %ignore(Res='$VAR'('RetResult')), + compound_name_arguments(EXEC1, exec1, []), + f2p(EXEC1,Res,I,O), + optimize_head_and_body(exec1(Res),O,_,BB). + +compile_for_exec0(Res,I,BB):- fail, + compound_name_arguments(EXEC0, exec0, []), + compile_for_assert(EXEC0, I, H:-BB), + arg(1,H,Res). + + + +compile_metta_defn(_KB,_F,_Len,Args,_BodyFn,_Clause):- \+ is_list(Args),!,fail. +%compile_metta_defn(_KB,_F,_Len,_Args,BodyFn,_Clause):- var(BodyFn),!,fail. +compile_metta_defn(KB,F,Len,Args,[WB|AL],ClauseU):- 'wam-body'==WB,!, + must_det_ll(( + if_t(var(Len), ignore((function_arity(KB,F,Len)))), + if_t(var(Arity),ignore((is_non_absorbed_return(KB,F,Len,_), ignore(Arity is Len+1)))), + if_t(var(Arity),ignore((is_absorbed_return(KB,F,Arity,_), ignore(Len is Arity)))), + if_t(var(Arity),ignore((predicate_arity(KB,F,Arity)))), + if_t(var(Arity),length(Args,Arity)), + if_t(var(Len),ignore(Len is Arity-1)), + if_t(var(Len),if_t(integer(SLen),Len = SLen)), + pfcAdd(metta_compiled_predicate(KB,F,Len)), + Clause=(H:-B), s2c([F|Args],H), maplist(s2c,AL,ALB), + list_to_conjuncts(ALB,B), + %nl,print_tree(Clause),nl, + add_unnumbered_clause(KB,F,Len,Clause,ClauseU))),!. +compile_metta_defn(KB,F,Len,Args,BodyFn,ClauseU):- + must_det_ll(( + if_t(var(Len),length(Args,Len)), + pfcAdd(metta_compiled_predicate(KB,F,Len)), + compile_for_assert([F|Args],BodyFn,Clause), + add_unnumbered_clause(KB,F,Len,Clause,ClauseU))). + +add_unnumbered_clause(KB,F,Len,ClauseN,Clause):- + must_det_ll(( + unnumbervars_clause(ClauseN,Clause), + pfcAdd(metta_compiled_predicate(KB,F,Len)), + add_assertion(KB,Clause))),!. + +compile_for_assert_eq('=',HeadInC, AsBodyFnC, Converted):- + subst_vars(['=',HeadInC, AsBodyFnC],['=',HeadIn, AsBodyFn],NamedVarsList), + maplist(cname_var,NamedVarsList),!, + compile_for_assert(HeadIn, AsBodyFn, Converted). +compile_for_assert_eq(':-',HeadIn, BodyIn, Converted):- + call(ensure_corelib_types), + Converted=(H:-B), s2p(HeadIn,H), s2p(BodyIn,B),!. + + + +/* +compile_for_assert_01(HeadIs, AsBodyFn, Converted) :- + ( AsBodyFn =@= HeadIs ; AsBodyFn == [] ), !, + compile_fact_for_assert(HeadIs,Converted). + +% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. + +compile_for_assert_01(Head, AsBodyFn, Converted) :- + once(compile_head_variablization(Head, HeadC, HeadCode)), + \+ atomic(HeadCode), !, + compile_for_assert_01(HeadC, + (HeadCode,AsBodyFn), Converted),!. + +compile_for_assert_01(HeadIn, AsBodyFn, Converted) :- + r2p(HeadIn,HResult,Head), + compile_for_assert_02(HResult,Head, AsBodyFn, Converted),!. +compile_for_assert_01(HeadIn, AsBodyFn, Converted) :- + compile_for_assert_02(_HResult, HeadIn, AsBodyFn, Converted),!. + + +compile_for_assert_02(HResult,HeadIs, AsBodyFn, Converted) + :- is_nsVar(AsBodyFn), + AsFunction = HeadIs,!, + must_det_ll(( + Converted = (HeadC :- BodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn + %funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), + f2p(HeadIs,HResult,AsFunction,HHead), + (var(HResult) -> (Result = HResult, HHead = Head) ; + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), + NextBody = u_assign(AsBodyFn,Result), + optimize_head_and_body(Head,NextBody,HeadC,BodyC), + cname_var('HEAD_RES',Result))),!. + +compile_for_assert_02(HResult,HeadIs, AsBodyFn, Converted) :- + h2p(HeadIs,HResult,NewHead), + AsFunction = HeadIs, + must_det_ll(( + Converted = (HeadC :- NextBodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn + % funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), + f2p(NewHead,HResult,AsFunction,HHead), + (var(HResult) -> (Result = HResult, HHead = Head) ; + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), + %verbose_unify(Converted), + f2p(HeadIs,Result,AsBodyFn,NextBody), + %RetResult = Converted, + %RetResult = _, + optimize_head_and_body(Head,NextBody,HeadC,NextBodyC), + %fbug([convert(Convert),optimize_head_and_body(HeadC:-NextBodyC)]), + %if_t(((Head:-NextBody)\=@=(HeadC:-NextBodyC)),fbug(was(Head:-NextBody))), + + cname_var('HEAD_RES',Result))),!. + +% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. +compile_for_assert_02(HResult,HeadIs, AsBodyFn, Converted) :- + Result = HResult, + AsFunction = HeadIs, Converted = (HeadCC :- BodyCC), + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), + compile_head_args(Head,HeadC,HeadCode), + f2p(HeadIs,Result,AsBodyFn,NextBody), + combine_code(HeadCode,NextBody,BodyC),!, + optimize_head_and_body(HeadC,BodyC,HeadCC,BodyCC),!. + + +*/ +merge_structures([F|HeadAsFunction0], AsBodyFn0,A,B,(=(NewVar,Cept),C)):- fail, + append(Left,[Merge|Right],HeadAsFunction0), nonvar(Merge), + append(Left,[Cept|Right],HeadAsFunctionM), + %HeadAsFunctionM=REPH, + HeadAsFunction0=REPH, + subst(AsBodyFn0+REPH,Merge,NewVar,NextBodyFn+NextHead), + NextBodyFn+NextHead \=@= AsBodyFn0+HeadAsFunctionM, + merge_structures([F|NextHead], NextBodyFn,A,B,C), + Cept=Merge. +merge_structures(A,B,A,B,true). + +compile_for_assert(HeadAsFunction0, AsBodyFn0, ConvertedO) :- + must_det_ll(( + call(ensure_corelib_types), + merge_structures(HeadAsFunction0, AsBodyFn0,HeadAsFunction, AsBodyFn,PreCode), + as_functor_args(HeadAsFunction,_F,Len), + h2p(Which,HeadAsFunction,ResultToHead,HeadAsPred), + compile_head_for_assert(Which,HeadAsPred,HeadC,_SupposedRT, + Len, NarrowRetType,ResultToHead, ResultFromBody,HeadCode,ResultCode), + f2p(HeadC,NarrowRetType,ResultFromBody,AsBodyFn,NextBody), + combine_code([PreCode,HeadCode,NextBody,ResultCode],BodyC),!, + optimize_head_and_body(HeadC,BodyC,HeadCC,BodyCC), + Convert = (HeadCC :- BodyCC), + fix_equals_in_head(Convert,Converted),!, + continue_opimize(Converted,ConvertedO))). + + +compile_head_for_assert(Which,Head, NewHead, SupposedRT, Len, NarrowRetType,ResultToHead,ResultFromBody,PreBodyCode,ResultCode):- + \+ is_list(Head), + as_functor_args(Head,F,_,ArgsL),!, + compile_head_for_assert(Which,[F|ArgsL], NewHead, SupposedRT, Len, NarrowRetType,ResultToHead,ResultFromBody,PreBodyCode,ResultCode),!. + +% compile_head_for_assert(Head, Head, true):- head_as_is(Head),!. +compile_head_for_assert(_Which,HeadAsPred,NewestHead,SupposedRT,Len,NarrowRetType, + ResultToHead,ResultFromBody, + PreBodyCode,ResultCode):- + must_det_ll(( + HeadAsPred=[F|PredArgs], + length(PredArgs,Arity), + length(NewPredArgs,Arity), + length(ParamTypes,Len), + length(FunctionArgs,Len),length(NewFunctionArgs,Len), + append(FunctionArgs,RetL,PredArgs), + append(NewFunctionArgs,RetL,NewPredArgs), + (RetL==[] -> true ; RetL=[ResultFromBody|_]), + get_operator_typedef(Self,F,ParamTypes,BodyRetType), + narrow_types(SupposedRT,BodyRetType,NarrowRetType), + compile_head_args(20,HeadAsPred,Self,F,1,ParamTypes,FunctionArgs,NewFunctionArgs,ParamCode), + FutureHead = [F|NewPredArgs], + compile_head_variablization(FutureHead, NewestHead, VHeadCode), + combine_code([ParamCode,VHeadCode],PreBodyCode), + ResultCode = eval_for(ret,BodyRetType,ResultFromBody,ResultToHead))). + + +compile_head_variablization(Head, NewHead, PreBodyCode) :- + must_det_ll( + (as_functor_args(Head,Functor,A,Args), + % Find non-singleton variables in Args + fix_non_singletons(Args, NewArgs, Conditions), + list_to_conjunction(Conditions,PreBodyCode), + as_functor_args(NewHead,Functor,A,NewArgs))),!. + + + + + +% Construct the new head args +compile_head_args(Depth,HeadIs,Self,F,Nth,[PT|ParamTypes],[A|Args],[N|NewArgs],CCode):- !, + compile_one_head_arg(Depth,HeadIs,Self,F,Nth,PT,A,N,C),!, + Nth1 is Nth+1, + compile_head_args(Depth,HeadIs,Self,F,Nth1,ParamTypes,Args,NewArgs,Code),!, + combine_code(C,Code,CCode). +compile_head_args(_Depth,_HeadIs,_Slf,_F,_Nth,[],Args,Args,true). +compile_head_args(_Depth,_HeadIs,_Slf,_F,_Nth,_ParamTypes,[],[],true). + + + +%compile_one_head_arg(_Head, NewArg, Arg, (NewArg=~Arg)):- data_term(Arg),!. +%compile_one_head_arg(_Head, NewArg, Arg, (NewArg=~Arg)):- !. +%compile_one_head_arg(Head, NewArg, Arg, Code):- f2p_assign(10,Head,NewArg,Arg,Code). + +compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,_PT,Arg,NewArg,eval_true(NewArg)):- Arg=='True',!. +compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,_PT,Arg,NewArg,eval_false(NewArg)):- Arg=='False',!. + +compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,N,eval_for(h5,PT,N,A)):- PT\=='Atom', is_list(A),!. +compile_one_head_arg(Depth,HeadIs,Slf,F,Nth,RetType,Arg,NewArgO,CodeOut):- \+ is_list(Arg), + compound(Arg), as_functor_args(Arg,AF,_A,Args), Compile = [AF|Args], !, +compile_one_head_arg(Depth,HeadIs,Slf,F,Nth,RetType,Compile,NewArgO,CodeOut),!. +compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,N,eval_for(h5,PT,N,A)):- PT\=='Atom', is_list(A),!. +compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,N,eval_for(h5,PT,N,A)):- is_list(A),!. +compile_one_head_arg(_Depth,_HeadIs,_Slf,F,Nth,PT,A,N,eval_for(h4(Nth,F),PT,N,A)):- var(PT), var(A),!. +compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,N,eval_for(h3,PT,N,A)):- var(PT), nonvar(A), get_type(A,PT),nonvar(PT),!. +compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,N,once(get_type(A,PT))):- A=N,var(PT), !. +compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,_PT,A,A,true). + + + + + + + + + + + + + + + + + + + + +% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. +compile_fact_for_assert(HeadIs, (Head:-Body)):- + compile_head_for_assert(HeadIs, NewHeadIs,Converted), + optimize_head_and_body(NewHeadIs,Converted,Head,Body). + +head_as_is(Head):- + as_functor_args(Head,Functor,A,_),!, + head_as_is(Functor,A). +head_as_is('If',3). + +rewrite_sym(S,F):- \+ atomic(S),!,F=S. +rewrite_sym(':',F):- var(F),!, 'iz' == F,!. +rewrite_sym(F,F). + +as_functor_args(AsPred,F,A):- + as_functor_args(AsPred,F,A,_ArgsL),!. + +as_functor_args(AsPred,F,A,ArgsL):-var(AsPred),!, + (is_list(ArgsL);(integer(A),A>=0)),!, + length(ArgsL,A), + (symbol(F)->AsPred =..[F|ArgsL]; (AsPred = [F|ArgsL])). + +as_functor_args(AsPred,_,_,_Args):- is_ftVar(AsPred),!,fail. +as_functor_args(AsPred,F,A,ArgsL):- \+ iz_conz(AsPred), + AsPred=..List,!, as_functor_args(List,F,A,ArgsL),!. +%as_functor_args([Eq,R,Stuff],F,A,ArgsL):- (Eq == '='), +% into_list_args(Stuff,List),append(List,[R],AsPred),!, +% as_functor_args(AsPred,F,A,ArgsL). +as_functor_args([F|ArgsL],F,A,ArgsL):- length(ArgsL,A),!. + + + + + +is_f('S'):- fail. +is_mf(','). is_mf(';'). is_mf('call'). +is_lf(':'). + + +s2c(Args,true):- Args==[],!. +s2c(Args,call(Args)):- \+ iz_conz(Args),!. +s2c([F|Args],C):- \+ symbol(F), !, C=[F|Args]. +s2c([F|Args],C):- is_lf(F), !, C=[F|Args]. +s2c([At,F|Args],C):- symbol(F), At== '@', is_list(Args),!,maplist(s2c,Args,ArgsL), compound_name_arguments(C,F,ArgsL). +s2c([F|Args],C):- is_f(F), is_list(Args),!,maplist(s2ca,Args,ArgsL), compound_name_arguments(C,F,ArgsL). +s2c([F|Args],C):- is_mf(F), is_list(Args),!,maplist(s2c,Args,ArgsL), compound_name_arguments(C,F,ArgsL). +s2c([F|Args],C):- is_list(Args),!,maplist(s2ca,Args,ArgsL), compound_name_arguments(C,F,ArgsL). +s2c(C,call(C)). + + +s2ca(Args,Args):- \+ iz_conz(Args),!. +s2ca([H|T],[HH|TT]):- \+ symbol(H), !, s2ca(H,HH),s2ca(T,TT). +s2ca([F|Args],C):- is_lf(F), !, C=[F|Args]. +s2ca([At,F|Args],C):- symbol(F), At== '@', is_list(Args),!,maplist(s2ca,Args,ArgsL), compound_name_arguments(C,F,ArgsL). +s2ca([F|Args],C):- is_f(F), is_list(Args),!,maplist(s2ca,Args,ArgsL), compound_name_arguments(C,F,ArgsL). +s2ca([F|Args],C):- is_mf(F), is_list(Args),!,maplist(s2c,Args,ArgsL), compound_name_arguments(C,F,ArgsL). +s2ca([H|T],[HH|TT]):- s2ca(H,HH),s2ca(T,TT). + + + + + + + + +fix_non_singletons(Args, NewArgs, [Code|Conditions]) :- + sub_term_loc(Var, Args, Loc1), is_nsVar(Var), + sub_term_loc_replaced(==(Var), _Var2, Args, Loc2, ReplVar2, NewArgsM), + Loc1 \=@= Loc2, + Code = same(ReplVar2,Var), + fix_non_singletons(NewArgsM, NewArgs, Conditions),!. +fix_non_singletons(Args, Args, []):-!. + + +sub_term_loc(A,A,self). +sub_term_loc(E,Args,e(N,nth1)+Loc):- is_list(Args),!, nth1(N,Args,ST),sub_term_loc(E,ST,Loc). +sub_term_loc(E,Args,e(N,arg)+Loc):- compound(Args),arg(N,Args,ST),sub_term_loc(E,ST,Loc). + +sub_term_loc_replaced(P1,E,Args,LOC,Var,NewArgs):- is_list(Args), !, sub_term_loc_l(nth1,P1,E,Args,LOC,Var,NewArgs). +sub_term_loc_replaced(P1,E,FArgs,LOC,Var,NewFArgs):- compound(FArgs), \+ is_nsVar(FArgs),!, + compound_name_arguments(FArgs, Name, Args), + sub_term_loc_l(arg,P1,E,Args,LOC,Var,NewArgs), + compound_name_arguments(NewCompound, Name, NewArgs),NewFArgs=NewCompound. + sub_term_loc_replaced(P1,A,A,self,Var,Var):- call(P1,A),!. + + +sub_term_loc_l(Nth,P1,E,Args,e(N,Nth)+Loc,Var,NewArgs):- + reverse(Args,RevArgs), + append(Left,[ST|Right],RevArgs), + sub_term_loc_replaced(P1,E,ST,Loc,Var,ReplaceST), + append(Left,[ReplaceST|Right],RevNewArgs), + reverse(RevNewArgs,NewArgs), + length([_|Right], N),!. + + +% Convert a list of conditions into a conjunction +list_to_conjunction([], true). +list_to_conjunction([Cond], Cond). +list_to_conjunction([H|T], RestConj) :- H==true, + list_to_conjunction(T, RestConj). +list_to_conjunction([H|T], (H, RestConj)) :- + list_to_conjunction(T, RestConj),!. + +fix_equals_in_head(Convert,Convert):- \+ compound(Convert),!. +fix_equals_in_head(Convert:-Vert,Comp:-Vert):-!, + fix_equals_in_head(Convert,Converted), + as_compound_head(Converted,Comp). +fix_equals_in_head(R=C,Converted):- + append_term(C,R,Converted). + +fix_equals_in_head((A:B),iz(A,B)):- !. +fix_equals_in_head(Convert,Convert). + +as_compound_head([F|Converted],Comp):- symbol(F),!,compound_name_arguments(Comp,F,Converted). +as_compound_head(Comp,Comp). + +:- op(700,xfx,'=~'). + + +filter_head_arg(H,F):- var(H),!,H=F. +filter_head_arge(H,F):- H = F. + +code_callable(Term,_CTerm):- var(Term),!,fail. +code_callable(Term, CTerm):- current_predicate(_,Term),!,Term=CTerm. +%code_callable(Term, CTerm):- current_predicate(_,Term),!,Term=CTerm. + +compile_test_then_else(Depth,RetResult,If,Then,Else,Converted):- + f2p(Depth,HeadIs,RetType,ThenResult,Then,ThenCode), + f2p(Depth,HeadIs,RetType,ElseResult,Else,ElseCode), + Converted=(If*->(ThenCode,ThenResult=RetResult); + (ElseCode,ElseResult=RetResult)). + +:- discontiguous(f2q/6). +%:- discontiguous(f2q/6). + + +dif_functors(HeadIs,_):- var(HeadIs),!,fail. +dif_functors(HeadIs,_):- \+ compound(HeadIs),!. +dif_functors(HeadIs,Convert):- compound(HeadIs),compound(Convert), + compound_name_arity(HeadIs,F,A),compound_name_arity(Convert,F,A). + +is_compiled_and(AND):- member(AND,[ /*(','), ('and'),*/ ('and2')]). + +flowc. + +no_lists(Args):- maplist(not_a_function_in_arg,Args). + +not_a_function_in_arg(Arg):- is_ftVar(Arg),!. +not_a_function_in_arg(Arg):- \+ is_list(Arg),!. + + + + + %is_data_functor(F,A),!. +%f2q(_Depth,_HeadIs,_RetType,_RetResult, ie(N=V, Code)) :- !, into_equals(N,V,Code). + +% The catch-all If no specific case is matched, consider Convert as already converted. + +%f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, Code):- into_u_assign(Convert,RetResult,Code). + + + + + +de_eval(u_assign(X),X):- compound(X),!. + +call1(G):- call(G). +call2(G):- call(G). +call3(G):- call(G). +call4(G):- call(G). +call5(G):- call(G). + +trace_break:- trace,break. + +%:- table(u_assign/2). +%u_assign(FList,R):- is_list(FList),!,u_assign(FList,R). +u_assign(FList,R):- var(FList),nonvar(R), !, u_assign(R,FList). +u_assign(FList,R):- FList=@=R,!,FList=R. +u_assign([F|List],[F|R]):- List=R, !. +%u_assign(FList,R):- number(FList), var(R),!,R=FList. +u_assign(FList,R):- \+ compound(FList), var(R),!,R=FList. +u_assign(FList,R):- self_eval(FList), var(R),!,R=FList. +u_assign(FList,RR):- (compound_non_cons(FList),u_assign_c(FList,RR))*->true;FList=~RR. +u_assign(FList,R):- FList =~ R, !. +u_assign(FList,R):- var(FList),!,/*trace,*/freeze(FList,u_assign(FList,R)). +u_assign([F|List],R):- F == ':-',!, trace_break,as_tf(clause(F,List),R). +%u_assign(FList,RR):- u_assign_list1(FList,RR)*->true;u_assign_list2(FList,RR). + +u_assign_list1([F|List],R):- fail,u_assign([F|List],R), nonvar(R), R\=@=[F|List]. +u_assign_list2([F|List],R):- symbol(F),append(List,[R],ListR), + catch(quietly(apply(F,ListR)),error(existence_error(procedure,F/_),_), + catch(quietly(as_tf(apply(F,List),R)),error(existence_error(procedure,F/_),_), + (fail, quietly(catch(u_assign([F|List],R),_, R=[F|List]))))). + +%u_assign([V|VI],[V|VO]):- nonvar(V),is_metta_data_functor(_Eq,V),!,maplist(u_assign,VI,VO). + +u_assign_c((F:-List),R):- !, R = (F:-List). +u_assign_c(FList,RR):- + as_functor_args(FList,F,_), + (catch(quietlY(call(FList,R)),error(existence_error(procedure,F/_),_), + catch(quietlY(as_tf(FList,R)),error(existence_error(procedure,F/_),_), + quietlY((p2m(FList,[F|List]),catch(u_assign([F|List],R),_, R=~[F|List])))))),!,R=RR. +u_assign_c(FList,RR):- as_tf(FList,RR),!. +u_assign_c(FList,R):- compound(FList), !, FList=~R. + +quietlY(G):- call(G). + +call_fr(G,Result,FA):- current_predicate(FA),!,call(G,Result). +call_fr(G,Result,_):- Result=G. + +% This predicate is responsible for converting functions to their equivalent predicates. +% It takes a function 'AsFunction' and determines the predicate 'AsPred' which will be +% equivalent to the given function, placing the result of the function at the 'Nth' position +% of the predicate arguments. The 'Result' will be used to store the result of the 'AsFunction'. +% +% It handles cases where 'AsFunction' is a variable and when it's an symbol or a compound term. +% For compound terms, it decomposes them to get the as_functor_args and arguments and then reconstructs +% the equivalent predicate with the 'Result' at the 'Nth' position. +% +% Example: +% funct_with_result_is_nth_of_pred(HeadIs,+(1, 2), Result, 3, +(1, 2, Result)). +into_callable(Pred,AsPred):- is_ftVar(Pred),!,AsPred=holds(Pred). +into_callable(Pred,AsPred):- Pred=AsPred,!. +into_callable(Pred,AsPred):- iz_conz(Pred), !,AsPred=holds(Pred). +into_callable(Pred,AsPred):- Pred=call_fr(_,_,_),!,AsPred=Pred. +into_callable(Pred,AsPred):- Pred =~ Cons, !,AsPred=holds(Cons). + + +%r2p(MeTTa,Result,IsPred):- r2p(_,MeTTa,Result,IsPred),!. + +%r2p(What,MeTTa,Result,IsPred):- h2p(What,MeTTa,Result,IsPred),!. +%r2p(What,MeTTa,Result,IsPred):- ar2q(What,MeTTa,Result,IsPred),!. + + +%h2p(MeTTa,Result,IsPred):- h2p(_,MeTTa,Result,IsPred). + + +absorbed_default('Bool',_AsPred,'True'). +absorbed_default(_,_AsPred,_). + +is_absorbed_return_value(F,A,Result):- + is_absorbed_return_value(F,A,_,Result). +is_absorbed_return_value(F,A,AsPred,Result):- + is_absorbed_return(F,A,Bool), + absorbed_default(Bool,AsPred,Result). + +h2p(boolean,AsPred,Result,IsPred):- + as_functor_args(AsPred,F,Len,PArgs), + is_absorbed_return_value(F,Len,Result),!, + safe_univ(IsPred,F,PArgs),!. + +h2p(func,AsFunction,Result,IsPred):- + as_functor_args(AsFunction,F,Len,Args), + is_non_absorbed_return(F,Len,_Type), + append(Args,[Result],PArgs), + safe_univ(IsPred,F,PArgs),!. + +h2p(pred,AsPred,Result,IsPred):- + as_functor_args(AsPred,F,Len,PArgs), + is_absorbed_return(F,Len,_Type), + Result = 'True', + cname_var('AbsorbedRetTrue',Result), + safe_univ(IsPred,F,PArgs),!. + +h2p(pred,AsPred,Result,IsPred):- + as_functor_args(AsPred,F,A,PArgs), + always_predicate_in_src(F,A),!, +% once(functional_predicate_arg(F, A, Nth);Nth=A), + %is_absorbed_return(F,A, _Bool), + %nth1(Nth,Args,Result), + Result = 'True', + cname_var('PRetTrue',Result), + safe_univ(IsPred,F,PArgs). + +h2p(func,AsPred,Result,IsPred):- + as_functor_args(AsPred,F,A,Args), + always_function_in_src(F,A), + append(Args,[Result],PArgs), + cname_var('FRet',Result), + safe_univ(IsPred,F,PArgs),!. + +h2p(func,AsPred,Result,IsPred):- + as_functor_args(AsPred,F,_A,Args), + append(Args,[Result],PArgs), + cname_var('Ret',Result), + safe_univ(IsPred,F,PArgs),!. + +safe_univ(IsPred,F,PArgs):- is_list(PArgs),atom(F),!,IsPred=..[F|PArgs]. +safe_univ(IsPred,F,PArgs):- compound(IsPred),var(F),!,IsPred=..[F|PArgs]. +safe_univ(IsPred,F,PArgs):- IsPred=fL(F,PArgs). + +/* + + +h2p(func,AsFunction,Result,IsPred):- + as_functor_args(AsFunction,F,Len,Args), + is_non_absorbed_return(F,Len, _Type), + append(Args,[Result],PArgs), + safe_univ(IsPred,F,PArgs),!. + + +h2p(W,Data,Result,IsPred):- + W\== boolean, + as_functor_args(Data,F,A,_Args), + is_data_functor(F,AA),!, + (AA=A + -> (IsPred = (Data =~ Result)) + ; was_predicate(Data,Result,IsPred)). +h2p(pred,AsPred,Result,IsPred):- + as_functor_args(AsPred,F,A,Args), + always_predicate_in_src(F,A),!, + once(functional_predicate_arg(F, A, Nth);Nth=A), + \+ is_absorbed_return(F,_, _Bool), + nth1(Nth,Args,Result), + IsPred=..[F|Args]. +h2p(func,AsFunction,Result,IsPred):- + as_functor_args(AsFunction,F,A0,FArgs), + \+ is_absorbed_return(F,A0, _Bool), + always_function_in_src(F,A0),!,A is A0 + 1, + once(functional_predicate_arg(F, A, Nth);Nth=A), + nth1(Nth,Args,Result,FArgs), + IsPred=..[F|Args]. +*/ + +ar2q(MeTTa,Result,IsPred):- ar2q(_,MeTTa,Result,IsPred). +ar2q(pred,AsPred,Result,IsPred):- + as_functor_args(AsPred,F,A,Args), + once(functional_predicate_arg(F, A, Nth);Nth=A), + nth1(Nth,Args,Result), + \+ is_absorbed_return(F,_, _Bool), + IsPred=..[F|Args]. +ar2q(funct,AsFunction,Result,IsPred):- + as_functor_args(AsFunction,F,A0,FArgs),A is A0 + 1, + \+ is_absorbed_return(F,_, _Bool), + once(functional_predicate_arg(F, A, Nth);Nth=A), + nth1(Nth,Args,Result,FArgs), + IsPred=..[F|Args]. + +ar2q(pred,AsPred,Result,IsPred):- + as_functor_args(AsPred,F,A,Args), + is_absorbed_return_value(F,A,AsPred,Result), + IsPred=..[F|Args],!. + +was_predicate(AsPred,Result,IsPred):- + as_functor_args(AsPred,F,A,Args), + is_absorbed_return_value(F,A,AsPred,Result), + IsPred=..[F|Args],!. + +was_predicate(AsPred,Result,IsPred):- + as_functor_args(AsPred,F,A,Args), + once(functional_predicate_arg(F, A, Nth);Nth=A), + \+ is_non_absorbed_return(F,A, _Bool), + nth1(Nth,Args,Result), + IsPred=..[F|Args]. + + +was_function(AsFunction,Result,IsPred):- + as_functor_args(AsFunction,F,A0,FArgs), + ( ( \+ is_absorbed_return(F,A0,_)) ; is_non_absorbed_return(F,A0,_)), + A is A0 + 1, + once(functional_predicate_arg(F, A, Nth);Nth=A), + nth1(Nth,Args,Result,FArgs), + IsPred=..[F|Args]. + + +funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, Nth, AsPred):- + var(AsPred),!, + funct_with_result_is_nth_of_pred0(HeadIs,AsFunction, Result, Nth, Pred), + into_callable(Pred,AsPred). + +funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, Nth, AsPred):- + var(AsFunction),!, + funct_with_result_is_nth_of_pred0(HeadIs,Function, Result, Nth, AsPred), + into_callable(Function,AsFunction). + +funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, Nth, AsPred):- + funct_with_result_is_nth_of_pred0(HeadIs,AsFunction, Result, Nth, AsPred). + +% Handles the case where AsFunction is a variable. +% It creates a compound term 'AsPred' and places the 'Result' at the 'Nth' position +% of the predicate arguments, and the 'AsFunction' represents the functional form with +% arguments excluding the result. +funct_with_result_is_nth_of_pred0(_HeadIs,AsFunction, Result, Nth, AsPred) :- + is_nsVar(AsFunction),!, + compound(AsPred), + compound_name_list(AsPred,FP,PredArgs), + nth1(Nth,PredArgs,Result,FuncArgs), + do_predicate_function_canonical(FP,F), + AsFunction =~ [F,FuncArgs]. + +% Handles the case where 'AsFunction' is not a variable. +% It decomposes 'AsFunction' to get the as_functor_args and arguments (FuncArgs) of the function +% and then it constructs the equivalent predicate 'AsPred' with 'Result' at the 'Nth' +% position of the predicate arguments. +funct_with_result_is_nth_of_pred0(HeadIs,AsFunctionO, Result, Nth, (AsPred)) :- + de_eval(AsFunctionO,AsFunction),!,funct_with_result_is_nth_of_pred0(HeadIs,AsFunction, Result, Nth, AsPred). + +funct_with_result_is_nth_of_pred0(HeadIs,AsFunction, Result, _Nth, AsPred) :- + nonvar(AsFunction), + compound(AsFunction), + \+ is_arity_0(AsFunction,_), + as_functor_args(AsFunction,F,A), + HeadIs\=@=AsFunction, + \+ (compound(HeadIs), (is_arity_0(HeadIs,HF);as_functor_args(HeadIs,HF,_))-> HF==F), + (into_u_assign(AsFunction, Result,AsPred) + -> true + ; (AA is A+1, + (FAA=(F/AA)), + \+ current_predicate(FAA), !, + AsPred = call_fr(AsFunction,Result,FAA))). + + +funct_with_result_is_nth_of_pred0(_HeadIs,AsFunction, Result, Nth, (AsPred)) :- + (symbol(AsFunction)->AsFunction =~ [F | FuncArgs]; compound_name_list(AsFunction,F,FuncArgs)), + ignore(var(Nth) -> is_function(AsFunction,Nth); true), + nth1(Nth, PredArgs, Result, FuncArgs), % It places 'Result' at the 'Nth' position + AA is Nth+1, \+ current_predicate(F/AA), + do_predicate_function_canonical(FP,F), + AsPred =~ [FP | PredArgs]. % It forms the predicate 'AsPred' by joining the as_functor_args with the modified arguments list. + + + +funct_with_result_is_nth_of_pred0(_HeadIs,AsFunction, Result, Nth, (AsPred)) :- + nonvar(AsFunction), + AsFunction =~ [F | FuncArgs], + do_predicate_function_canonical(FP,F), + length(FuncArgs, Len), + ignore(var(Nth) -> is_function(AsFunction,Nth); true), + ((number(Nth),Nth > Len + 1) -> (trace,throw(error(index_out_of_bounds, _))); true), + (var(Nth)->(between(1,Len,From1),Nth is Len-From1+1);true), + nth1(Nth,PredArgs,Result,FuncArgs), + AsPred =~ [FP | PredArgs]. + +% optionally remove next line +funct_with_result_is_nth_of_pred0(_HeadIs,AsFunction, _, _, _) :- + var(AsFunction), + throw(error(instantiation_error, _)). + +% The remove_funct_arg/3 predicate is a utility predicate that removes +% the Nth argument from a predicate term, effectively converting a +% predicate to a function. The first argument is the input predicate term, +% the second is the position of the argument to be removed, and the third +% is the output function term. +remove_funct_arg(AsPred, Nth, AsFunction) :- + % Decompose AsPred into its as_functor_args and arguments. + AsPred =~ [F | PredArgs], + % Remove the Nth element from PredArgs, getting the list FuncArgs. + nth1(Nth,PredArgs,_Result,FuncArgs), + % Construct AsFunction using the as_functor_args and the list FuncArgs. + do_predicate_function_canonical(F,FF), + compound_name_list(AsFunction,FF,FuncArgs). + +% deep_lhs_sub_sterm/2 predicate traverses through a given Term +% and finds a sub-term within it. The sub-term is unifiable with ST. +% This is a helper predicate used in conjunction with others to inspect +% and transform terms. + +deep_lhs_sub_sterm(ST, Term):- deep_lhs_sub_sterm0(ST, Term), ST\=@=Term. +deep_lhs_sub_sterm0(_, Term):- never_subterm(Term),!,fail. +deep_lhs_sub_sterm0(ST, Term):- Term =~ if(Cond,_Then,_Else),!,deep_lhs_sub_sterm0(ST, Cond). +deep_lhs_sub_sterm0(ST, Term):- Term =~ 'if-error'(Cond,_Then,_Else),!,deep_lhs_sub_sterm0(ST, Cond). +deep_lhs_sub_sterm0(ST, Term):- Term =~ 'if-decons'(Cond,_Then,_Else),!,deep_lhs_sub_sterm0(ST, Cond). +deep_lhs_sub_sterm0(ST, Term):- Term =~ 'chain'(Expr,_Var,_Next),!,deep_lhs_sub_sterm0(ST, Expr). +deep_lhs_sub_sterm0(ST, Term):- + % If Term is a list, it reverses the list and searches for a member + % in the reversed list that is unifiable with ST. + is_list(Term),!,member(E,Term),deep_lhs_sub_sterm0(ST, E). +deep_lhs_sub_sterm0(ST, Term):- + % If Term is a compound term, it gets its arguments and then recursively + % searches in those arguments for a sub-term unifiable with ST. + compound(Term), compound_name_list(Term,_,Args),deep_lhs_sub_sterm0(ST, Args). +deep_lhs_sub_sterm0(ST, ST):- + % If ST is non-var, not an empty list, and callable, it unifies + % ST with Term if it is unifiable. + nonvar(ST), ST\==[], callable(ST). + +never_subterm(Term):- is_ftVar(Term). +never_subterm([]). +never_subterm('Nil'). +%never_subterm(F):- symbol(F),not_function(F,0). + +% rev_member/2 predicate is a helper predicate used to find a member +% of a list. It is primarily used within deep_lhs_sub_sterm/2 to +% traverse through lists and find sub-terms. It traverses the list +% from the end to the beginning, reversing the order of traversal. +rev_member(E,[_|L]):- rev_member(E,L). +rev_member(E,[E|_]). + +% Continuing from preds_to_functs/2 +% Converts a given predicate representation to its equivalent function representation +preds_to_functs(Convert, Converted):- + % Verbose_unify/1 here may be used for debugging or to display detailed unification information + verbose_unify(Convert), + % Calls the auxiliary predicate preds_to_functs0/2 to perform the actual conversion + preds_to_functs0(Convert, Converted). + +% if Convert is a variable, Converted will be the same variable +preds_to_functs0(Convert, Converted) :- + is_ftVar(Convert), !, + Converted = Convert. + +% Converts the rule (Head :- Body) to its function equivalent +preds_to_functs0((Head:-Body), Converted) :- !, + % The rule is converted by transforming Head to a function AsFunction and the Body to ConvertedBody + ( + pred_to_funct(Head, AsFunction, Result), + cname_var('HEAD_RES',Result), + conjuncts_to_list(Body,List), + reverse(List,RevList),append(Left,[BE|Right],RevList), + compound(BE),arg(Nth,BE,ArgRes),sub_var(Result,ArgRes), + remove_funct_arg(BE, Nth, AsBodyFunction), + append(Left,[u_assign(AsBodyFunction,Result)|Right],NewRevList), + reverse(NewRevList,NewList), + list_to_conjuncts(NewList,NewBody), + preds_to_functs0(NewBody,ConvertedBody), + % The final Converted term is constructed + into_equals(AsFunction,ConvertedBody,Converted)). + +% Handles the case where Convert is a conjunction, and AsPred is not not_function. +% It converts predicates to functions inside a conjunction +preds_to_functs0((AsPred, Convert), Converted) :- + \+ not_function(AsPred), + pred_to_funct(AsPred, AsFunction, Result), + sub_var(Result, Convert), !, + % The function equivalent of AsPred replaces Result in Convert + subst(Convert, Result, AsFunction, Converting), + preds_to_functs0(Converting, Converted). + +% Handles the special case where u_assign/2 is used and returns the function represented by the first argument of u_assign/2 +preds_to_functs0(u_assign(AsFunction, _Result), AsFunction) :- !. + +% Handles the general case where Convert is a conjunction. +% It converts the predicates to functions inside a conjunction +preds_to_functs0((AsPred, Converting), (AsPred, Converted)) :- !, + preds_to_functs0(Converting, Converted). + +% Handles the case where AsPred is a compound term that can be converted to a function +preds_to_functs0(AsPred, u_assign(AsFunction, Result)) :- + pred_to_funct(AsPred, AsFunction, Result), !. + +% any other term remains unchanged +preds_to_functs0(X, X). + +% Converts a given predicate AsPred to its equivalent function term AsFunction +pred_to_funct(AsPred, AsFunction, Result) :- + compound(AsPred), % Checks if AsPred is a compound term + as_functor_args(AsPred, F, A), % Retrieves the as_functor_args F and arity A of AsPred + functional_predicate_arg(F, A, Nth),!, % Finds the Nth argument where the result should be + arg(Nth, AsPred, Result), % Retrieves the result from the Nth argument of AsPred + remove_funct_arg(AsPred, Nth, AsFunction). % Constructs the function AsFunction by removing the Nth argument from AsPred + +% If not found in functional_predicate_arg/3, it tries to construct AsFunction by removing the last argument from AsPred +pred_to_funct(AsPred, AsFunction, Result) :- + compound(AsPred), !, + as_functor_args(AsPred, _, Nth), + arg(Nth, AsPred, Result), + remove_funct_arg(AsPred, Nth, AsFunction). + +% body_member/4 is utility predicate to handle manipulation of body elements in the clause, but the exact implementation details and usage are not provided in the given code. +body_member(Body,BE,NewBE,NewBody):- + conjuncts_to_list(Body,List), + reverse(List,RevList),append(Left,[BE|Right],RevList), + append(Left,[NewBE|Right],NewRevList), + reverse(NewRevList,NewList), + list_to_conjuncts(NewList,NewBody). +% combine_clauses/3 is the main predicate combining clauses with similar heads and bodies. +% HeadBodiesList is a list of clauses (Head:-Body) +% NewHead will be the generalized head representing all clauses in HeadBodiesList +% NewCombinedBodies will be the combined bodies of all clauses in HeadBodiesList. +combine_clauses(HeadBodiesList, NewHead, NewCombinedBodies) :- + % If HeadBodiesList is empty, then NewCombinedBodies is 'false' and NewHead is an anonymous variable. + (HeadBodiesList = [] -> NewCombinedBodies = false, NewHead = _ ; + % Find all Heads in HeadBodiesList and collect them in the list Heads + findall(Head, member((Head:-_), HeadBodiesList), Heads), + % Find the least general head among the collected Heads + least_general_head(Heads, LeastHead), + as_functor_args(LeastHead,F,A),as_functor_args(NewHead,F,A), + % Transform and combine bodies according to the new head found + transform_and_combine_bodies(HeadBodiesList, NewHead, NewCombinedBodies)), + \+ \+ ( + Print=[converting=HeadBodiesList,newHead=NewHead], + numbervars(Print,0,_,[]),fbug(Print), + nop(in_cmt(print_pl_source(( NewHead :- NewCombinedBodies))))),!. + +% Predicate to find the least general unified head (LGU) among the given list of heads. +% Heads is a list of head terms, and LeastGeneralHead is the least general term that unifies all terms in Heads. +least_general_head(Heads, LeastGeneralHead) :- + lgu(Heads, LeastGeneralHead). + +% the LGU of a single head is the head itself. +lgu([Head], Head) :- !. +% find the LGU of the head and the rest of the list. +lgu([H1|T], LGU) :- + lgu(T, TempLGU), + % Find generalization between head H1 and temporary LGU + generalization(H1, TempLGU, LGU). + +% generalization/3 finds the generalization of two heads, Head1 and Head2, which is represented by GeneralizedHead. +% This predicate is conceptual and will require more complex processing depending on the actual structures of the heads. +generalization(Head1, Head2, GeneralizedHead) :- + % Ensure the as_functor_args names and arities are the same between Head1 and Head2. + as_functor_args(Head1, Name, Arity), + as_functor_args(Head2, Name, Arity), + as_functor_args(GeneralizedHead, Name, Arity), + % Generalize the arguments of the heads. + generalize_args(Arity, Head1, Head2, GeneralizedHead). + +% no more arguments to generalize. +generalize_args(0, _, _, _) :- !. +% generalize the corresponding arguments of the heads. +generalize_args(N, Head1, Head2, GeneralizedHead) :- + arg(N, Head1, Arg1), + arg(N, Head2, Arg2), + % If the corresponding arguments are equal, use them. Otherwise, create a new variable. + (Arg1 = Arg2 -> arg(N, GeneralizedHead, Arg1); arg(N, GeneralizedHead, _)), + % Continue with the next argument. + N1 is N - 1, + generalize_args(N1, Head1, Head2, GeneralizedHead). + +% transform_and_combine_bodies/3 takes a list of clause heads and bodies, a new head, and produces a combined body representing all the original bodies. +% The new body is created according to the transformations required by the new head. +transform_and_combine_bodies([(Head:-Body)|T], NewHead, CombinedBodies) :- + % Transform the body according to the new head. + transform(Head, NewHead, Body, TransformedBody), + % Combine the transformed body with the rest. + combine_bodies(T, NewHead, TransformedBody, CombinedBodies). + +/* OLD +% Define predicate combine_clauses to merge multiple Prolog clauses with the same head. +% It receives a list of clauses as input and returns a combined clause. +combine_clauses([Clause], Clause) :- !. % If there's only one clause, return it as is. +combine_clauses(Clauses, (Head :- Body)) :- % If there are multiple clauses, combine them. + Clauses = [(Head :- FirstBody)|RestClauses], % Decompose the list into the first clause and the rest. + combine_bodies(RestClauses, FirstBody, Body). % Combine the bodies of all the clauses. + +% Helper predicate to combine the bodies of a list of clauses. +% The base case is when there are no more clauses to combine; the combined body is the current body. +combine_bodies([], Body, Body). +combine_bodies([(Head :- CurrentBody)|RestClauses], PrevBody, Body) :- + % Combine the current body with the previous body using a conjunction (,). + combine_two_bodies(PrevBody, CurrentBody, CombinedBody), + % Recursively combine the rest of the bodies. + combine_bodies(RestClauses, CombinedBody, Body). + +% Predicate to combine two bodies. +% Handles the combination of different Prolog constructs like conjunctions, disjunctions, etc. +combine_two_bodies((A, B), (C, D), (A, B, C, D)) :- !. % Combine conjunctions. +combine_two_bodies((A; B), (C; D), (A; B; C; D)) :- !. % Combine disjunctions. +combine_two_bodies(A, B, (A, B)). % Combine simple terms using conjunction. +*/ + +% if there are no more bodies, the accumulated Combined is the final CombinedBodies. +combine_bodies([], _, Combined, Combined). +% combine the transformed body with the accumulated bodies. +combine_bodies([(Head:-Body)|T], NewHead, Acc, CombinedBodies) :- + transform(Head, NewHead, Body, TransformedBody), + % Create a disjunction between the accumulated bodies and the transformed body. + NewAcc = (Acc;TransformedBody), + combine_bodies(T, NewHead, NewAcc, CombinedBodies). + +% combine_code/3 combines Guard and Body to produce either Guard, Body, or a conjunction of both, depending on the values of Guard and Body. +combine_code(Guard, Body, Guard) :- Body==true, !. +combine_code(Guard, Body, Body) :- Guard==true, !. +combine_code((A,B,C), Body, Out):- combine_code(C,Body,CBody),combine_code(B,CBody,BCBody),combine_code(A,BCBody,Out). +combine_code((AB,C), Body, Out):- combine_code(C,Body,CBody),combine_code(AB,CBody,Out). +combine_code(Guard, Body, (Guard, Body)). + + +combine_code([A|Nil],O):- Nil==[],!,combine_code(A,O). +combine_code([A|B],O):- \+ is_list(B),combine_code(A,AA),combine_code(B,BB),!, + combine_code([AA,BB],O). +combine_code([A,B|C],O):- \+ is_list(B), + combine_code(A,AA),combine_code(B,BB),!, + combine_code(AA,BB,AB), + combine_code([AB|C],O),!. +combine_code((A;O),(AA;OO)):- !, combine_code(A,AA),combine_code(O,OO). +combine_code(AO,AO). + + + +% create_unifier/3 creates a unification code that unifies OneHead with NewHead. +% If OneHead and NewHead are structurally equal, then they are unified and the unification Guard is 'true'. +% Otherwise, the unification code is 'metta_unify(OneHead,NewHead)'. + +create_unifier(OneHead,NewHead,Guard):- OneHead=@=NewHead,OneHead=NewHead,!,Guard=true. +create_unifier(OneHead,NewHead,Guard):- compound(OneHead), + compound_name_list(OneHead,_,Args1), + compound_name_list(NewHead,_,Args2), + create_unifier_goals(Args1,Args2,Guard),!. +create_unifier(OneHead,NewHead,u(OneHead,NewHead)). + +create_unifier_goals([V1],[V2],u(V1,V2)):-!. +create_unifier_goals([V1|Args1],[V2|Args2],RightGuard):-!, + create_unifier_goals(Args1,Args2,Guard), + combine_code(u(V1,V2),Guard,RightGuard). +create_unifier_goals([],[],true). + + +% transform/4 combines unification code with Body to produce NewBody according to the transformations required by NewHead. +% It uses create_unifier/3 to generate the unification code between OneHead and NewHead. +transform(OneHead, NewHead, Body, NewBody):- create_unifier(OneHead,NewHead,Guard), + combine_code(Guard,Body,NewBody). + + +unnumbervars_clause(Cl,ClU):- + copy_term_nat(Cl,AC),unnumbervars(AC,UA),copy_term_nat(UA,ClU). +% =============================== +% Compile in memory buffer +% =============================== +is_clause_asserted(AC):- unnumbervars_clause(AC,UAC), + expand_to_hb(UAC,H,B),clause(H,B,Ref),clause(HH,BB,Ref), + strip_m(HH,HHH),HHH=@=H, + strip_m(BB,BBB),BBB=@=B,!. + +strip_m(M:BB,BB):- nonvar(BB),nonvar(M),!. +strip_m(BB,BB). + +get_clause_pred(UAC,F,A):- expand_to_hb(UAC,H,_),strip_m(H,HH),functor(HH,F,A). + +:- dynamic(needs_tabled/2). + +add_assertion(Space,List):- is_list(List),!,maplist(add_assertion(Space),List). +add_assertion(Space,AC):- unnumbervars_clause(AC,UAC), add_assertion1(Space,UAC). +add_assertion1(_,AC):- /*'&self':*/is_clause_asserted(AC),!. +add_assertion1(_,AC):- get_clause_pred(AC,F,A), \+ needs_tabled(F,A), !, pfcAdd(/*'&self':*/AC),!. + +add_assertion1(_KB,ACC) :- + copy_term(ACC,AC,_), + expand_to_hb(AC,H,_), + as_functor_args(H,F,A), as_functor_args(HH,F,A), + % assert(AC), + % Get the current clauses of my_predicate/1 + findall(HH:-B,clause(/*'&self':*/HH,B),Prev), + copy_term(Prev,CPrev,_), + % Create a temporary file and add the new assertion along with existing clauses + append(CPrev,[AC],NewList), + cl_list_to_set(NewList,Set), + length(Set,N), + if_t(N=2, + (Set=[X,Y], + numbervars(X), + numbervars(Y), + nl,display(X), + nl,display(Y), + nl)), + %wdmsg(list_to_set(F/A,N)), + abolish(/*'&self':*/F/A), + create_and_consult_temp_file(F/A, Set). + + +cl_list_to_set([A|List],Set):- + member(B,List),same_clause(A,B),!, + cl_list_to_set(List,Set). +cl_list_to_set([New|List],[New|Set]):-!, + cl_list_to_set(List,Set). +cl_list_to_set([A,B],[A]):- same_clause(A,B),!. +cl_list_to_set(List,Set):- list_to_set(List,Set). + +same_clause(A,B):- A==B,!. +same_clause(A,B):- A=@=B,!. +same_clause(A,B):- unnumbervars_clause(A,AA),unnumbervars_clause(B,BB),same_clause1(AA,BB). +same_clause1(A,B):- A=@=B. +same_clause1(A,B):- expand_to_hb(A,AH,AB),expand_to_hb(B,BH,BB),AB=@=BB, AH=@=BH,!. + +%clause('is-closed'(X),OO1,Ref),clause('is-closed'(X),OO2,Ref2),Ref2\==Ref, OO1=@=OO2. + +% Predicate to create a temporary file and write the tabled predicate +create_and_consult_temp_file(F/A, PredClauses) :- + % Generate a unique temporary memory buffer + tmp_file_stream(text, TempFileName, TempFileStream), + % Write the tabled predicate to the temporary file + format(TempFileStream, ':- multifile((~q)/~w).~n', [F, A]), + format(TempFileStream, ':- dynamic((~q)/~w).~n', [F, A]), + %if_t( \+ option_value('tabling',false), + if_t(option_value('tabling','True'),format(TempFileStream,':- ~q.~n',[table(F/A)])), + maplist(write_clause(TempFileStream), PredClauses), + % Close the temporary file + close(TempFileStream), + % Consult the temporary file + % abolish(F/A), + /*'&self':*/consult(TempFileName), + % Delete the temporary file after consulting + %delete_file(TempFileName), + true. + + +% Helper predicate to write a clause to the file +write_clause(Stream, Clause) :- + subst_vars(Clause,Can), + write_canonical(Stream, Can), + write(Stream, '.'), + nl(Stream). + +same(X,Y):- X =~ Y. + + +end_of_file. + + + + % If any sub-term of Convert is a control flow imperative, convert that sub-term and then proceed with the conversion. + f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- fail, + % Get the least deepest sub-term AsFunction of Convert + get_first_p1(AsFunction,Convert,N1Cmpd), + arg(2,N1Cmpd,Cmpd), + Cmpd \= ( ==(_,_) ), + (Cmpd = [EE,_,_] -> (EE \== '==') ; true ), + AsFunction\=@= Convert, + callable(AsFunction), % Check if AsFunction is callable + Depth2 is Depth -0, + % check that that is is a control flow imperative + f2q(Depth2,HeadIs,RetType,Result,AsFunction, AsPred), + HeadIs\=@=AsFunction,!, + subst(Convert, AsFunction, Result, Converting), % Substitute AsFunction by Result in Convert + f2p(Depth2,HeadIs,RetType,RetResult,(AsPred,Result==AsFunction,Converting), Converted). % Proceed with the conversion of the remaining terms + + + % If any sub-term of Convert is a control flow imperative, convert that sub-term and then proceed with the conversion. + f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- fail, + deep_lhs_sub_sterm(AsFunction, Convert), + AsFunction\=@= Convert, + % Get the deepest sub-term AsFunction of Convert + % sub_term(AsFunction, Convert), AsFunction\==Convert, + callable(AsFunction), % Check if AsFunction is callable + Depth2 is Depth -0, + f2q(Depth2,HeadIs,RetType,Result,AsFunction, AsPred), + HeadIs\=@=AsFunction,!, + subst(Convert, AsFunction, Result, Converting), % Substitute AsFunction by Result in Convert + f2p(Depth2,HeadIs,RetType,RetResult,(AsPred,Converting), Converted). % Proceed with the conversion of the remaining terms + + % If any sub-term of Convert is a function, convert that sub-term and then proceed with the conversion. + f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- fail, + deep_lhs_sub_sterm(AsFunction, Convert), % Get the deepest sub-term AsFunction of Convert + AsFunction\=@= Convert, + callable(AsFunction), % Check if AsFunction is callable + %is_function(AsFunction, Nth), % Check if AsFunction is a function and get the position Nth where the result is stored/retrieved + HeadIs\=@=AsFunction, + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, AsPred), % Convert AsFunction to a predicate AsPred + subst(Convert, AsFunction, Result, Converting), % Substitute AsFunction by Result in Convert + f2p(Depth,HeadIs,RetType,RetResult, (AsPred, Converting), Converted). % Proceed with the conversion of the remaining terms + /* + % If AsFunction is a recognized function, convert it to a predicate. + f2q(Depth,HeadIs,RetType,RetResult,AsFunction,AsPred):- % HeadIs\=@=AsFunction, + is_function(AsFunction, Nth), % Check if AsFunction is a recognized function and get the position Nth where the result is stored/retrieved + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, RetResult, Nth, AsPred), + \+ ( compound(AsFunction), arg(_,AsFunction, Arg), is_function(Arg,_)),!. + */ + + % If any sub-term of Convert is an u_assign/2, convert that sub-term and then proceed with the conversion. + f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- fail, + deep_lhs_sub_sterm0(ConvertFunction, Convert), % Get the deepest sub-term AsFunction of Convert + callable(ConvertFunction), % Check if AsFunction is callable + ConvertFunction = u_assign(AsFunction,Result), + ignore(is_function(AsFunction, Nth)), + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, Nth, AsPred), % Convert AsFunction to a predicate AsPred + subst(Convert, ConvertFunction, Result, Converting), % Substitute AsFunction by Result in Convert + f2p(Depth,HeadIs,RetType,RetResult, (AsPred, Converting), Converted). % Proceed with the conversion of the remaining terms + diff --git a/.Attic/canary_docme/metta_compiler_inlining.pl b/.Attic/canary_docme/metta_compiler_inlining.pl new file mode 100644 index 00000000000..851ad26246c --- /dev/null +++ b/.Attic/canary_docme/metta_compiler_inlining.pl @@ -0,0 +1,981 @@ + + +eval_for(_,Var,B,C):- var(Var),!, B=C. +eval_for(_, _, B, C):- B==C,!. +eval_for(b_C, A, B, C):- !, eval_for1(b_C,A,B,C), \+ \+ ((get_type(C,CT),can_assign(CT,A))). +eval_for(Why, A, B, C):- eval_for1(Why,A,B,C). + +eval_for1(_Why,_,B,C):- \+ callable(B),!, B= C. +eval_for1(_Why,_,B,C):- compound(B),compound(C),B=C,!. +eval_for1(_Why,'Any',B,C):- !, eval(B,C). +eval_for1(_Why,'AnyRet',B,C):- !, eval(B,C). +eval_for1(b_6,'Atom',B,C):- !, eval(B,C). +eval_for1(_,'Atom',B,C):- !, B=C. +eval_for1(_Why,A,B,C):- eval_for(A,B,C). + +why_call(_,Goal):- %println(Y),trace, + call(Goal). + + +u_assign1(B,C):- u_assign5(B,C). +u_assign2(B,C):- u_assign5(B,C). +u_assign3(B,C):- u_assign5(B,C). +u_assign4(B,C):- u_assign5(B,C). +u_assign6(B,C):- u_assignI(B,C). +u_assign7(B,C):- u_assignI(B,C). +u_assign8(B,C):- u_assign5(B,C). +u_assign9(B,C):- u_assign5(B,C). +u_assignA(B,C):- u_assign5(B,C). +u_assignB(B,C):- u_assign5(B,C). +u_assignC(B,C):- u_assign5(B,C). +u_assign5(B,C):- \+ compound(B),!,B=C. +u_assign5(B,C):- u_assignI(B,C). + +u_assignI(B,C):- var(B),!,B=C. +u_assignI(B,C):- u_assign(B,C). + +:- op(700,xfx,'=~'). + +:- discontiguous f2q/6. + + +f2p(RetResult,Convert, Converted):- + f2p(my_head,_ANY_,RetResult,Convert, Converted). + +f2p(HeadIs,RetResult,Convert, Converted):- + f2p(HeadIs,_ANY_,RetResult,Convert, Converted),!. + +f2p(HeadIs,RetType,RetResult,Convert, Converted):- + f2p(40,HeadIs,RetType,RetResult,Convert, Converted). + +f2p(Depth,HeadIs,RetType,RetResult,Convert, Converted):- + Depth2 is Depth-1, + f2q(Depth2,HeadIs,RetType,RetResult,Convert, Converting), + convert_fromi(Depth2,Converting, Converted),!. + +%f2p(_Depth,_HeadIs,_RetType,RetResult,Convert, eval(Convert,RetResult)). + + +convert_fromi(_Depth,Converted, Converted):- !. +convert_fromi(_Depth,Converted, Converted):- is_ftVar(Converted),!. +convert_fromi(_Depth,Converted, Converted):- \+ compound(Converted),!. +%convert_fromi(_Depth, u_assign(E,R), UA):- !, u_assign(E,R)=UA. +convert_fromi(Depth,(A,B), (AA,BB)):- !, convert_fromi(Depth,A,AA), convert_fromi(Depth,B,BB). +convert_fromi(Depth,Converting, Converted):- is_list(Converting),!,maplist(convert_fromi(Depth),Converting, Converted). +convert_fromi(Depth,Converting, Converted):- compound_name_arguments(Converting,F,Args),!, + maplist(convert_fromi(Depth),Args, NewArgs),!, + compound_name_arguments(Converted,F,NewArgs). + +%convert_fromi(Depth,Converting, Converted):- f2q(Depth,Converting, Converted). +is_fqVar(Var2):- is_ftVar(Var2),!. +is_fqVar(Var2):- symbol(Var2),!. + + +%f2q(_Depth,_HeadIs,RetType,Var1, Var2, ((Var1=Var2))):- +% is_fqVar(Var1),is_fqVar(Var2),!. + + +f2q(_Depth,_HeadIs, RetType,RetVar, Convert, true) :- + is_ftVar(RetVar),is_ftVar(RetType),is_ftVar(Convert), + RetVar=Convert,!. % Check if Convert is a variable + +f2q(_Depth,_HeadIs, RetType,RetVar, Convert, eval_for(b_C,RetType,Convert,RetVar)) :- + is_ftVar(Convert),!.% Check if Convert is a variable + +f2q(_Depth,_HeadIs,RetType,RetVar, [C|Convert], eval_for(b_B,RetType,[C|Convert],RetVar)) :- + is_ftVar(C),!.% Check if Convert is a variable + +f2q(Depth,HeadIs,RetType,RetResult, eval(Convert), Code):- !, + DepthM1 is Depth-1, f2q(DepthM1,HeadIs,RetType,RetResult, Convert, Code). + + + +f2q(_Depth,_HeadIs,_RetType,_RetResult, u_assign(E,R), UA):- !, + u_assign2(E,R)=UA. + +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, Converted) :- % HeadIs\=@=Convert, + is_arity_0(Convert,F), !, Converted = u_assign3([F],RetResult),!. + +% If Convert is a ":-" (if) function, we convert it to the equivalent ":-" (if) predicate. +f2q(_Depth,_HeadIs,RetType,RetResult, Convert, true) :- ignore(RetType='Atom'), + (Convert = (H:-B)), + (RetResult= (H:-B)). + + +get_ret_type([F|Args],RetType):- is_list(Args),!, + ((length(Args,Len),(PL = Len ; PL is Len + 1 ; PL is Len - 1), + PL>=0, + length(Params,PL), + get_operator_typedef1(_Self,F,Params,RetType), + RetType \== 'RetAny')*->true;RetType=_/*'%Undefined%'*/). +get_ret_type(F,RetType):- get_type(F,RetType). + + +f2q(Depth,HeadIs,RetType,RetVar, Data, CodeOut):- var(RetType), nonvar(Data), + get_ret_type(Data,PRT),nonvar(PRT),!,RetType=PRT, + f2q(Depth,HeadIs,RetType,RetVar, Data, CodeOut). + +f2q(Depth,HeadIs,RetType,RetVar, Data, CodeOut):- var(RetType), nonvar(RetVar), + get_ret_type(RetVar,PRT),nonvar(PRT),!,RetType=PRT, + f2q(Depth,HeadIs,RetType,RetVar, Data, CodeOut). + +f2q(Depth,HeadIs,RetType,RetVal,Convert,Code):- + compound_non_cons(Convert),into_list_args(Convert,ConvertL), + f2q(Depth,HeadIs,RetType,RetVal,ConvertL,Code),!. + +f2q(Depth,HeadIs,RetType,C,Convert,CodeOut):- + Convert =~ ['-',A,B], + f2p(Depth,HeadIs,RetType,NewA, A, ACodeOut), + f2p(Depth,HeadIs,RetType,NewB, B, BCodeOut), + combine_code([ACodeOut,BCodeOut,'-'(NewA,NewB,C)],CodeOut). + +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert,eval_true(Convert)):- fail, + %nl,print(Convert),nl, + as_functor_args(Convert,F,A,Args), + \+ (member(Arg,Args),(is_list(Arg);compound(Arg))), + is_absorbed_return_value(F,A,RResult), + RResult=RetResult. + +f2q(Depth,_HeadIs,_RetType,RetResult, Convert, u_assign4(Convert,RetResult)) :- Depth=<0,!. + +f2q(_Depth,_HeadIs,_RetType,RetResult, Convert, true) :- + (number(Convert)),RetResult=Convert,!.% Check if Convert is a ... + + +% If Convert is a number or an symbol, it is considered as already converted. +f2q(_Depth,_HeadIs,_RetType,RetResult, Convert, why_call(is_data, Convert = RetResult )) :- % HeadIs,RetType\=@=Convert, + once(number(Convert); symbol(Convert); data_term(Convert)), % Check if Convert is a number or an symbol + !. % Set RetResult to Convert as it is already in predicate form + +data_term(Convert):- \+ compound(Convert), + self_eval(Convert),!, + (iz_conz(Convert) ; \+ compound(Convert)). + +f2q(_Depth,_HeadIs,_RetType,RetResult, Convert, (RetResult =~ Convert)) :- data_term(Convert),!.% Check if Convert is a ... + +f2q(_Depth,_HeadIs,_RetType,RetResult, Convert, true) :- + (data_term(Convert)),RetResult=Convert,!.% Check if Convert is a ... + +% If Convert is a variable, the corresponding predicate is just u_assign(Convert, RetResult) +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, RetResultConverted) :- + is_ftVar(Convert),!,% Check if Convert is a variable + into_equals(RetResult,Convert,RetResultConverted). + % Converted = u_assign(Convert, RetResult). % Set Converted to u_assign(Convert, RetResult) + +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, RetResultConverted) :- + number(Convert),!,into_equals(RetResult,Convert,RetResultConverted). + +% If Convert is a "," (and) function, we convert it to the equivalent "," (and) predicate. +f2q(Depth,HeadIs,_RetType,RetResult,SOR,CC) :- + SOR =~ [LogOp, AsPredI, Convert], ',' == LogOp, + RetResult = [LogOp,RetResult1, RetResult2], + must_det_ll((f2p(Depth,HeadIs,_RetType1,RetResult1,AsPredI, AsPredO), + f2p(Depth,HeadIs,_RetType2,RetResult2,Convert, Converted))),!, + combine_code(AsPredO,Converted,CC). + + + f2q(Depth,HeadIs,RetType,RetResult,SOR,(AsPredO,Converted)) :- + SOR =~ [LogOp, AsPredI, Convert], 'and' == LogOp,!, + must_det_ll((f2p(Depth,HeadIs,'Bool','True',AsPredI, AsPredO), + f2p(Depth,HeadIs,RetType,RetResult,Convert, Converted))),!. + +f2q(Depth,HeadIs,RetType,RetResult,SOR,CC) :- + SOR =~ [LogOp, AsPredI, Convert], 'and' == LogOp, + %RetType = 'Bool', RetResultB = 'True', RetResultA = 'True', + must_det_ll((f2p(Depth,HeadIs,RetTypeA,RetResultA,AsPredI, AsPredO), + f2p(Depth,HeadIs,RetTypeB,RetResultB,Convert, Converted))),!, + combine_code([ AsPredO, RetResult=RetResultA, Converted, + why_call(merge_rettypes,narrow_types([RetTypeA,RetTypeB],RetType)), + why_call(same_result,RetResultA==RetResultB), + why_call(return_val,RetResult=RetResultB)],CC). + + f2q(Depth,HeadIs,RetType,RetResult,SOR,(AsPredO;Converted)) :- + SOR =~ [LogOp, AsPredI, Convert], 'or' == LogOp,!, + must_det_ll((f2p(Depth,HeadIs,RetType,RetResult,AsPredI, AsPredO), + f2p(Depth,HeadIs,RetType,RetResult,Convert, Converted))),!. + + + +f2q(Depth,HeadIs,RetType,RetResult,SOR,CC) :- + SOR =~ [LogOp, AsPredI, Convert], 'or' == LogOp, + % RetType = 'Bool', + %RetResultB = 'True', RetResultA = 'True', + must_det_ll((f2p(Depth,HeadIs,RetTypeA,RetResultA,AsPredI, AsPredO), + f2p(Depth,HeadIs,RetTypeB,RetResultB,Convert, Converted))),!, + combine_code(( AsPredO, RetResult=RetResultA,RetType=RetTypeA); + (Converted,RetResult=RetResultB,RetType=RetTypeB),CC). + + +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, eval(Convert,RetResult)):- fail, + interpet_this(Convert),!. + +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert,Converted) :- fail, % dif_functors(HeadIs,Convert), + Convert =~ [H|_], \+ symbol(H), \+ is_non_evaluatable(H), + Converted = (Convert=RetResult),!. + +f2q(Depth,HeadIs,RetType,Atom,Convert,Converted) :- + Convert=~ match(Space,Q,T),Q==T,Atom=Q,!, + f2p(Depth,HeadIs,RetType,Atom,'get-atoms'(Space),Converted). + +f2q(Depth,HeadIs,_RetType,AtomsVar,Convert,Converted) :- + Convert=~ 'get-atoms'(Space), Pattern = AtomsVar, + compile_pattern(Depth,HeadIs,Space,Pattern,Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert,Converted) :- %dif_functors(HeadIs,Convert), + Convert =~ 'match'(ESpace,Pattern,Template),!, + must_det_ll(( + f2p(Depth,HeadIs,_SpaceT,SpaceV,ESpace,Code), + %term_variables(Template,TemplateVars), + compile_pattern(Depth,HeadIs,SpaceV,Pattern,SpacePatternCode), + f2p(Depth,HeadIs,RetType,RetResult,Template,TemplateCode), + combine_code((Code,SpacePatternCode),TemplateCode,Converted))). + + compile_pattern(_Depth,_HeadIs,Space,Pattern,SpaceMatchCode):- + SpaceMatchCode = metta_atom_iter(Space,Pattern). + + +/* + f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- dif_functors(HeadIs,Convert), + Convert =~ 'match'(_Space,Match,Template),!, + must_det_ll(( + f2p(Depth,HeadIs,RetType,_,Match,MatchCode), + into_equals(RetResult,Template,TemplateCode), + combine_code(MatchCode,TemplateCode,Converted))). +*/ + + +interpet_this(_Convert):-!, fail. + +interpet_this(Convert):- as_functor_args(Convert,F,A,Args), interpet_this(Convert,F,A,Args). +interpet_this(_,F,_,_):- \+ symbolic(F),!. +interpet_this(_,F,_,_):- compile_this_s(F),!,fail. +interpet_this(_,F,_,_):- interpet_this_f(F),!. +% stable workarround until the '=~' bug is fixed for numbers +interpet_this(Convert,F,A,Args):- compile_this(Convert,F,A,Args),!,fail. +interpet_this(_,_,_,_). + +interpet_this_f(_Convert):-!, fail. +interpet_this_f(F):- metta_atom_file_buffer_isa(F,'Compiled'),!,fail. +interpet_this_f(F):- metta_atom_file_buffer_isa(F,'Interpreted'),!. +interpet_this_f(F):- op_decl(F, [ 'Number', 'Number' ], 'Number'). + +compile_this(_):-!. +compile_this(Convert):- as_functor_args(Convert,F,A,Args), compile_this(Convert,F,A,Args). +compile_this(_,F,_,_):- \+ symbolic(F),!, fail. +compile_this(_,F,_,_):- compile_this_f(F),!. + + compile_this_f(_):-!. +compile_this_f(F):- metta_atom_file_buffer_isa(F,'Compiled'). +compile_this_f(F):- interpet_this_f(F),!,fail. +compile_this_f(F):- compile_this_s(F),!. +compile_this_f(F):- metta_atom_file_buffer([':',F,[Ar|_]]), Ar=='->', !. +compile_this_s('superpose'). +compile_this_s('match'). +compile_this_s('do'). +compile_this_s('do-all'). + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- fail, dif_functors(HeadIs,Convert), + get_inline_def(Convert,NewDef),!, + must_det_ll((f2p(Depth,HeadIs,RetType,RetResult,NewDef,Converted))). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, do(Converted)) :- % dif_functors(HeadIs,Convert), + Convert =~ ['do',Body],!, + ignore(RetResult='Empty'), + f2p(Depth,HeadIs,RetType,_RetResult,Body, Converted). + +f2q(Depth,HeadIs,_RetTypeD,RetResult,Convert, (doall(Converted),RetResult='Empty')) :- % dif_functors(HeadIs,Convert), + Convert =~ ['do-all',Body],!, + f2p(Depth,HeadIs,_RetTypeB,_RetResultB,Body, Converted). + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ ['let',Var,Value1,Body],!, + f2p(Depth,HeadIs,_,ResValue1,Value1,CodeForValue1), + into_equals(Var,ResValue1,CodeEquals), + f2p(Depth,HeadIs,RetType,RetResult,Body,BodyCode), + combine_code([CodeForValue1,CodeEquals,BodyCode],Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ ['let',Var,Value1,Body],!, + f2p(Depth,HeadIs,_,Var,Value1, BindingCode), + f2p(Depth,HeadIs,RetType,RetResult,Body, BodyCode), + combine_code(BindingCode,BodyCode,Converted). + +is_Nil(Nil):- Nil==[],!. +is_Nil(Nil):- Nil=='Nil',!. +is_Nil(Nil):- Nil=='()',!. + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- %dif_functors(HeadIs,Convert), + Convert =~ ['let*',Nil,Body],is_Nil(Nil), !, + must_det_ll((f2p(Depth,HeadIs,RetType,RetResult,Body, Converted))). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- %dif_functors(HeadIs,Convert), + Convert =~ ['let*',AAAA,Body],AAAA=~[VE|Bindings],VE=~[V,E], + f2q(Depth,HeadIs,RetType,RetResult,['let',V,E,['let*',Bindings,Body]], Converted). + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- fail, dif_functors(HeadIs,Convert), + Convert =~ ['let*',Bindings,Body],!, + must_det_ll(( + maplist(compile_let_star(Depth,HeadIs,RetType),Bindings,CodeList), + combine_code(CodeList,BindingCode), + f2p(Depth,HeadIs,RetType,RetResult,Body,BodyCode), + combine_code(BindingCode,BodyCode,Converted))). + +compile_let_star(Depth,HeadIs,RetType,NV,Converted):- + must_det_ll((NV =~ [Expression,Var], + (var(Var)-> f2p(Depth,HeadIs,RetType,Var,Expression,Converted); + (var(Expression)-> f2p(Depth,HeadIs,RetType,Expression,Var,Converted); + (f2p(Depth,HeadIs,RetType,Eval1Result,Expression,Code), + into_equals(Eval1Result,Var,Eval1ResultVar), + combine_code(Code,Eval1ResultVar,Converted)))))),!. + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- + Convert =~ ['superpose',COL],compound_equals(COL,'collapse'(Value1)), !, + f2p(Depth,HeadIs,RetType,ResValue1,Value1,CodeForValue1), + Converted = (find_ne(ResValue1,CodeForValue1,Gathered),member(RetResult,Gathered)). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- + Convert =~ ['sequential'|ValueL], + ReConvert =~ ['superpose'|ValueL],!, + f2q(Depth,HeadIs,RetType,RetResult,ReConvert, Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, (Converted)) :- + Convert =~ ['sequential',ValueL],is_list(ValueL),!, + %maybe_unlistify(UValueL,ValueL,URetResult,RetResult), + maplist(f2p_assign(Depth,HeadIs,RetType),RetResultL,ValueL,CodeForValueL), + last(RetResultL,RetResult), + combine_code(CodeForValueL,Converted),!. + +f2q(Depth,HeadIs,RetType,RetResult,Convert, (Converted)) :- + Convert =~ ['superpose',ValueL],is_list(ValueL),!, + %maybe_unlistify(UValueL,ValueL,URetResult,RetResult), + must_det_ll(( ignore(cname_var('SP_Ret',RetResult)), + maplist(f2p(Depth,HeadIs,RetType,RetResult),ValueL,CodeForValueL), + list_to_disjuncts(CodeForValueL,Converted))),!. + +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, (Converted)) :- + Convert =~ ['superpose',ValueL],is_nsVar(ValueL),!, + %maybe_unlistify(UValueL,ValueL,URetResult,RetResult), + Converted = call('superpose'(ValueL,RetResult)), + cname_var('MeTTa_SP_',ValueL). + + +:- op(700,xfx, =~). +f2q(Depth,HeadIs,RetType,RetResult,Convert, (Code1,Eval1Result=Result,Converted)) :- % dif_functors(HeadIs,Convert), + Convert =~ 'chain'(Eval1,Result,Eval2),!, + f2p(Depth,HeadIs,RetType,Eval1Result,Eval1,Code1), + f2p(Depth,HeadIs,RetType,RetResult,Eval2,Converted). + +f2q(Depth,HeadIs,RetType,ResValue2,Convert, (CodeForValue1,Converted)) :- % dif_functors(HeadIs,Convert), + Convert =~ ['eval-in-space',Value1,Value2], + f2p(Depth,HeadIs,RetType,ResValue1,Value1,CodeForValue1), + f2p(Depth,HeadIs,RetType,ResValue2,Value2,CodeForValue2), + Converted = with_space(ResValue1,CodeForValue2). + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + once(Convert =~ 'if'(Cond,Then,Else);Convert =~ 'If'(Cond,Then,Else)), + !,Test = is_True(CondResult), + f2p(Depth,HeadIs,RetType,CondResult,Cond,CondCode), + compile_test_then_else(Depth,RetResult,(CondCode,Test),Then,Else,Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- dif_functors(HeadIs,Convert), + once(Convert =~ 'if'(Cond,Then);Convert =~ 'If'(Cond,Then)), + f2p(Depth,HeadIs,RetType,CondResult,Cond,CondCode), + f2p(Depth,HeadIs,RetType,RetResult,Then,ThenCode), + combine_code([CondCode,is_True(CondResult),ThenCode],Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ 'if-error'(Value,Then,Else),!,Test = is_Error(ValueResult), + f2p(Depth,HeadIs,RetType,ValueResult,Value,ValueCode), + combine_code(ValueCode,Test,ValueCodeTest), + compile_test_then_else(Depth,RetResult,ValueCodeTest,Then,Else,Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ 'if-empty'(Value,Then,Else),!,Test = is_Empty(ValueResult), + f2p(Depth,HeadIs,RetType,ValueResult,Value,ValueCode), + compile_test_then_else(Depth,RetResult,(ValueCode,Test),Then,Else,Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + (Convert =~ 'if-non-empty-expression'(Value,Then,Else)),!, + (Test = ( \+ is_Empty(ValueResult))), + f2p(Depth,HeadIs,RetType,ValueResult,Value,ValueCode), + compile_test_then_else(Depth,RetResult,(ValueCode,Test),Then,Else,Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ ['if-equals',Value1,Value2,Then,Else],!,Test = equal_enough(ResValue1,ResValue2), + f2p(Depth,HeadIs,RetType,ResValue1,Value1,CodeForValue1), + f2p(Depth,HeadIs,RetType,ResValue2,Value2,CodeForValue2), + compile_test_then_else(Depth,RetResult,(CodeForValue1,CodeForValue2,Test),Then,Else,Converted). + +cname_var(Sym,_Src):- var(Sym),!. +cname_var(Sym,Src):- var(Src),!,must_det_ll((gensym(Sym,SrcV),Src='$VAR'(SrcV))). +cname_var(Sym,Src):- Src='$VAR'(_),!,must_det_ll((gensym(Sym,SrcV),nb_setarg(1,Src,SrcV))). +cname_var(_Sym,_Src). +cname_var(Name=Var):- cname_var(Name,Var). +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- + Convert =~ ['assertEqual',Value1,Value2],!, + cname_var('Src_',Src), + cname_var('FA_',ResValue1), + cname_var('FA_',ResValue2), + cname_var('FARL_',L1), + cname_var('FARL_',L2), + f2p(Depth,HeadIs,RetType,ResValue1,Value1,CodeForValue1), + f2p(Depth,HeadIs,RetType,ResValue2,Value2,CodeForValue2), + Converted = + (Src = Convert, + loonit_assert_source_tf_empty(Src,L1,L2, + (findall_ne(ResValue1,CodeForValue1,L1), + findall_ne(ResValue2,CodeForValue2,L2)), + equal_enough_for_test(L1,L2),RetResult)). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- + Convert =~ ['assertEqualToResult',Value1,Value2],!, + f2p(Depth,HeadIs,RetType,ResValue1,Value1,CodeForValue1), + Src = Convert, + Goal = findall_ne(ResValue1,CodeForValue1,L1), + Converted = ( + loonit_assert_source_tf_empty(Src,L1,Value2, + Goal, + equal_enough_for_test(L1,Value2),RetResult)). + +maybe_unlistify([UValueL],ValueL,RetResult,[URetResult]):- fail, is_list(UValueL),!, + maybe_unlistify(UValueL,ValueL,RetResult,URetResult). +maybe_unlistify(ValueL,ValueL,RetResult,RetResult). + +list_to_disjuncts([],false). +list_to_disjuncts([A],A):- !. +list_to_disjuncts([A|L],(A;D)):- list_to_disjuncts(L,D). + + +%f2p_assign(Depth,_HeadIs,_RetType,V,Value,is_True(V)):- Value=='True'. +f2p_assign(_Depth,_HeadIs,_RetType,ValueR,Value,ValueR=Value):- is_nsVar(Value),!. +f2p_assign(_Depth,_HeadIs,_RetType,ValueR,Value,ValueR=Value):- \+ compound(Value),!. +f2p_assign(_Depth,_HeadIs,_RetType,ValueResult,Value,Converted):- + f2p(Value,ValueResult,Converted),!. +f2p_assign(Depth,HeadIs,RetType,ValueResult,Value,Converted):- + f2p(Depth,HeadIs,RetType,ValueResultR,Value,CodeForValue), + %into_equals(ValueResultR,ValueResult,ValueResultRValueResult), + ValueResultRValueResult = (ValueResultR=ValueResult), + combine_code(CodeForValue,ValueResultRValueResult,Converted). + + +f2p_arg(_Depth,_HeadIs,_RetType,Value,Value,true):- is_nsVar(Value),!. +f2p_arg(_Depth,_HeadIs,_RetType,Value,Value,true):- \+ compound(Value),!. +f2p_arg(_Depth,_HeadIs,_RetType,ValueResult,Value,Converted):- h2p(Value,ValueResult,Converted),!. +f2p_arg(Depth,HeadIs,RetType,ValueResult,Value,Converted):- + f2p_assign(Depth,HeadIs,RetType,ValueResult,Value,Converted). + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, keep(Converted)) :- + Convert =~ ['case',Value,PNil],[]==PNil,!,Converted = (ValueCode,RetResult=[]), + f2p(Depth,HeadIs,RetType,_ValueResult,Value,ValueCode). + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, (ValueCode, Converted)) :- + Convert =~ ['case',Value|Options], \+ is_nsVar(Value),!, + cname_var('CASE_VAR_',ValueResult), + f2q(Depth,HeadIs,RetType,RetResult,['case',ValueResult|Options], Converted), + f2p(Depth,HeadIs,RetType,ValueResult,Value,ValueCode). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- + Convert =~ ['case',Value,Options],!, + must_det_ll(( + maplist(compile_case_bodies(Depth,HeadIs,RetType),Options,Cases), + cname_var('SWITCH_',AllCases), + cname_var('CASE_RESULT_',RetResult), + Converted = + ( AllCases = Cases, + select_case(AllCases,Value,RetResult)))). + +select_case(AllCases,Value,BodyResult):- + once((member(caseOption(MatchVar,MatchCode,BodyResult,BodyCode),AllCases), + rtrace_on_error(MatchCode),unify_case(Value,MatchVar))) + ,!, + rtrace_on_error(BodyCode). + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- + Convert =~ ['case',Value,[Opt|Options]],nonvar(Opt),!, + must_det_ll(( + compile_case_bodies(Depth,HeadIs,RetType,Opt,caseOption(Value,If,RetResult,Then)), + Converted = ( If -> Then ; Else ), + ConvertCases =~ ['case',Value,Options], + f2q(Depth,HeadIs,RetType,RetResult,ConvertCases,Else))). + + +/* +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- + Convert =~ ['case',Value,Options],!, + must_det_ll(( + maplist(compile_case_bodies(Depth,HeadIs,RetType),Options,Cases), + Converted = + (( AllCases = Cases, + once((member(caseOption(MatchVar,MatchCode,BodyResult,BodyCode),AllCases), + (MatchCode,unify_enough(Value,MatchVar)))), + (BodyCode), + BodyResult=RetResult)))). + +f2q(Depth,HeadIs,RetType,_,Convert, Converted) :- + Convert =~ ['case',Value,Options,RetResult],!, + must_det_ll(( + f2p(Depth,HeadIs,RetType,ValueResult,Value,ValueCode), + maplist(compile_case_bodies(Depth,HeadIs,RetType),Options,Cases), + Converted = + (( AllCases = Cases, + call(ValueCode), + once((member(caseOption(MatchVar,MatchCode,BodyResult,BodyCode),AllCases), + both_of(ValueResult,MatchCode,unify_enough(ValueResult,MatchVar)))), + call(BodyCode), + BodyResult=RetResult)))). + + +both_of(Var,G1,G2):- nonvar(Var),!,call(G2),call(G1). +both_of(_Var,G1,G2):- call(G1),call(G2). + +*/ + +compile_case_bodies(Depth,HeadIs,RetType,[Match,Body],caseOption(_,true,BodyResult,BodyCode)):- Match == '%void%',!, + f2p(Depth,HeadIs,RetType,BodyResult,Body,BodyCode). +compile_case_bodies(Depth,HeadIs,RetType,[Match,Body],caseOption(MatchResult,If,BodyResult,BodyCode)):- !, + f2p(Depth,HeadIs,RetType,MatchResultV,Match,MatchCode), + combine_code(MatchCode,unify_case(MatchResult,MatchResultV),If), + f2p(Depth,HeadIs,RetType,BodyResult,Body,BodyCode). +compile_case_bodies(Depth,HeadIs,RetType,MatchBody,CS):- compound(MatchBody), MatchBody =~ MB,compile_case_bodies(Depth,HeadIs,RetType,MB,CS). + + +compound_equals(COL1,COL2):- COL1=@=COL2,!,COL1=COL2. +compound_equals(COL1,COL2):- compound_equals1(COL1,COL2). +compound_equals1(COL1,COL2):- is_nsVar(COL1),!,is_nsVar(COL2),ignore(COL1=COL2),!. +compound_equals1(COL1,COL2):- compound(COL1),!,compound(COL2), COL1=COL2. + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- + Convert =~ ['collapse',Value1],!, + f2p(Depth,HeadIs,RetType,ResValue1,Value1,CodeForValue1), + Converted = (findall_ne(ResValue1,CodeForValue1,RetResult)). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- + Convert =~ ['compose',Value1],!, + Convert2 =~ ['collapse',Value1],!, + f2q(Depth,HeadIs,RetType,RetResult,Convert2, Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ ['unify',Value1,Value2,Then,Else],!,Test = metta_unify(ResValue1,ResValue2), + f2p(Depth,HeadIs,RetType,ResValue1,Value1,CodeForValue1), + f2p(Depth,HeadIs,RetType,ResValue2,Value2,CodeForValue2), + compile_test_then_else(Depth,RetResult,(CodeForValue1,CodeForValue2,Test),Then,Else,Converted). + + + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- dif_functors(HeadIs,Convert), + + Convert =~ ['if-decons',Atom,Head,Tail,Then,Else],!,Test = unify_cons(AtomResult,ResHead,ResTail), + f2p(Depth,HeadIs,RetType,AtomResult,Atom,AtomCode), + f2p(Depth,HeadIs,RetType,ResHead,Head,CodeForHead), + f2p(Depth,HeadIs,RetType,ResTail,Tail,CodeForTail), + compile_test_then_else(Depth,RetResult,(AtomCode,CodeForHead,CodeForTail,Test),Then,Else,Converted). + + + +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, was_True(RetResult)) :- is_compiled_and(AND), + Convert =~ [AND],!. + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- is_compiled_and(AND), + Convert =~ [AND,Body],!, + f2p(Depth,HeadIs,RetType,RetResult,Body,BodyCode), + compile_test_then_else(Depth,RetResult,BodyCode,'True','False',Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- is_compiled_and(AND), + Convert =~ [AND,Body1,Body2],!, + f2p(Depth,HeadIs,RetType,B1Res,Body1,Body1Code), + f2p(Depth,HeadIs,RetType,RetResult,Body2,Body2Code), + into_equals(B1Res,'True',AE), + Converted = (Body1Code,AE,Body2Code),!. + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- is_compiled_and(AND), + Convert =~ [AND,Body1,Body2],!, + f2p(Depth,HeadIs,RetType,B1Res,Body1,Body1Code), + f2p(Depth,HeadIs,RetType,_,Body2,Body2Code), + into_equals(B1Res,'True',AE), + compile_test_then_else(Depth,RetResult,(Body1Code,AE,Body2Code),'True','False',Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- is_compiled_and(AND), + Convert =~ [AND,Body1,Body2|BodyMore],!, + And2 =~ [AND,Body2|BodyMore], + Next =~ [AND,Body1,And2], + f2q(Depth,HeadIs,RetType,RetResult, Next, Converted). + +% If Convert is an "or" function, we convert it to the equivalent ";" (or) predicate. +f2q(Depth,HeadIs,RetType,RetResult,SOR,or(AsPredO, Converted)) :- + SOR =~ or(AsPredI, Convert), + must_det_ll((f2p(Depth,HeadIs,RetType,RetResult,AsPredI, AsPredO), + f2p(Depth,HeadIs,RetType,RetResult,Convert, Converted))),!. +f2q(Depth,HeadIs,RetType,RetResult,or(AsPredI,Convert), (AsPredO *-> true; Converted)) :- fail, !, + must_det_ll((f2p(Depth,HeadIs,RetType,RetResult,AsPredI, AsPredO), + f2p(Depth,HeadIs,RetType,RetResult,Convert, Converted))). +f2q(Depth,HeadIs,RetType,RetResult,(AsPredI; Convert), (AsPredO; Converted)) :- !, + must_det_ll((f2p(Depth,HeadIs,RetType,RetResult,AsPredI, AsPredO), + f2p(Depth,HeadIs,RetType,RetResult,Convert, Converted))). + +'True'(X):- ignore(is_True(X)). +'False'(X):- is_False(X). + +get_inline_case_list(HeadDef,Quot,CaseList):- + findall([HeadDef,NewDef],get_inline_def1(HeadDef,NewDef),DefList),DefList\==[], + findall([Quot,NewDef],member([HeadDef,NewDef],DefList),CaseList). + +get_inline_def(HeadDef,NewDef):- + findall(NewDef,get_inline_def1(HeadDef,NewDef),EachDef), EachDef\==[], + disj_def(EachDef,NewDef). + + + +get_inline_def1(HeadDef,NewDef):- + into_list_args(HeadDef,UHeadDef), + copy_term(UHeadDef,CopyUHeadDef), + [UHead|_UArgs] = UHeadDef, nonvar(UHead), + metta_atom_file_buffer([Eq,UHeadDef|Body]),Eq=='=', once(xform_body(Body,NewDef)), + (UHeadDef=@=CopyUHeadDef). + +%xform_body([Body],Body):-!. +%xform_body(Items,[progn|Body]). + +xform_body(Var,Var):-is_ftVar(Var), !. +xform_body([],call(true)):-!. +xform_body([Body],Body):-!. +xform_body([Body1,Body2],(Body1,Body2)):-!. +xform_body([Body1|Body2L],(Body1,Body2)):-xform_body(Body2L,Body2). + +disj_def(Var,Var):-is_ftVar(Var), !. +disj_def([],call(fail)):-!. +disj_def([Body],Body):-!. +disj_def([Body1,Body2],(Body1;Body2)):-!. +disj_def([Body1|Body2L],(Body1;Body2)):-disj_def(Body2L,Body2). + + +/* +f2q(Depth,HeadIs,RetType,RetResult,transpose(Convert), Converted,Code) :- !, + maplist(each_result(Depth,HeadIs,RetType,RetResult),Convert, Converted), + list_to_disjuncts(Converted,Code). + +each_result(Depth,HeadIs,RetType,RetResult,Convert,Converted):- + f2p(Depth,HeadIs,RetType,OneResult,Convert,Code1), + into_equals(OneResult,RetResult,Code2), + combine_code(Code1,Code2,Converted). + +*/ +/* +f2q(Depth,HeadIs,RetType,RetResult,Convert, once(u_assign(Body,RetResult))) :- + Convert=~ first_of(Body), is_ftVar(Body),!. +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- + Convert=~ first_of(Body), + must_det_ll((as_functor_args(Body,F,A,Args), + as_functor_args(Quot,quot,A,NewArgs), + as_functor_args(QConvert,quot,A,Args))), + get_inline_case_list([F|NewArgs],Quot,DefList),!, + must_det_ll((f2p(Depth,HeadIs,RetType,RetResult,[case,QConvert,DefList],Converted))).*/ +f2q(Depth,HeadIs,RetType,RetResult,Convert, once(Converted)) :- + Convert=~ first_of(Body),!, f2p(Depth,HeadIs,RetType,RetResult,Body,Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, catch(BodyCode,Ex,HandlerCode)) :- + Convert=~ catch(Body,E,Handler),!, s2p(E,Ex), + f2p(Depth,HeadIs,RetType,RetResult,Body,BodyCode), + f2p(Depth,HeadIs,RetType,RetResult,Handler,HandlerCode). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, call_cleanup(BodyCode,HandlerCode)) :- + Convert=~ finally(Body,Handler),!, + f2p(Depth,HeadIs,RetType,RetResult,Body,BodyCode), + f2p(Depth,HeadIs,RetType,RetResult,Handler,HandlerCode). + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- fail, dif_functors(HeadIs,Convert), + get_inline_def(Convert,InlineDef),!, + must_det_ll((f2p(Depth,HeadIs,RetType,RetResult,InlineDef,Converted))). + + +% If Convert is a "not" function, we convert it to the equivalent ";" (or) predicate. +f2q(Depth,HeadIs,RetType,RetResult,Convert, \+ eval_true(AsPredO)) :- + '=~'(Convert , (not(AsPredI))), + must_det_ll(f2p(Depth,HeadIs,RetType,RetResult,AsPredI, AsPredO)). + + + +get_first_p1(_,Cmpd,_):- \+ compound(Cmpd),!, fail. +get_first_p1(E,Cmpd,set_nth1(N1,Cmpd)):- is_list(Cmpd), nth1(N1,Cmpd,E). +get_first_p1(E,Cmpd,Result) :- is_list(Cmpd),!, member(Ele,Cmpd), get_first_p1(E,Ele,Result). +get_first_p1(_,Cmpd,_) :- is_conz(Cmpd),!,fail. +get_first_p1(E,Cmpd,set_arg(N1,Cmpd)) :- arg(N1,Cmpd,E). +get_first_p1(E,Cmpd,Result) :- arg(_,Cmpd,Ele),!,get_first_p1(E,Ele,Result). + +non_simple_arg(E):- compound(E),!, \+ is_ftVar(E). + + +f2q(Depth,HeadIs,RetType,RetResult,Converting, (PreArgs,Converted)):- fail, + as_functor_args(Converting,F,A,Args), + \+ \+ (member(E,Args), non_simple_arg(E)), + cname_var('Self',Self), + %Self = '$VAR'('RetType'), + maplist(type_fit_childs('=',Depth,Self),_RetTypes1,ArgsCode,Args,NewArgs), + combine_code(ArgsCode,PreArgs), + nop(non_compat_io(color_g_mesg('magenta', + ((write_src(type_fit_childs('=',Depth,F,_RetTypes2,PreArgs,Args,NewArgs)),nl))))), + as_functor_args(Convert,F,A,NewArgs), + \+ (member(E,NewArgs), non_simple_arg(E)),!, + f2p(Depth,HeadIs,RetType,RetResult,Convert, Converted). + + + /* +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ if(Cond,Then),!, + f2p(Depth,HeadIs,RetType,CondResult,Cond,CondCode), + f2p(Depth,HeadIs,RetType,RetResult,Then,ThenCode), + Converted = ((CondCode,is_True(CondResult)),ThenCode). + +f2q(Depth,HeadIs,RetType,RetResult,Converter, Converted):- + de_eval(Converter,Convert),!, + f2p(Depth,HeadIs,RetType,RetResult,Convert, Converted). + +f2q(Depth,HeadIs,RetType,_Result,Convert, Converted) + :- fail, + as_functor_args(Convert,Func,PA), + functional_predicate_arg(Func,PA,Nth), + Convert =~ [Func|PredArgs], + nth1(Nth,PredArgs,Result,FuncArgs), + RetResult = Result, + AsFunct =~ [Func|FuncArgs], + f2p(Depth,HeadIs,RetType,RetResult,AsFunct, Converted). + + */ + +% f2q(_Depth,_HeadIs,_RetType, _RetVal, Convert, Convert) :- compound(Convert), (Convert= (_,_)),!. + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- fail, + must_det_ll(( + as_functor_args(Convert,F,A,Args), + as_functor_args(Quot,quot,A,NewArgs), + as_functor_args(QConvert,quot,A,Args))), + get_inline_case_list([F|NewArgs],Quot,DefList),!, + must_det_ll((f2p(Depth,HeadIs,RetType,RetResult,case(QConvert,DefList),Converted))). + +is_non_evaluatable(S):- \+ compound(S),!. +is_non_evaluatable(S):- is_ftVar(S),!. +is_non_evaluatable([H|_]):- \+ symbol(H), \+ is_non_evaluatable(H). +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, Converted) :- fail, is_non_evaluatable(Convert), + Converted = call_why(non_eval,Convert=RetResult),!. + + +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ 'bind!'(Var,Value),is_ftVar(Value),!, + Converted = u_assign8('bind!'(Var,Value),RetResult). + +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ 'bind!'(Var,Value), Value =~ 'new-space'(),!, + Converted = eval('bind!'(Var,Value),RetResult). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ 'bind!'(Var,Value), !, + f2p(Depth,HeadIs,RetType,ValueResult,Value,ValueCode), + Eval = eval_args(['bind!',Var,ValueResult],RetResult), + combine_code(ValueCode,Eval,Converted). + + +returns_empty('add-atom'). +returns_empty('remove-atom'). + +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, Converted) :- + (Convert =~ [EmptyResultFunction,Where,What,RetResult]; + Convert =~ [EmptyResultFunction,Where,What]), + nonvar(EmptyResultFunction), + returns_empty(EmptyResultFunction), + current_predicate(EmptyResultFunction/2), + =(What,WhatP),!, + Converted = as_nop(call(EmptyResultFunction,Where,WhatP),RetResult). + +f2q(Depth,HeadIs,RetType,RetResult,Convert,Converted) :- + Convert =~ ['println!',Value],!, + Converted = (ValueCode,eval(['println!',ValueResult], RetResult)), + f2p(Depth,HeadIs,RetType,ValueResult,Value,ValueCode). + + + +f2q(Depth,HeadIs,RetType,RetResult,Convert,CodeForValueConverted) :- fail, + Convert =~ [Plus,N,Value], symbol(Plus), current_predicate(Plus/3), number(N), + \+ number(Value), \+ is_nsVar(Value),!, + f2p(Depth,HeadIs,RetType,ValueResult,Value,CodeForValue),!, + Converted =.. [Plus,N,ValueResult,RetResult], + combine_code(CodeForValue,Converted,CodeForValueConverted). +/* +% match(Space,f(1)=Y,Y) +f2q(Depth,HeadIs,RetType,Y,Convert,Converted) :- dif_functors(HeadIs,Convert), + Convert=~ match(Space,AsFunctionY,YY), + nonvar(AsFunctionY),( AsFunctionY =~ (AsFunction=Y)), nonvar(AsFunction), + !, Y==YY, + f2p(Depth,HeadIs,RetType,Y,AsFunction,Converted),!. +*/ + +metta_atom_iter(Space,Match):- + metta_atom_iter('=',10,Space,Space,Match). + +make_with_space(Space,MatchCode,MatchCode):- Space=='&self',!. +make_with_space(Space,MatchCode,with_space(Space,MatchCode)):- Space\=='&self'. + +% If Convert is a Value, and RetResult is a Variable bind them together and mark the compiler used them +f2q(_Depth,_HeadIs,_RetType, _RetResult,(A =~ B), (A =~ B)) :-!. + + +% If Convert is an "u_assign" function, we convert it to the equivalent "is" predicate. +f2q(Depth,HeadIs,RetType,RetResult,EvalConvert,Converted):- + EvalConvert =~ eval(Convert), !, + must_det_ll((f2p(Depth,HeadIs,RetType,RetResult,Convert, Converted))). + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted):- fail, + compound(Convert), Convert = u_assign(C, Var), compound_non_cons(C),into_list_args(C,CC),!, + f2p(Depth,HeadIs,RetType,RetResult,u_assign(CC, Var), Converted). + +f2q(_Depth,_HeadIs,_RetType,_RetResult,Convert, Converted):- fail, + compound(Convert), + Convert = u_assign(C, _Var), + is_list(C),Converted = Convert,!. + + +f2q(_Depth,HeadIs,_RetType,RetResult,Convert, Converted) :- fail, + symbol(Convert), functional_predicate_arg(Convert,Nth,Nth2), + Nth==1,Nth2==1, + HeadIs\=@=Convert, + Convert = F,!, + must_det_ll(( + do_predicate_function_canonical(FP,F), + compound_name_list(Converted,FP,[RetResult]))). + + +% If Convert is an "is" function, we convert it to the equivalent "is" predicate. +f2q(Depth,HeadIs,RetType,RetResult,is(Convert),(Converted,is(RetResult,Result))):- !, + must_det_ll((f2p(Depth,HeadIs,RetType,Result,Convert, Converted))). + +into_equals(Eval,Result,Code):- + into_u_assign(Eval,Result,Code). + +into_u_assign(Eval,Result,true):- is_nsVar(Eval), is_nsVar(Result), Eval=Result,!. +into_u_assign(Eval,Result,Code):- Result=='True',!,f2p(Eval,_Result,Code). +into_u_assign(Eval,Result,Code):- var(Eval), \+ var(Result), !, into_u_assign(Result,Eval,Code). +into_u_assign(Eval,Result,Code):- f2p(Eval,Result,Code),!. +into_u_assign(Eval,Result,Code):- Code = u_assign5(Eval,Result). + +% check if this is a flow control operation +%f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted):- +% compound(Convert), \+ compound_name_arity(Convert,_,0), +% f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted),!. + +f2q(Depth,HeadIs,RetType,RetResultL, ConvertL, Converted) :- is_list(ConvertL), + ConvertL = [Convert], is_list(Convert), + f2p(Depth,HeadIs,RetType,RetResult,Convert, Code),!, + into_equals(RetResultL,[RetResult],Equals), + combine_code(Code,Equals,Converted). +f2q(_Depth,_HeadIs,_RetType,ResultVar,'cdr-atom'(Atom), 'cdr-atom'(Atom,ResultVar)) :- !. +f2q(_Depth,_HeadIs,_RetType,ResultVar,'car-atom'(Atom), 'car-atom'(Atom,ResultVar)) :- !. + +% If Convert is a list, we convert it to its termified form and then proceed with the functs_to_preds conversion. +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- fail, is_list(Convert), + once((sexpr_s2p(Convert,IS), \+ IS=@=Convert)), !, % Check if Convert is a list and not in predicate form + must_det_ll((f2p(Depth,HeadIs,RetType,RetResult, IS, Converted))). % Proceed with the conversion of the predicate form of the list. + + +f2q(Depth,HeadIs,RetType,RetResult, ConvertL, Converted) :- fail, is_list(ConvertL), + maplist(f2p_assign(Depth,HeadIs,RetType),RetResultL,ConvertL, ConvertedL), + combine_code(ConvertedL,Conjs), + into_u_assign(RetResultL,RetResult,Code), + combine_code(Conjs,Code,Converted). + + + +/* MAYBE USE ? +% If Convert is a compound term, we need to recursively convert its arguments. +f2q(Depth,HeadIs,RetType,RetResult, Convert, Converted) :- fail, + compound(Convert), !, + Convert =~ [Functor|Args], % Deconstruct Convert to as_functor_args and arguments + maplist(convert_argument, Args, ConvertedArgs), % Recursively convert each argument + Converted =~ [Functor|ConvertedArgs], % Reconstruct Converted with the converted arguments + (callable(Converted) -> f2p(Depth,HeadIs,RetType,RetResult, Converted, _); true). % If Converted is callable, proceed with its conversion +% Helper predicate to convert an argument of a compound term +convert_argument(Arg, ConvertedArg) :- + (callable(Arg) -> ftp(_, _, Arg, ConvertedArg); ConvertedArg = Arg). +*/ + +% convert Funtion +% f2q(Depth,HeadIs,RetType,ResultVar,Convert, Converted) :- h2p(Convert, ResultVar, Converted). + + +/* +f2q(Depth,_HeadIs,_RetType,RetResult,AsPred,Converted):- + compound(AsPred), + as_functor_args(AsPred,F,A,Args), + no_lists(Args), + always_predicate_in_src(F,A), + was_predicate(AsPred,RetResult,Converted). + +f2q(Depth,_HeadIs,_RetType,RetResult,AsPred,Converted):- + compound(AsPred), + as_functor_args(AsPred,F,A,Args), + no_lists(Args), + always_function_in_src(F,A), + was_predicate(AsPred,RetResult,Converted). +*/ + +f2q(_Depth,_HeadIs,_RetType,_RetResult,u_assign(Convert,Res), u_assignA(Convert,Res)):-!. + + + +f2q(Depth,_HeadIs,RetType,RetVar, Data, CodeOut):- + as_functor_args(Data,F,A,Args), + current_self(Self), + length(NewArgs,A), + length(ParamTypes,A), + most_true([get_operator_typedef(Self,F,ParamTypes,RetTypeF), + can_assign(RetTypeF,RetType)]), + if_t(F==(fL), println(Data)), + narrow_types(RetTypeF,RetType,NarrowType), + Call=[F|NewArgs], + append(ParamTypes,[RetType|_],ParamTypesO), + into_eval_for_l(Depth,Call,Self,F,1,ParamTypesO,Args,NewArgs,ParamCode), + combine_code(ParamCode,eval_for(b_6,NarrowType,Call,RetVar),CodeOut). + +f2q(_Depth,_HeadIs,RetType,RetVar,Data,eval_for(b_8,RetType,Data,RetVar)). + +most_true([]):-!. +most_true([A|List]):- call(A),!,most_true(List). +most_true([A|List]):- most_true(List),ignore(A). + + +into_eval_for_l(Depth,HeadIs,Self,F,Nth,[PT|ParamTypes],[A|Args],[N|NewArgs],CCode):- !, + into_eval_for(Depth,HeadIs,Self,F,Nth,PT,A,N,C), + Nth1 is Nth+1, + into_eval_for_l(Depth,HeadIs,Self,F,Nth1,ParamTypes,Args,NewArgs,Code), + combine_code(C,Code,CCode). +into_eval_for_l(_Depth,_HeadIs,_Slf,_F,_Nth,[],Args,Args,true). +into_eval_for_l(_Depth,_HeadIs,_Slf,_F,_Nth,_ParamTypes,[],[],true). + +into_eval_for(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,A,true):- number(A),!,ignore(PT='Number'). +into_eval_for(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,N,eval_for(b_5,PT,A,N)):- nonvar(PT), PT\=='Atom',var(A),!. +into_eval_for(_Depth,_HeadIs,_Slf,F,Nth,PT,A,N,eval_for(b_4(Nth,F),PT,A,N)):- var(PT), var(A),!. +%into_eval_for(Depth,HeadIs,_Slf,_F,_Nth,RetType,[-,A,B],C,(ACodeOut,BCodeOut,-(NewA,NewB,C))):- +%f2p(Depth,HeadIs,RetType,NewA, A, ACodeOut), +%f2p(Depth,HeadIs,RetType,NewB, B, BCodeOut),!. + +into_eval_for(Depth,HeadIs,_Slf,_F,_Nth,RetType,Arg,NewArg,CodeOut):- is_list(Arg), + f2p(Depth,HeadIs,RetType,NewArg,Arg, CodeOut),!. + +into_eval_for(Depth,HeadIs,Slf,F,Nth,RetType,Arg,NewArgO,CodeOut):- + compound(Arg), as_functor_args(Arg,AF,_A,Args), + Compile = [AF|Args], !, into_eval_for(Depth,HeadIs,Slf,F,Nth,RetType,Compile,NewArgO,CodeOut),!. + +into_eval_for(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,N,eval_for(b_3,PT,A,N)):- var(PT), get_type(A,PT),nonvar(PT),!. +into_eval_for(_Depth,_HeadIs,_Slf,F,Nth,PT,A,N,eval_for(b_2(Nth,F),PT,A,N)):- var(PT), !. +into_eval_for(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,N,eval_for(b_1,PT,A,N)):- nonvar(PT),PT\=='Atom', !. +into_eval_for(_Depth,_HeadIs,_Slf,_F,_Nth,_PT,A,A,true). + diff --git a/.Attic/canary_docme/metta_convert.pl b/.Attic/canary_docme/metta_convert.pl new file mode 100644 index 00000000000..c7c65ab08e0 --- /dev/null +++ b/.Attic/canary_docme/metta_convert.pl @@ -0,0 +1,771 @@ +/* + * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpeter + * 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 functional/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. + */ + + +:- encoding(iso_latin_1). +:- flush_output. +:- setenv('RUST_BACKTRACE',full). +:- op(700,xfx,'=~'). +:- ensure_loaded(metta_interp). + +% =============================== +% TESTING +% =============================== +% Define 'fb', a rule that calls 'make' and writes information for each clause of 'fb0'. +% 'make' compiles the program. +% The 'forall' loop will write and call all goals of the 'fb0' clauses. + + +fb:- make, + writeln(';; ==========================================='), + forall((clause(fb0,Goal),write(';; '),writeq(?- Goal),nl,call(Goal)), + writeln(';; ===========================================')). + +% The 'fb0' rule showing mettalog sources with specific definitions. +fb0:- show_mettalog_src((two_pi(R):-(pi(A), +(A, A, B), R is B))). +fb0:- show_mettalog_src(factorial_tail_basic). +fb0:- show_mettalog_src(funct). + +print_metta_src :- show_mettalog_src. +% 'show_mettalog_src' rule compiles the program and shows mettalog sources for each source file containing 'metta'. +show_mettalog_src:- make, + forall((source_file(AsPred,File), + symbol_contains(File,metta)), + show_mettalog_src(AsPred)). + + +% Handling different cases for 'show_mettalog_src' with different input parameters. +% These rules use nonvar, current_predicate, and other built-ins to perform various checks and actions +% based on the type and value of the input to 'show_mettalog_src'. +show_mettalog_src(F/A):- nonvar(F),!, forall(current_predicate(F/A), show_mettalog_src(F,A)). +show_mettalog_src(AsPred):- functor(AsPred,F,A), \+ \+ current_predicate(F/A), !, forall(current_predicate(F/A), show_mettalog_src(F,A)). +show_mettalog_src(F):- atom(F), \+ \+ current_predicate(F/_),!, forall(current_predicate(F/A), show_mettalog_src(F,A)). +show_mettalog_src(C):- atom(C), \+ \+ (current_predicate(F/_),once(atom_contains(F,C))),!, forall((current_predicate(F/A),once(atom_contains(F,C))), show_mettalog_src(F,A)). +show_mettalog_src(C):- show_cvts(C),!. + +% The 'show_space_src' rules compile the program and show space sources for each space predicate. +show_space_src:- make, + forall(space_preds(AsPred),show_space_src(AsPred)). + + +% Similar to the 'show_mettalog_src' rules, these rules handle different cases for 'show_space_src' +% with different input parameters and perform various checks and actions based on the type and value of the input. +show_space_src(F/A):- nonvar(F),!, forall(current_predicate(F/A), show_space_src(F,A)). +show_space_src(AsPred):- functor(AsPred,F,A), \+ \+ current_predicate(F/A), !, forall(current_predicate(F/A), show_space_src(F,A)). +show_space_src(F):- atom(F), \+ \+ current_predicate(F/_),!, forall(current_predicate(F/A), show_space_src(F,A)). +show_space_src(C):- atom(C), \+ \+ (current_predicate(F/_),once(atom_contains(F,C))),!, forall((current_predicate(F/A),once(atom_contains(F,C))), show_space_src(F,A)). +show_space_src(C):- show_cvts(C),!. + +% 'show_cvts' rule processes a term, performing different actions based on the structure of the term. +show_cvts(Term):- + once((is_list(Term), sexpr_s2p(Term,PF))), \+ is_list(PF),!,show_cvts(PF). + +% 'show_cvts' continues processing, performing conversions between predicates and functions, +% and pretty-printing original terms, function forms, and Prolog forms. +show_cvts(Term):- iz_conz(Term),!, ppc(orig,Term),Term = FunctForm, + functs_to_preds(FunctForm,Prolog), ppc(preds,Prolog), + preds_to_functs(Prolog,NFunctForm), ppc(functs,NFunctForm). +show_cvts(Term):- ppc(orig,Term), + preds_to_functs(Term,FunctForm), ppc(functs,FunctForm), + functs_to_preds(FunctForm,Prolog), ppc(preds,Prolog). + +% 'show_mettalog_src' for specific predicate, prints metta clauses if they exist in the source file containing 'metta'. +show_mettalog_src(F,A):- functor(Head,F,A), + ignore((predicate_property(Head,number_of_clauses(_)), + source_file(Head,File),atom_contains(File,metta),!, + nl,findall((Head:-Body), + clause(Head,Body), Clauses), + print_metta_clauses(Clauses))),nl. + +% 'print_metta_clauses' rule is handling the printing of metta clauses. +% It checks the form of the input clauses and calls 'print_metta_clause' accordingly. +print_metta_clauses([]):- !. +print_metta_clauses([Head:-Body]):- !, print_metta_clause(Head,Body). +print_metta_clauses(Clauses):- combine_clauses(Clauses,Head,Body),!,print_metta_clause(Head,Body). +print_metta_clause(Head,Body):- + print_metta_clause0(Head,Body), + show_cvts(Head:-Body). + +% 'print_metta_clause0' rule prints metta clauses based on the body. +% It transforms the body to a list, if needed, and prints it in a sequential form. +print_metta_clause0(Head,Body):- Body == true,!, pp_metta([=,Head,'True']). +print_metta_clause0(Head,Body):- Body == false,!, pp_metta([=,Head,'False']). +print_metta_clause0(Head,Body):- conjuncts_to_list(Body,List), into_sequential([':-'],List,SP), pp_metta([=,Head,SP]). + + + +% ========================================= +% STERM -> PTERM +% ========================================= + +iz_exact_symbol(N,_):- \+ atom(N),!,fail. +iz_exact_symbol(N,P):- nonvar(P),!,iz_exact_symbol(N,PP),zalwayz(P=PP). +iz_exact_symbol(':-',':-'). +iz_exact_symbol('?-','?-'). +iz_exact_symbol('??',_). + +%:- baseKB:ensure_loaded(logicmoo('plarkc/logicmoo_i_cyc_rewriting')). + +maybe_varz(S,Name,'$VAR'(Name)):- S=='?',atom(Name),!. + +%% sexpr_s2p(Fn,?VAR, ?V) is det. +% +% S-expression Sterm Converted To Pterm. +% +sexpr_s2p(HB,P):- fail, compound(HB), HB=~ (H=B), compile_for_assert(H,B,Cl), + clause_to_code(Cl,P),!. +sexpr_s2p(S,P):- sexpr_s2p(progn,1,S,P). + + +clause_to_code(P,P):- is_ftVar(P),!. +%clause_to_code(P:-True,P):- True == true,!. +clause_to_code((H:-B),P):- B==true, !, combine_code(B,H,P). +clause_to_code(P,P). + +sexpr_s2p(_Fn,_Nth,VAR,VAR):-is_ftVar(VAR),!. +sexpr_s2p(_Fn,_Nth,S,P):- iz_exact_symbol(S,P),!. +sexpr_s2p(_Fn,_Nth,'#'(S),P):- iz_exact_symbol(S,P),!. +sexpr_s2p(_Fn,_Nth,VAR,'$VAR'(Name)):- atom(VAR),svar(VAR,Name),!. +sexpr_s2p(Fn,Nth,S,P):- S==[], iz_fun_argz(Fn,Nth),!,P=S. + +%sexpr_s2p(Fn,Nth,S,P):- expects_type(Fn,Nth,Type),will_become_type(Type,S,P),!. + +sexpr_s2p(_Fn,_Nth,[F|SList],P):- is_list(SList), length(SList,Len),is_syspred(F,Len,Pred), sexpr_s2p_arglist(F,1,SList,PList), !, P=..[Pred|PList]. +:- style_check(-singleton). + +sexpr_s2p(Fn,Nth,[S|SList],[P|PList]):- iz_fun_argz(Fn,Nth),!,sexpr_s2p(S,P), sexpr_s2p(Fn,Nth,SList,PList). +sexpr_s2p(Fn,Nth,[S|SList],[P|PList]):- ( \+ atom(S) ; \+ is_list(SList)), !,sexpr_s2p(list(Fn),Nth,S,P), sexpr_s2p(list(Fn),Nth,SList,PList). +sexpr_s2p(_Fn,_Nth,[S,STERM0],PTERM):- iz_quoter(S),sexpr_s2p_pre_list(S,0,STERM0,STERM), !,PTERM=..[S,STERM],!. +sexpr_s2p(_Fn,_Nth,[S|SList],P):- atom(S), SList == [], compound_name_arity(P,S,0). +% sexpr_s2p(Fn,Nth,List,PTERM):- append(Left,[S,Name|TERM],List),maybe_varz(S,Name,Var),!,append(Left,[Var|TERM],NewList), sexpr_s2p(Fn,Nth,NewList,PTERM). +% sexpr_s2p(Fn,Nth,[S|TERM],dot_holds(PTERM)):- \+ (is_list(TERM)),sexpr_s2p_arglist(Fn,Nth,[S|TERM],PTERM),!. +%sexpr_s2p(Fn,Nth,[S|TERM],PTERM):- \+ atom(S),sexpr_s2p_arglist(Fn,Nth,[S|TERM],PTERM),!. +/* +sexpr_s2p(Fn,Nth,[S,Vars|TERM],PTERM):- nonvar(S), + call_if_defined(common_logic_snark:iz_quantifier(S)), + zalwayz((sexpr_s2p_arglist(Fn,Nth,TERM,PLIST), + PTERM =~ [S,Vars|PLIST])),!. +*/ +% sexpr_s2p(progn,_,[S|TERM],PTERM):- S==AND,!,zalwayz((maplist(sexpr_s2p,TERM,PLIST),list_to_conjuncts(',',PLIST,PTERM))). +%sexpr_s2p(Fn,Nth,[S|TERM],PTERM):- (number(S); (atom(S),fail,atom_concat_or_rtrace(_,'Fn',S))),sexpr_s2p_arglist(Fn,Nth,[S|TERM],PTERM),!. +%sexpr_s2p(Fn,Nth,[S],O):- is_ftVar(S),sexpr_s2p(Fn,Nth,S,Y),!,z_univ(Fn,Nth,O,[Y]),!. +%sexpr_s2p(Fn,Nth,[S],O):- nonvar(S),sexpr_s2p(Fn,Nth,S,Y),!,z_univ(Fn,Nth,O,[Y]),!. +%sexpr_s2p(Fn,Nth,[S|TERM],PTERM):- S==and,!,zalwayz((maplist(sexpr_s2p,TERM,PLIST),list_to_conjuncts(',',PLIST,PTERM))). +% sexpr_s2p(Fn,Nth,[S|TERM],PTERM):- iz_va_relation(S),!,zalwayz((maplist(sexpr_s2p,TERM,PLIST),list_to_conjuncts(S,PLIST,PTERM))). +%sexpr_s2p(Fn,Nth,[S|TERM],PTERM):- iz_relation_sexpr(S),zalwayz((sexpr_s2p_arglist(Fn,Nth,TERM,PLIST),PTERM =~ [S|PLIST])),!. +%sexpr_s2p(Fn,Nth,STERM,PTERM):- STERM =~ [S|TERM],sexpr_s2p_arglist(Fn,Nth,TERM,PLIST),z_univ(Fn,Nth,PTERM,[S|PLIST]),!. +sexpr_s2p(Fn,Nth,[S|STERM0],PTERM):- + sexpr_s2p_pre_list(Fn,Nth,STERM0,STERM), + sexpr_s2p_arglist(S,1,STERM,PLIST), z_univ(Fn,Nth,PTERM,[S|PLIST]),!. +sexpr_s2p(_Fn,_Nth,VAR,VAR). + + +expects_type(Fn,Nth,Type):- + get_operator_typedef(Self,Fn,Params,RetType), + nth0(Nth,[RetType|Params],Type),nonvar(Type). + +will_become_type(Type,S,P):- try_adjust_arg_types(=,_RetType,88,_Self,[Type],[S],[PS]),PS=P,!. +will_become_type(Type,S,P):- is_ftVar(S),!,P=S. +will_become_type(Type,S,P):- + get_type(S,T),!, + (is_subtype(T,Type)->S=P; P=coerce(Type,S)). +will_become_type(_Type,S,P):-!,S=P. + +is_subtype(T,TT):- T=@=TT,!,T=TT. +is_subtype(T,TT):- T=TT,!. + +iz_quoter('#BQ'):- iz_common_lisp. +iz_quoter('#COMMA'):- iz_common_lisp. +iz_quoter('quote'). +iz_quoter(superpose). + +iz_fun_argz(list(_),_). +iz_fun_argz(defmacro,2). +iz_fun_argz(defun,2). +iz_fun_argz(let,1). +iz_fun_argz('let*',1). +iz_fun_argz('member',2). +%iz_fun_argz('let*',2). +iz_fun_argz(F,1):- iz_quoter(F). + +z_functor(F):- \+ atom(F), !,fail. +z_functor(F):- \+ atom_concat('?',_,F). +z_functor(F):- \+ atom_concat('$',_,F). + +%z_univ(_Fn,1,S,S):-!. +z_univ(_Fn,_,P,[F|ARGS]):- z_functor(F),is_list(ARGS),length(ARGS,A),l_arity_l(F,A),compound_name_arguments(P,F,ARGS),!. +z_univ(_Fn,0,P,[F|ARGS]):- z_functor(F),is_list(ARGS),compound_name_arguments(P,F,ARGS),!. +z_univ(_Fn,_Nth,P,[F|ARGS]):- z_functor(F),is_list(ARGS),compound_name_arguments(P,F,ARGS),!. +z_univ(_Fn,_Nth,P,S):-P=S. + +l_arity_l(F,A):- clause_b(arity(F,A)). +l_arity_l(function,1). +l_arity_l(quote,1). +l_arity_l('#BQ',1):- iz_common_lisp. +l_arity_l(F,A):-current_predicate(F/A). +l_arity_l(_,1). + +sexpr_s2p_arglist(_Fn,_,VAR,VAR):-is_ftVar(VAR),!. +sexpr_s2p_arglist(Fn,Nth,[S|SList],[P|PList]):-sexpr_s2p(Fn,Nth,S,P), + (Nth>0->Nth2 is Nth+1;Nth2=0),sexpr_s2p_arglist(Fn,Nth2,SList,PList),!. +sexpr_s2p_arglist(Fn,Nth,S,P):-sexpr_s2p(Fn,Nth,S,P),!. +sexpr_s2p_arglist(_Fn,_Nth,VAR,VAR). + +sexpr_s2p_pre_list(_Fn,_,STERM,STERM):- \+ compound(STERM), !. +sexpr_s2p_pre_list(_Fn,_,STERM,STERM):- \+ is_list(STERM), !. +% sexpr_s2p_pre_list(Fn,_,[S|STERM],[S|STERM]):- STERM == [], !. +sexpr_s2p_pre_list(Fn,Nth,[S0|STERM0],[S|STERM]):- + (is_list(S0)->sexpr_s2p(Fn,Nth,S0,S);sexpr_s2p_pre_list(Fn,Nth,S0,S)), + sexpr_s2p_pre_list(Fn,Nth,STERM0,STERM),!. +sexpr_s2p_pre_list(_Fn,_,STERM,STERM). + + + + +% p2m/2 is a translation utility to convert Prolog constructs to MeTTa constructs. +% It handles a variety of cases, including different types of compound terms, +% control structures, and predicate definitions. +% The first argument is the input in Prolog syntax, +% and the second argument is the output converted to MeTTa syntax. + +p2m(I):-forall( + no_repeats(current_predicate(I/A)), + (functor(P,I,A), + forall(clause(P,Body), + (numbervars(P+Body,0,_,[]), + write_src(=(P,'call!'(Body))))))). + + + +p2m(I,O):- p2m([progn],I,O). + +p2m(_OC,NC, NC) :- var(NC), !. % If NC is a variable, do not translate. +p2m(_OC,NC, NC) :- is_ftVar(NC), !. % If NC is a free term variable, do not translate. + +p2m(OC,[H|T],'::'(L)):- is_list([H|T]),maplist(p2m(OC),[H|T],L). +p2m(OC,[H|T], 'Cons'(OH,OT)):- p2m(OC,H, OH), p2m(OC,T, OT). + + +% Conversion for any atomic term +p2m(_OC,A, A):- string(A),!. +p2m(_OC,[], 'Nil'). % empty list +p2m(_OC,[], 'Nil'). % empty list +p2m(_OC,'[|]','Cons'). +p2m(_OC,!, ['set-det']). % Translate the cut operation directly. +p2m(_OC,!, '!'). % Translate the cut operation directly. +p2m(_OC,false, 'False'). +p2m(_OC,true, 'True'). % Translate Prolog?s true to MeTTa?s True. +p2m([progn|_],Atom,[O]):- atom(Atom),!,p2m([arg],Atom,O),!. +p2m(_OC,( ';' ),'xor'). +p2m(_OC,( ',' ),'and2'). +%p2m(_OC,( ',' ),and). +%p2m(_OC,( '\\+' ),unless). +%p2m(_OC,( ':-' ),entailed_by). +p2m(_OC,'=..','atom_2_list'). +p2m([progn|_], (fail), [empty]). % Translate Prolog?s fail to MeTTa?s False. +p2m(_OC,'atom','is-symbol'). +p2m(_OC,'atomic','symbolic'). +p2m(OC,ASymbolProc,O):- atom(ASymbolProc), + symbolic_list_concat(LS,'$',ASymbolProc),LS\==[],LS\=[_],!, + symbolic_list_concat(LS,'%',SymbolProc),into_hyphens(SymbolProc,O). +p2m(OC,ASymbolProc,O):- atom(ASymbolProc),into_hyphens(ASymbolProc,O). +p2m(_,A, H):- atom(A),into_hyphens(A,H),!. +p2m(_OC,A, A):- atomic(A). +p2m(_OC,NC,NC):- \+ compound(NC),!. + + +p2m(_OC,NC,[F]):- compound_name_arity(NC,F,0),!. +p2m(OC,M:I, O):- M==user,!, p2m(OC,I,O),!. +p2m(OC,M:I, O):- M==user,!, p2m(OC,I,O),!. +p2m(_OC,M:I, 'scoped'(N,O)):- p2m(OC,M,N),p2m(I,O). +% Conversion for lists +p2m(OC,NC, OO) :- + % If NC is a list, map each element of the list from Prolog to MeTTa + is_list(NC),!, + maplist(p2m(OC), NC, OO). + p2m([progn|_], (!,fail), [empty]). % Translate Prolog?s fail to MeTTa?s False. +% p2m(_OC,fail, 'False'). % Translate Prolog?s fail to MeTTa?s False. +% p2m(_OC,prolog, meTTa). % Translate the atom prolog to meTTa. + + +p2m([progn|_],A, [H]):- atom(A),into_hyphens(A,H),!. + +% Conversion for the negation as failure +p2m(_OC,(\+ A), O):- !, p2m(_OC,naf(A), O). + +p2m(OC,(G,E),O):- conjuncts_to_list((G,E),List),!,into_sequential(OC,List,O),!. + +% Conversion for arithmetic evaluation +%p2m(_OC,is(A, B), O):- !, p2m(_OC,eval(B, A), O). +%p2m(_OC,is(V,Expr),let(V,Expr,'True')). +p2m(_OC,(Head:-Body),O):- Body == true,!, O = (=(Head,'True')). +p2m(_OC,(Head:-Body),O):- Body == fail,!, O = (=(Head,[empty])). +p2m(OC,(Head:-Body),O):- + p2m(Head,H),conjuncts_to_list(Body,List),maplist(p2m([progn|OC]),List,SP),!, + O = ['=',H|SP]. + +p2m(OC,(:-Body),O):- !, + conjuncts_to_list(Body,List),into_sequential([progn|OC],List,SP),!, O= exec(SP). +p2m(OC,( ?- Body),O):- !, + conjuncts_to_list(Body,List),into_sequential([progn|OC],List,SP),!, O= exec('?-'(SP)). + +%p2m(_OC,(Head:-Body),O):- conjuncts_to_list(Body,List),into_sequential(OC,List,SP),!,O=(=(Head,SP)). + +% Conversion for if-then-else constructs +p2m(OC,(A->B;C),O):- !, p2m(OC,det_if_then_else(A,B,C),O). +p2m(OC,(A;B),O):- !, p2m(OC,or(A,B),O). +p2m(OC,(A*->B;C),O):- !, p2m(OC,if(A,B,C),O). +p2m(OC,(A->B),O):- !, p2m(OC,det_if_then(A,B),O). +p2m(OC,(A*->B),O):- !, p2m(OC,if(A,B),O). +p2m(_OC,metta_defn(Eq,Self,H,B),'add-atom'(Self,[Eq,H,B])). +p2m(_OC,metta_type,'get-type'). +p2m(_OC,metta_atom,'get-atoms'). +%p2m(_OC,get_metta_atom,'get-atoms'). +p2m(_OC,clause(H,B), ==([=,H,B],'get-atoms'('&self'))). +p2m(_OC,assert(X),'add-atom'('&self',X)). +p2m(_OC,assertz(X),'add-atom'('&self',X)). +p2m(_OC,asserta(X),'add-atom'('&self',X)). +p2m(_OC,retract(X),'remove-atom'('&self',X)). +p2m(_OC,retractall(X),'remove-all-atoms'('&self',X)). +% The catch-all case for the other compound terms. +%p2m(_OC,I,O):- I=..[F|II],maplist(p2m,[F|II],OO),O=..OO. + +% It will break down compound terms into their functor and arguments and apply p2m recursively +p2m(OC,I, O):- + compound(I), + I =.. [F|II], % univ operator to convert between a term and a list consisting of functor name and arguments + maplist(p2m([F|OC]), II, OO), % applying p2m recursively on each argument of the compound term + into_hyphens(F,FF), + O = [FF|OO]. % constructing the output term with the converted arguments + + +% In the context of this conversion predicate, each branch of the p2m predicate +% is handling a different type or structure of term, translating it into its +% equivalent representation in another logic programming language named MeTTa. +% The actual transformations are dependent on the correspondence between Prolog +% constructs and MeTTa constructs, as defined by the specific implementations +% of Prolog and MeTTa being used. +prolog_to_metta(V, D) :- + % Perform the translation from Prolog to MeTTa + p2m([progn], V, D),!. + + +% Define predicates to support the transformation from Prolog to MeTTa syntax +% (Continuing the translation from Prolog to MeTTa syntax as per the given code) +% Handle the case where the body is a conjunction of terms +into_sequential(OC,Body, SP) :- + % Check if Body is not a list and convert conjunctions in Body to a list of conjuncts. + \+ is_list(Body), + conjuncts_to_list(Body, List), + is_list(List), % Converts a list of conjunctions into a sequential representation in MeTTa + into_sequential(OC,List, SP), !. +into_sequential([progn|_],Nothing,'True'):- Nothing ==[],!. +into_sequential(_OC,Nothing,'Nil'):- Nothing ==[],!. +% If theres only one element +into_sequential(_,[SP],O):- prolog_to_metta(SP,O). +% Otherwise, construct sequential representation using AND. +into_sequential([progn|_],List, SPList) :- + maplist(prolog_to_metta, List, SPList),!. +into_sequential(_CA,List, [AND|SPList]) :- + is_compiled_and(AND), maplist(prolog_to_metta, List, SPList),!. + + + + +list_direct_subdirectories(Directory, DirectSubdirectories) :- + directory_files(Directory, Entries), + findall(Path, + (member(Entry, Entries), + \+ member(Entry, ['.', '..']), % Exclude '.' and '..' + symbolic_list_concat([Directory, '/', Entry], Path), + is_directory(Path)), + DirectSubdirectories). + +% List all subdirectories of a given directory recursively +list_all_subdirectories(Directory, AllSubdirectories) :- + list_direct_subdirectories(Directory, DirectSubdirectories), + findall(Sub, + (member(SubDir, DirectSubdirectories), + list_all_subdirectories(SubDir, Subs), + member(Sub, Subs)), + NestedSubdirectories), + append(DirectSubdirectories, NestedSubdirectories, AllSubdirectories). + +% Processes a list of filenames, applying 'convert_to_metta' to each. + +with_file_lists(Rel,P1,FileSpec):- FileSpec=='.pl',!. +with_file_lists(Rel,P1,FileSpec):- is_list(FileSpec),!, + ignore(maplist(with_file_lists(Rel,P1),FileSpec)). + + +with_file_lists(Rel,P1,Filename):- atomic(Filename), exists_file(Filename),!, + ignore(call(P1,Filename)). + +with_file_lists(Rel,P1,Filename):- + absolute_file_name(Rel, Dir, [access(read), file_errors(fail), file_type(directory)]), + Rel \=@= Dir,!, + with_file_lists(Dir,P1,Filename). +with_file_lists(Rel,P1,Filename):- \+ exists_directory(Rel), !, + with_file_lists('.',P1,Filename). + + +with_file_lists(Rel,P1, File) :- + compound(File), + absolute_file_name(File, Dir, [access(read), relative_to(Rel), file_errors(fail), + extensions(['pl', 'prolog', 'pfc'])]), + '\\=@='(Dir, File), !, + with_file_lists(Rel,P1, Dir). + +with_file_lists(Rel,P1, File) :- + compound(File), + absolute_file_name(File, Dir, [access(read), file_errors(fail),relative_to(Rel), file_type(directory)]), + '\\=@='(Dir, File), !, + with_file_lists(Rel,P1, Dir). + +/* +with_file_lists(Rel,P1, File) :- + compound(File), + absolute_file_name(File, Dir, [access(read), file_errors(fail), file_type(directory)]), + '\\=@='(Dir, File), !, + with_file_lists(Rel,P1, Dir). +with_file_lists(Rel,P1, File) :- + compound(File), !, + absolute_file_name(File, Dir, [access(read), file_errors(fail), file_type(['csv', 'tsv', ''])]), + '\\=@='(Dir, File), !, + with_file_lists(Rel,P1, Dir). +with_file_lists(Rel,P1, File) :- + symbol_contains(File, '*'), + expand_file_name(File, List),List\==[], !, + maplist(with_wild_path(Fnicate), List). +with_file_lists(Rel,P1, File) :- + exists_directory(File), + directory_file_path(File, '*.*sv', Wildcard), + expand_file_name(Wildcard, List), !, + maplist(Fnicate, List). +*/ + + + +with_file_lists(Rel,P1,Wildcard):- atom(Wildcard), + \+ exists_file(Wildcard), + once(atom_contains(Wildcard,'*');atom_contains(Wildcard,'?');atom_contains(Wildcard,'|')), + expand_file_name(Wildcard, Files), Files\==[], !, + ignore(maplist(with_file_lists(Rel,P1),Files)). + +with_file_lists(Rel,P1,Wildcard):- atom(Wildcard), + once(atom_contains(Wildcard,'*');atom_contains(Wildcard,'?');atom_contains(Wildcard,'|')), + \+ exists_file(Wildcard), + absolute_file_name(Wildcard,AbsWildcard,[relative_to(Rel)]), + \+ exists_file(AbsWildcard), + expand_file_name(AbsWildcard, Files), Files\==[], !, + ignore(maplist(with_file_lists(Rel,P1),Files)). + +/* +with_file_lists(Rel,P1,Local):- (Local=='.';Local=='';Local=='*.pl'),Directory = Rel, + absolute_file_name(Directory,AbsDirectory,[relative_to(Rel),file_type(directory)]), + exists_directory(AbsDirectory), + findall(File,directory_source_files(AbsDirectory, File, [recursive(false),if(true)]),Files), + ignore(maplist(with_file_lists(Rel,P1),Files)),!. +*/ +with_file_lists(Rel,P1,Local):- (Local=='**';Local=='**.pl'), + must_det_ll((absolute_file_name(Directory,AbsDirectory,[file_type(directory)]), + exists_directory(AbsDirectory))), + findall(File,directory_source_files(AbsDirectory, File, [recursive(true),if(true)]),Files),!, + ignore(maplist(with_file_lists(Rel,P1),Files)). + + +with_file_lists(Rel,P1,Filename):- + symbolic_list_concat(['**',S|More],'/',Filename), + symbolic_list_concat([S|More],'/',Rest), + list_all_subdirectories(Rel, AllSubdirectories),!, + forall(member(SubDir,AllSubdirectories),with_file_lists(SubDir,P1,Rest)). + +with_file_lists(Rel,P1,Filename):- + symbolic_list_concat([WildDir,S|More],'/',Filename), + symbolic_list_concat([Rel,WildDir,''],'/',WildMaskDir), + expand_file_name(WildMaskDir, AllSubdirectories), + symbolic_list_concat([S|More],'/',Rest),!, + forall(member(SubDir,AllSubdirectories),with_file_lists(SubDir,P1,Rest)). + + + +with_file_lists(Rel,P1,FileSpec):- atomic(FileSpec), + absolute_file_name(FileSpec,AbsFile,[relative_to(Rel),access(read), file_errors(fail)]), + exists_file(AbsFile), !, ignore(call(P1,AbsFile)). + +with_file_lists(Rel,P1,Directory):- atomic(Directory), + absolute_file_name(Directory,AbsDirectory,[relative_to(Rel),access(read), file_errors(fail), file_type(directory)]), + exists_directory(AbsDirectory), !, + findall(File,directory_source_files(AbsDirectory, File, [recursive(true),if(true)]),Files),!, + ignore(maplist(with_file_lists(Rel,P1),Files)). + +with_file_lists(Rel,P1,Wildcard):- atom(Wildcard), + absolute_file_name(Wildcard,AbsWildcard,[relative_to(Rel)]), + \+ exists_file(AbsWildcard), + expand_file_name(AbsWildcard, Files), Files\==[], !, + ignore(maplist(with_file_lists(Rel,P1),Files)). + +%with_file_lists(Rel,P1,Filename):- must_det_ll(call(P1,Filename)). +with_file_lists(Rel,P1,Filename):- write_src(with_file_lists(Rel,P1,Filename)),nl. + + + + + % Entry point for printing to Metta format. It clears the screen, sets the working directory, + % expands the filenames with a specific extension, and processes each file. + % cls, % Clears the screen (assumes a custom or system-specific implementation). + % with_pwd( + % '/opt/logicmoo_opencog/hyperon-wam/tests/gpt2-like/language_models/', + %Filt = 'tests/gpt2-like/language_models/*.pl', + % Filt = '/opt/logicmoo_opencog/hyperon-wam/tests/performance/nondet_unify/*.pl', + % Finds all Prolog files in the specified directory. + % convert_to_metta(Filt), % Processes each found file. + % MC = '/opt/logicmoo_opencog/hyperon-wam/src/main/metta_convert.pl', + % convert_to_metta(MC), % Processes each found file. + % Example of a no-operation (nop) call for a specific file path, indicating a placeholder or unused example. + %$nop(convert_to_metta('/opt/logicmoo_opencog/hyperon-wam/src/main/metta_convert.pl')). + +default_pl_mask(Mask):- Mask = [ + %'src/main/metta_*.pl', + %'src/main/flybase_*.pl', + '*/*.pl', + '*/*/*.pl', + '*/*/*/.pl', + '*/*/*/*/.pl', + '*/*/*/*/*/.pl', + '*/*/*/*/*/*.pl', + '*.pl' + ],!. +default_pl_mask(Mask):- Mask = ['**/*.pl']. + +convert_to_metta_console :- default_pl_mask(Mask), + ignore(convert_to_metta_console(Mask)),!, writeln(';; convert_to_metta_console. '). + +convert_to_metta_file :- default_pl_mask(Mask), + ignore(convert_to_metta_file(Mask)),!, writeln(';; convert_to_metta_file. '). + + +convert_to_metta :- default_pl_mask(Mask), + %locally(set_prolog_flag(gc,true), + + call( + ignore(convert_to_metta(Mask))),!, writeln(';; convert_to_metta. '). + +ctm:- convert_to_metta. +% Processes a list of filenames, applying 'convert_to_metta' to each. +convert_to_metta_console(FileSpec):- with_file_lists('.',convert_to_metta_now(user_output),FileSpec). +convert_to_metta_file(FileSpec):- with_file_lists('.',convert_to_metta_now(_Create),FileSpec). +convert_to_metta(Filename):- atomic(Filename), exists_file(Filename),!, + ignore(convert_to_metta_file(Filename)), + ignore(convert_to_metta_console(Filename)),!. +convert_to_metta(FileSpec):- with_file_lists('.',convert_to_metta,FileSpec). + +convert_to_metta_now(OutputIn,Filename):- + user_io(convert_to_metta_now_out(OutputIn,Filename)). + +% Processes a single filename by opening the file, translating its content, and then closing the file. +convert_to_metta_now_out(OutputIn,Filename):- + atom(Filename), % Verifies that the filename is an atom. + % Generate the new filename with .metta extension. + file_name_extension(Base, _OldExt, Filename), + file_name_extension(Base, metta, NewFilename), + file_base_name(Base,Module), + % Setup step: open both the input and output files. + %format('~N~n~w~n', [convert_to_metta(Filename,NewFilename)]), % Prints the action being performed. + convert_to_metta_file(Module,OutputIn,Filename,NewFilename). + +write_src_cmt(G):- ignore((with_output_to(string(S),write_src(G)),in_cmt(write(S)))). + +convert_to_metta_file(Module,OutputIn,Filename,NewFilename):- + + copy_term(OutputIn,Output), + + if_t(var(OutputIn), + user_io(write_src_cmt(convert_to_metta_file(Module,OutputIn,Filename,NewFilename)))), + %Output = user_output, + setup_call_cleanup( + open(Filename, read, Input, [encoding(iso_latin_1)]), + % Call step: perform the translation and write to the output file. + setup_call_cleanup( + (if_t(var(Output),open(NewFilename, write, Output, [encoding(utf8)]))), + with_output_to(Output, + (write_src_cmt(convert_to_metta_file(Module,OutputIn,Filename,NewFilename)), + translate_to_metta(Module,Input))), + % Cleanup step for the output file: close the output stream. + close(Output) + ), + % Cleanup step for the input file: close the input stream. + close(Input) + ). + +into_namings(N=V):- ignore(V='$VAR'(N)). + +% Recursively translates content, stopping at the end of the file. +translate_to_metta(Module,Input):- + at_end_of_stream(Input), % Checks for the end of the file. + !, nl. + +% Processes whitespace characters, maintaining their presence in the output. +translate_to_metta(Module,Input):- + peek_char(Input, Char), % Peeks at the next character without consuming it. + is_reprint_char(Char), !, + get_char(Input, _), % Consumes the character. + put_char(Char), % Prints the character. + translate_to_metta(Module,Input). + +% Converts Prolog comments to Metta-style comments, then continues processing. + translate_to_metta(Module,Input):- + peek_char(Input, Char), + Char == '%', % Checks for Prolog comment start. + get_char(Input, _), put_char(';'), + read_line_to_string(Input, Cmt), % Reads the comment line. + print_metta_comments(Cmt),nl, % Converts and prints the comment in Metta style. + translate_to_metta(Module,Input). % Continues with the next line. + + translate_to_metta(Module,Input):- + peek_char(Input, Char), + Char == '#', % Checks for Prolog comment start. + get_char(Input, _), put_char(';'), + read_line_to_string(Input, Cmt), % Reads the comment line. + print_metta_comments(Cmt),nl, % Converts and prints the comment in Metta style. + translate_to_metta(Module,Input). % Continues with the next line. + +% Reads a clause along with its metadata, then continues translation. +translate_to_metta(Module,Input):- + read_clause_with_info(Input),!, + translate_to_metta(Module,Input). + +% Helper predicates and processing functions follow... + +% Determines if a character should be reprinted (spaces and period). +is_reprint_char(Char):- char_type(Char, space). +is_reprint_char(Char):- Char == '.'. + +% Translates Prolog comments to Metta comments, applying string replacements. +translate_comment(Cmt,Str):- replace_in_string(["%"=";", + "prolog"="MeTTa", + "PROLOG"="MeTTa", + "Prolog"="MeTTa"],Cmt,Str). + +% Reads a clause while capturing various pieces of metadata. + +read_clause_with_info(Stream) :- at_end_of_stream(Stream),!. +read_clause_with_info(Stream):- catch(read_clause_with_info_0(Stream),E, + ((user_io(write_src_cmt(E)),write_src_cmt(E)))). + +read_clause_with_info_0(Stream) :- + Options = [ variable_names(Bindings), + term_position(Pos), + subterm_positions(RawLayout), + syntax_errors(error), + comments(Comments), + module(trans_mod)], + read_term(Stream, Term, Options), + ( (fail,Term == end_of_file) + -> true + ; b_setval('$term_position', Pos), + b_setval('$variable_names', Bindings), + display_term_info(Stream, Term, Bindings, Pos, RawLayout, Comments)). + +% Displays term information and processes comments. +display_term_info(Stream, Term, Bindings, Pos, RawLayout, Comments):- + maplist(into_namings,Bindings), + ignore(process_term(Stream,Term)), + print_metta_comments(Comments),!. + +print_metta_comments(Comments):- print_metta_comment(Comments). +print_metta_comment([]):-!. +print_metta_comment(_TP-Cmt):-!, print_metta_comment(Cmt). +print_metta_comment([Cmt|Cs]):- !, print_metta_comment(Cmt),!, print_metta_comment(Cs). +print_metta_comment(Cmt):- translate_comment(Cmt,String), print_cmt_lines(String). + +print_cmt_lines(String):- + normalize_space(string(TaxM),String), + atomics_to_string(List,'\n',TaxM),!, + maplist(print_cmt_line,List). +print_cmt_line(Str):- format('~N; ~w',[Str]). + + +echo_as_commnents_until_eof(Stream):- + repeat, + (at_end_of_stream(Stream)-> !; + (read_line_to_string(Stream,Cmt), + ignore((print_metta_comments(Cmt))), + fail)). + + + +% Processes each term based on its type (directive or other). +process_term(Stream,end_of_file):- !, echo_as_commnents_until_eof(Stream). +process_term(Stream,Term):- + is_directive(Term), + ignore(maybe_call_directive(Stream,Term)), + !, ignore(print_directive(Term)). +process_term(_,Term):- + expand_to_hb(Term,H,B), + p2m((H:-B),STerm), + push_term_ctx(Term), + write_pl_metta(STerm). + +maybe_call_directive(Stream,(:- X)):- !, maybe_call_directive(Stream,X). +maybe_call_directive(_Stream,op(X,F,Y)):- trans_mod:op(X,F,Y). +maybe_call_directive(_Stream,use_module(library(W))):- trans_mod:use_module(library(W)). +maybe_call_directive(Stream,encoding(Enc)):- + set_stream(Stream,encoding(Enc)). + +% Checks if a term is a directive. +is_directive((:- _)). + +push_term_ctx(X):- \+ compound(X),!, + (nb_current(term_ctx,Was)->true;Was=[]), + (Was =@= X -> true; (nb_setval(term_ctx,X),nl)). +push_term_ctx((X:-_)):- !, push_term_ctx(X). +push_term_ctx(X):- compound_name_arity(X,F,_A),push_term_ctx(F). +% Print a Prolog directive in a specific format. +print_directive((:- Directive)):- + push_term_ctx(exec), % pc + p2m([':-'],Directive,STerm), % p2m + write_pl_metta(exec(STerm)). %we + +write_pl_metta(STerm):- + \+ \+ write_pl_metta_0(STerm). + write_pl_metta_0(STerm):- numbervars(STerm,0,_,[singletons(true),attvar(skip)]), + write_src(STerm). + + +:- ensure_loaded(metta_compiler). +:- ensure_loaded(metta_convert). +:- ensure_loaded(metta_types). +:- ensure_loaded(metta_space). +:- ensure_loaded(metta_testing). +:- ensure_loaded(metta_utils). +:- ensure_loaded(metta_printer). +:- ensure_loaded(metta_eval). + + + diff --git a/.Attic/canary_docme/metta_debug.pl b/.Attic/canary_docme/metta_debug.pl new file mode 100644 index 00000000000..9a559cdab09 --- /dev/null +++ b/.Attic/canary_docme/metta_debug.pl @@ -0,0 +1,2181 @@ +/* + * 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. + */ + +:- dynamic(is_cached_call/3). + +%% cached_call(+ForSeconds, :Call) is nondet. +% Attempts to use cached results for Call, or executes Call if no valid cache is present. +% ForSeconds - Expire after so many seconds +% Call - The Goal that is cached +cached_call(ForSeconds, Call) :- + get_time(CurrentTime), % Get the current time for cache validation. + copy_term(Call, CallCopied), % Create a copy of the Call for consistent comparison. + numbervars(CallCopied, 0, _, [attvar(bind)]), % Ensure variables in Call are standardized. + NewerThan is CurrentTime - ForSeconds, % Calculate the cutoff time for cache validity. + ( + % Check if a valid cache entry exists. + is_cached_call(CallCopied, CachedTime, Result), + NewerThan > CachedTime + -> + true % Use cached result if valid. + ; + % Otherwise, execute Call and update cache. + (retractall(is_cached_call(CallCopied, _, _)), % Remove any existing cache for Call. + call_ndet(Call, IsLast), % Execute the Call, expecting it to be nondeterministic. + nop(assertion(IsLast)), % Assert that the last call succeeded, for debugging purposes. + assertz(is_cached_call(CallCopied, CurrentTime, Result)) % Cache the new result. + ) + ), + Call = Result. % Return the result. + + +%% debugging_metta(+G) is nondet. +% Debugging utility for metta-related goals. +debugging_metta(G) :- notrace((is_debugging((eval)) -> ignore(G); true)). + + +:- nodebug(metta(eval)). % Ensure no debugging for metta(eval). + +%% depth_to_use(+InDepth, -UseThis) is det. +% Determine a depth value to use, based on a modulo operation. +% InDepth - The input depth. +% UseThis - The depth to actually use, calculated by modulo 50. +depth_to_use(InDepth, UseThis) :- + Depth is abs(InDepth), % Ensure the depth is non-negative. + UseThis is Depth mod 50, % Calculate modulo 50. + !. % Cut to prevent backtracking. +depth_to_use(_InDepth, 5). % Default to depth 5 if other cases fail. + + +%% w_indent(+Depth, :Goal) is det. +% Execute a goal with indentation based on depth. +% Depth - The depth to determine indentation. +% Goal - The goal to execute with indentation. +w_indent(Depth, Goal) :- + must_det_ll(( + depth_to_use(Depth, UseThis), % Determine the depth to use. + format('~N'), % Start a new line. + setup_call_cleanup(i_this(UseThis), Goal, format('~N')) % Execute the goal with indentation. + )). + +%% i_this(+UseThis) is det. +% Helper predicate to create indentation based on depth. +i_this(UseThis) :- + ignore(catch(forall(between(1, UseThis, _), write(' ')), _, true)), % Write indentation spaces. + write(';;'). % End with a delimiter. + +%% indentq2(+Depth, +Term) is det. +% Print a term with indentation based on depth. +% Depth - The depth for indentation. +% Term - The term to print. +indentq2(Depth, Term) :- + w_indent(Depth, format('~q', [Term])), % Print the term with indentation. + !. +indentq2(_Depth, Term) :- + format('~q', [Term]). % Fallback printing without indentation. + +%% print_padded(+EX, +DR, +AR) is det. +% Print a padded line with extra formatting, if certain conditions are met. +% EX - The EX component for padding. +% DR - The DR component for padding. +% AR - The AR component to print. +print_padded(_DR, _EX, _AR) :- is_fast_mode, !. % Skip printing in fast mode. +print_padded(EX, DR, AR) :- + integer(EX), integer(DR), EX > 0, DR > 0, + nb_current('$print_padded', print_padded(EX, DR, _)), % Check if padding is active. + !, + format("~| |", []), % Print the initial padding. + DRA is abs(round(DR) mod 24), % Calculate padding size. + forall(between(2, DRA, _), write(' |')), % Write additional padding. + write(' '), write(' '), write(AR). % Write the AR value. +print_padded(EX, DR, AR) :- + format("~|~` t~d~5+:~d~5+|", [EX, DR]), % Print padded EX and DR values. + nb_setval('$print_padded', print_padded(EX, DR, AR)), % Set the current padding. + DRA is abs(round(DR) mod 24), % Calculate padding size. + forall(between(1, DRA, _), write(' |')), % Write additional padding. + write('-'), write(AR). % Write the AR value. + +%% indentq_d(+Depth, +Prefix4, +Message) is det. +% Print a message with depth-based indentation and prefix. +% Depth - The depth for indentation. +% Prefix4 - The prefix to include. +% Message - The message to print. +indentq_d(_DR, _EX, _AR) :- is_fast_mode, !. % Skip printing in fast mode. +indentq_d(Depth, Prefix4, Message) :- + flag(eval_num, EX0, EX0), + EX is EX0 mod 500, + DR is 99 - (Depth mod 100), + indentq(DR, EX, Prefix4, Message). % Call indentq with the formatted values. + +%% indentq(+DR, +EX, +AR, +Term) is det. +% Print a term with depth and EX-based indentation. +% DR - Depth for indentation. +% EX - EX component for formatting. +% AR - AR component for formatting. +% Term - The term to print. +indentq(_DR, _EX, _AR, _Term) :- is_fast_mode, !. % Skip printing in fast mode. +indentq(DR, EX, AR, retval(Term)) :- + nonvar(Term), !, + indentq(DR, EX, AR, Term). % Handle return values specially. +indentq(DR, EX, AR, [E, Term]) :- + E == e, !, + indentq(DR, EX, AR, Term). % Special case for list elements. +%indentq(_DR,_EX,_AR,_Term):- flag(trace_output_len,X,X+1), XX is (X mod 1000), XX>100,!. +indentq(DR, EX, AR, ste(S, Term, E)) :- !, + indentq(DR, EX, AR, S, Term, E). % Special case for structured terms. +indentq(DR, EX, AR, Term) :- + indentq(DR, EX, AR, '', Term, ''). % Default case with empty prefix/suffix. + +%% indentq(+DR, +EX, +AR, +S, +Term, +E) is det. +% Print a term with depth-based indentation, including start and end strings. +% DR - Depth for indentation. +% EX - EX component for formatting. +% AR - AR component for formatting. +% S - Start string. +% Term - The term to print. +% E - End string. +indentq(DR, EX, AR, S, Term, E) :- + setup_call_cleanup( + notrace(format('~N;')), + ( + wots(Str, indentq0(DR, EX, AR, S, Term, E)), % Format the term. + newlines_to_spaces(Str, SStr), % Convert newlines to spaces. + write(SStr) % Write the formatted string. + ), + notrace(format('~N')) % End with a newline. + ). + +%% newlines_to_spaces(+Str, -SStr) is det. +% Convert newlines in a string to spaces. +% Str - Input string with newlines. +% SStr - Output string with spaces. +newlines_to_spaces(Str, SStr) :- + atomics_to_string(L, '\n', Str), % Split the string by newlines. + atomics_to_string(L, ' ', SStr). % Join the parts with spaces. + +%% indentq0(+DR, +EX, +AR, +S, +Term, +E) is det. +% Print a term with padding and depth-based indentation. +% DR - Depth for indentation. +% EX - EX component for formatting. +% AR - AR component for formatting. +% S - Start string. +% Term - The term to print. +% E - End string. +indentq0(DR, EX, AR, S, Term, E) :- + as_trace(( + print_padded(EX, DR, AR), % Print the padded line. + format(S, []), % Print the start string. + with_indents(false, write_src(Term)), % Print the term. + format(E, []) % Print the end string. + )). + +%% reset_eval_num is det. +% Reset evaluation-related flags. +reset_eval_num :- + flag(eval_num, _, 0), % Reset eval_num flag. + flag(trace_output_len, _, 0). % Reset trace_output_len flag. + +%% reset_only_eval_num is det. +% Reset only the eval_num flag. +reset_only_eval_num :- + flag(eval_num, _, 0). % Reset eval_num flag. + +%% is_fast_mode is semidet. +% Check if the system is in fast mode. +is_fast_mode :- fail, \+ is_debugging(eval), !. + +%% ignore_trace_once(:Goal) is nondet. +% Ignore trace for a single execution of a goal. +% Goal - The goal to execute. +ignore_trace_once(Goal) :- ignore(notrace(catch(ignore(Goal), _, fail))), !. +%ignore_trace_once(Goal):- must_det_ll(Goal). + +%% as_trace(:Goal) is nondet. +% Execute a goal while suppressing trace output. +% Goal - The goal to execute. +as_trace(Goal) :- + ignore_trace_once(\+ with_no_screen_wrap(color_g_mesg('#2f2f2f', Goal))). + +%% with_no_screen_wrap(:Goal) is nondet. +% Execute a goal without screen wrapping. +% Goal - The goal to execute. +with_no_screen_wrap(Goal) :- !, call(Goal). +with_no_screen_wrap(Goal) :- with_no_wrap(6000, Goal). + +%% with_no_wrap(+Cols, :Goal) is nondet. +% Execute a goal with a specific number of columns, without wrapping. +% Cols - Number of columns to use. +% Goal - The goal to execute. +with_no_wrap(Cols, Goal) :- + % Setup: Save current terminal settings and disable line wrapping + setup_call_cleanup( + begin_no_wrap(Cols, OriginalCols, OriginalRows), % Begin no-wrap mode. + Goal, % Execute the goal. + end_no_wrap(OriginalCols, OriginalRows) % Restore original settings. + ). + +%% begin_no_wrap(+Cols, -OriginalCols, -OriginalRows) is det. +% Begin no-wrap mode by setting terminal size. +% Cols - Desired number of columns. +% OriginalCols - Original number of columns. +% OriginalRows - Original number of rows. +begin_no_wrap(Cols, OriginalCols, OriginalRows) :- + cached_call(30.0, get_current_terminal_settings(OriginalCols, OriginalRows)), % Get current terminal settings. + set_terminal_size(Cols, OriginalRows), % Set the new terminal size. + format('~s', ["\e[?7l"]). % Disable line wrapping. + +%% end_no_wrap(+OriginalCols, +OriginalRows) is det. +% End no-wrap mode by restoring terminal size. +% OriginalCols - Original number of columns. +% OriginalRows - Original number of rows. +end_no_wrap(OriginalCols, OriginalRows) :- + set_terminal_size(OriginalCols, OriginalRows), % Restore original terminal size. + format('~s', ["\e[?7h"]). % Re-enable line wrapping. + +%% get_current_terminal_settings(-Cols, -Rows) is det. +% Get the current terminal size. +% Cols - Number of columns. +% Rows - Number of rows. +get_current_terminal_settings(Cols, Rows) :- + % Use 'stty size' to get the current dimensions of the terminal + process_create(path(stty), ['size'], [stdout(pipe(Stream))]), % Execute stty size command. + read_line_to_string(Stream, SizeStr), % Read the output. + close(Stream), % Close the stream. + split_string(SizeStr, " ", "", [RowsStr, ColsStr]), % Split the string into rows and columns. + number_string(Rows, RowsStr), % Convert rows to number. + number_string(Cols, ColsStr), % Convert columns to number. + !. +get_current_terminal_settings(_, _). + +%% set_terminal_size(+Cols, +Rows) is det. +% Set the terminal size (conceptual, may not work in all terminals). +% Cols - Number of columns. +% Rows - Number of rows. +set_terminal_size(Cols, Rows) :- + % Conceptual; actual resizing may not work in all terminals + if_t(integer(Cols), + if_t(integer(Rows), format('~s~w;~w~s', ["\e[8;", Rows, Cols, "t"]))). + +%% with_debug(+Flag, :Goal) is nondet. +% Execute a goal with debugging enabled based on a flag. +% Flag - Debugging flag. +% Goal - The goal to execute. +with_debug(Flag, Goal) :- + is_debugging(Flag), + !, + call(Goal). +with_debug(Flag, Goal) :- + reset_only_eval_num, + setup_call_cleanup(set_debug(Flag, true), call(Goal), set_debug(Flag, false)). + +%% flag_to_var(+Flag, -Var) is det. +% Convert a debugging flag to a variable name. +% Flag - The debugging flag. +% Var - The resulting variable name. +flag_to_var(Flag, Var) :- atom(Flag), \+ atom_concat('trace-on-', _, Flag), !, atom_concat('trace-on-', Flag, Var). +flag_to_var(metta(Flag), Var) :- !, nonvar(Flag), flag_to_var(Flag, Var). +flag_to_var(Flag, Var) :- Flag = Var. + +%% set_debug(+Flag, +TF) is det. +% Set debugging on or off based on a flag. +% Flag - The debugging flag. +% TF - Boolean flag for true/false. +set_debug(metta(Flag), TF) :- nonvar(Flag), !, set_debug(Flag, TF). +%set_debug(Flag,Val):- \+ atom(Flag), flag_to_var(Flag,Var), atom(Var),!,set_debug(Var,Val). + + +set_debug(Flag, TF) :- TF == 'True', !, set_debug(Flag, true). +set_debug(Flag, TF) :- TF == 'False', !, set_debug(Flag, false). +set_debug(Flag, true) :- !, debug(metta(Flag)). %, flag_to_var(Flag, Var), set_fast_option_value(Var, true). +set_debug(Flag, false) :- nodebug(metta(Flag)). %, flag_to_var(Flag, Var), set_fast_option_value(Var, false). + +%% if_trace(+Flag, :Goal) is nondet. +% Conditionally execute a goal if tracing is enabled for the flag. +% Flag - The tracing flag. +% Goal - The goal to execute. +if_trace(Flag, Goal) :- + notrace(real_notrace((catch_err(ignore((is_debugging(Flag), Goal)), E, + fbug(E --> if_trace(Flag, Goal)))))). + + +%% is_showing(+Flag) is semidet. +% Check if showing is enabled for a flag. +% Flag - The flag to check. +is_showing(Flag) :- fast_option_value(Flag, 'silent'), !, fail. +is_showing(Flag) :- is_verbose(Flag), !. +is_showing(Flag) :- fast_option_value(Flag, 'show'), !. + +%% if_show(+Flag, :Goal) is nondet. +% Conditionally execute a goal if showing is enabled for the flag. +% Flag - The showing flag. +% Goal - The goal to execute. +if_show(Flag, Goal) :- + real_notrace((catch_err(ignore((is_showing(Flag), Goal)), E, + fbug(E --> if_show(Flag, Goal))))). + + +%% fast_option_value(+N, -V) is semidet. +% Get the value of a fast option. +% N - Option name. +% V - Option value. +fast_option_value(N, V) :- atom(N), current_prolog_flag(N, V). + +%% is_verbose(+Flag) is semidet. +% Check if verbose mode is enabled for a flag. +% Flag - The flag to check. +is_verbose(Flag) :- fast_option_value(Flag, 'silent'), !, fail. +is_verbose(Flag) :- fast_option_value(Flag, 'verbose'), !. +is_verbose(Flag) :- is_debugging(Flag), !. + +%% if_verbose(+Flag, :Goal) is nondet. +% Conditionally execute a goal if verbose mode is enabled for the flag. +% Flag - The verbose flag. +% Goal - The goal to execute. +if_verbose(Flag, Goal) :- + real_notrace((catch_err(ignore((is_verbose(Flag), Goal)), E, + fbug(E --> if_verbose(Flag, Goal))))). + +%% maybe_efbug(+SS, :G) is nondet. +% Execute a goal and potentially report it as an efbug. +% SS - The string to report. +% G - The goal to execute. + +%maybe_efbug(SS,G):- efbug(SS,G)*-> if_trace(eval,fbug(SS=G)) ; fail. +maybe_efbug(_, G) :- call(G). + +%% efbug(+_, :G) is nondet. +% Execute a goal, suppressing trace errors. +% _ - Ignored parameter. +% G - The goal to execute. + +%efbug(P1,G):- call(P1,G). +efbug(_, G) :- call(G). + +%% is_debugging_always(+_Flag) is semidet. +% Always return true for debugging, used as a placeholder. +is_debugging_always(_Flag) :- !. + +%% is_debugging(+Flag) is semidet. +% Check if debugging is enabled for a flag. +% Flag - The flag to check. + +%is_debugging(Flag):- !, fail. +is_debugging(Flag) :- var(Flag), !, fail. +is_debugging((A; B)) :- !, (is_debugging(A); is_debugging(B)). +is_debugging((A, B)) :- !, (is_debugging(A), is_debugging(B)). +is_debugging(not(Flag)) :- !, \+ is_debugging(Flag). +is_debugging(Flag) :- Flag == false, !, fail. +is_debugging(Flag) :- Flag == true, !. +%is_debugging(e):- is_testing, \+ fast_option_value(compile,'full'),!. +%is_debugging(e):- is_testing,!. +%is_debugging(eval):- is_testing,!. +%is_debugging(_):-!,fail. +is_debugging(Flag) :- fast_option_value(Flag, 'debug'), !. +is_debugging(Flag) :- fast_option_value(Flag, 'trace'), !. +is_debugging(Flag) :- debugging(metta(Flag), TF), !, TF == true. +%is_debugging(Flag):- debugging(Flag,TF),!,TF==true. +%is_debugging(Flag):- once(flag_to_var(Flag,Var)), +% (fast_option_value(Var,true)->true;(Flag\==Var -> is_debugging(Var))). + +% overflow = trace +% overflow = fail +% overflow = continue +% overflow = debug + +%% trace_eval(:P4, +TNT, +D1, +Self, +X, +Y) is det. +% Perform trace evaluation of a goal, managing trace output and depth. +% P4 - The predicate to call. +% TNT - The trace name/type. +% D1 - The current depth. +% Self - The self-referential term. +% X - Input term. +% Y - Output term. +trace_eval(P4, TNT, D1, Self, X, Y) :- + must_det_ll(( + notrace(( + flag(eval_num, EX0, EX0 + 1), % Increment eval_num flag. + EX is EX0 mod 500, % Calculate EX modulo 500. + DR is 99 - (D1 mod 100), % Calculate DR based on depth. + PrintRet = _, % Initialize PrintRet. + option_else('trace-length', Max, 500), % Get trace-length option. + option_else('trace-depth', DMax, 30) % Get trace-depth option. + )), + quietly((if_t((nop(stop_rtrace), EX > Max), (set_debug(eval, false), MaxP1 is Max + 1, + %set_debug(overflow,false), + nop(format('; Switched off tracing. For a longer trace: !(pragma! trace-length ~w)', [MaxP1])), + nop((start_rtrace, rtrace)))))), + nop(notrace(no_repeats_var(NoRepeats))))), + + ((sub_term(TN, TNT), TNT \= TN) -> true ; TNT = TN), % Ensure proper subterm handling. + %if_t(DR', [TN, X]))) ), + + Ret = retval(fail), !, + + (Display = ( \+ \+ (flag(eval_num, EX1, EX1 + 1), + ((Ret \=@= retval(fail), nonvar(Y)) + -> indentq(DR, EX1, '<--', [TN, Y]) + ; indentq(DR, EX1, '<--', [TN, Ret]))))), + + call_cleanup(( + (call(P4, D1, Self, X, Y) *-> nb_setarg(1, Ret, Y); + (fail, trace, (call(P4, D1, Self, X, Y)))), + ignore((notrace(( \+ (Y \= NoRepeats), nb_setarg(1, Ret, Y)))))), + % cleanup + ignore((PrintRet == 1 -> ignore(Display) ; + (notrace(ignore((( % Y\=@=X, + if_t(DRtrue;(fail,trace,(call(P4,D1,Self,X,Y)),fail)). + + + +:- set_prolog_flag(expect_pfc_file, unknown). + +% ======================================================= +/* +% +%= predicates to examine the state of pfc +% interactively exploring Pfc justifications. +% +% Logicmoo Project PrologMUD: A MUD server written in Prolog +% Maintainer: Douglas Miles +% Dec 13, 2035 +% +*/ +% ======================================================= +% File: /opt/PrologMUD/pack/logicmoo_base/prolog/logicmoo/mpred/pfc_list_triggers.pl +:- if(( ( \+ ((current_prolog_flag(logicmoo_include,Call),Call))) )). +pfc_listing_module :- nop(module(pfc_listing, + [ draw_line/0, + loop_check_just/1, + pinfo/1, + pp_items/2, + pp_item/2, + pp_filtered/1, + pp_facts/2, + pp_facts/1, + pp_facts/0, + pfc_list_triggers_types/1, + pfc_list_triggers_nlc/1, + pfc_list_triggers_1/1, + pfc_list_triggers_0/1, + pfc_list_triggers/1, + pfc_contains_term/2, + pfc_classify_facts/4, + lqu/0, + get_clause_vars_for_print/2, + %pfcWhyBrouse/2, + %pfcWhy1/1, + %pfcWhy/1, + %pfcWhy/0, + pp_rules/0, + pfcPrintSupports/0, + pfcPrintTriggers/0, + print_db_items/1, + print_db_items/2, + print_db_items/3, + print_db_items/4, + print_db_items_and_neg/3, + show_pred_info/1, + show_pred_info_0/1, + pfc_listing_file/0 + ])). + +%:- include('pfc_header.pi'). + +:- endif. + +% Operator declarations +:- op(500, fx, '~'). +:- op(1050, xfx, ('==>')). +:- op(1050, xfx, '<==>'). + :- op(1050,xfx,('<-')). + :- op(1100,fx,('==>')). +:- op(1150, xfx, ('::::')). + +% :- use_module(logicmoo(util/logicmoo_util_preddefs)). + +:- multifile(( + user:portray/1, + user:prolog_list_goal/1, + user:prolog_predicate_name/2, + user:prolog_clause_name/2)). + +:- dynamic user:portray/1. + +%:- dynamic(whybuffer/2). + +%% lqu is semidet. +% Lists all clauses of the predicate que/2. +lqu :- listing(que/2). + +:- ensure_loaded(metta_pfc_base). + +% File : pfcdebug.pl +% Author : Tim Finin, finin@prc.unisys.com +% Author : Dave Matuszek, dave@prc.unisys.com +% Author : Douglas R. Miles, dmiles@teknowledge.com +% Updated: +% Purpose: provides predicates for examining the database and debugging +% for Pfc. + +:- dynamic pfcTraced/1. +:- dynamic pfcSpied/2. +:- dynamic pfcTraceExecution/0. +:- dynamic pfcWarnings/1. + +:- pfcDefault(pfcWarnings(_), pfcWarnings(true)). + +%% pfcQueue is semidet. +% Lists all clauses of the predicate pfcQueue/1. +pfcQueue :- listing(pfcQueue/1). + +%% pfcPrintDB is semidet. +% Prints the entire Pfc database, including facts, rules, triggers, and supports. +pfcPrintDB :- + pfcPrintFacts, + pfcPrintRules, + pfcPrintTriggers, + pfcPrintSupports,!. + +%% printLine is semidet. +% Draws a line in the console output for formatting purposes. +printLine :- ansi_format([underline], "~N=========================================~n", []). + +%% pfcPrintFacts is semidet. +% Prints all facts in the Pfc database. +pfcPrintFacts :- pfcPrintFacts(_, true). + +%% pfcPrintFacts(+Pattern) is semidet. +% Prints all facts in the Pfc database that match a given pattern. +% Pattern - The pattern to match facts against. +pfcPrintFacts(Pattern) :- pfcPrintFacts(Pattern, true). + +%% pfcPrintFacts(+Pattern, +Condition) is semidet. +% Prints all facts in the Pfc database that match a given pattern and condition. +% Pattern - The pattern to match facts against. +% Condition - The condition to filter facts. +pfcPrintFacts(P, C) :- + pfcFacts(P, C, L), + pfcClassifyFacts(L, User, Pfc, _Rule), + printLine, + pfcPrintf("User added facts:~n", []), + pfcPrintitems(User), + printLine, + pfcPrintf("MettaLog-Pfc added facts:~n", []), + pfcPrintitems(Pfc), + printLine,!. + +%% pfcPrintitems(+List) is det. +% Prints a list of items. Note that this predicate clobbers its arguments, so beware. +% List - The list of items to print. +pfcPrintitems([]). +pfcPrintitems([H|T]) :- + % numbervars(H,0,_), + %format('~N ~p.',[H]), + \+ \+ ( pretty_numbervars(H, H1), format(" ", []), portray_clause_w_vars(H1)), + pfcPrintitems(T). + +%% pfcClassifyFacts(+Facts, -UserFacts, -PfcFacts, -RuleFacts) is det. +% Classifies a list of facts into user-added facts, Pfc-added facts, and rule facts. +% Facts - The list of facts to classify. +% UserFacts - The list of user-added facts. +% PfcFacts - The list of Pfc-added facts. +% RuleFacts - The list of rule facts. +pfcClassifyFacts([], [], [], []). + +pfcClassifyFacts([H|T], User, Pfc, [H|Rule]) :- + pfcType(H, rule), + !, + pfcClassifyFacts(T, User, Pfc, Rule). + +pfcClassifyFacts([H|T], [H|User], Pfc, Rule) :- + matches_why_UU(UU), + pfcGetSupport(H, UU), + !, + pfcClassifyFacts(T, User, Pfc, Rule). + +pfcClassifyFacts([H|T], User, [H|Pfc], Rule) :- + pfcClassifyFacts(T, User, Pfc, Rule). + +%% pfcPrintRules is semidet. +% Prints all rules in the Pfc database. +pfcPrintRules :- + printLine, + pfcPrintf("Rules:...~n", []), + bagof_or_nil((P==>Q), clause((P==>Q), true), R1), + pfcPrintitems(R1), + bagof_or_nil((P<==>Q), clause((P<==>Q), true), R2), + pfcPrintitems(R2), + bagof_or_nil((P<-Q), clause((P<-Q), true), R3), + pfcPrintitems(R3), + printLine. + +%% pfcGetTrigger(-Trigger) is nondet. +% Retrieves a trigger from the Pfc database. +% Trigger - The retrieved trigger. +pfcGetTrigger(Trigger) :- pfc_call(Trigger). + +%% pfcPrintTriggers is semidet. +% Pretty prints all triggers in the Pfc database. +pfcPrintTriggers :- + print_db_items("Positive triggers", '$pt$'(_, _)), + print_db_items("Negative triggers", '$nt$'(_, _, _)), + print_db_items("Goal triggers", '$bt$'(_, _)). + +pp_triggers :- pfcPrintTriggers. + +%% pfcPrintSupports is semidet. +% Pretty prints all supports in the Pfc database. +pfcPrintSupports :- + % temporary hack. + draw_line, + fmt("Supports ...~n", []), + setof_or_nil((P =< S), (pfcGetSupport(P, S), \+ pp_filtered(P)), L), + pp_items('Support', L), + draw_line,!. +pp_supports :- pfcPrintSupports. + +%% pp_filtered(+Predicate) is semidet. +% Checks if a predicate should be filtered out from pretty-printing. +% Predicate - The predicate to check. +pp_filtered(P) :- var(P),!,fail. +pp_filtered(_:P) :- !, pp_filtered(P). +pp_filtered(P) :- safe_functor(P, F, A), F\==(/),!, pp_filtered(F/A). +pp_filtered(F/_) :- F==pfc_prop. + +%% pfcFact(+Predicate) is semidet. +% Checks if a fact was asserted into the database via pfcAdd. +% Predicate - The fact to check. +pfcFact(P) :- pfcFact(P, true). + +%% pfcFact(+Predicate, +Condition) is semidet. +% Checks if a fact was asserted into the database via pfcAdd and a condition is satisfied. +% Predicate - The fact to check. +% Condition - The condition to check. +% Example: pfcFact(X,pfcUserFact(X)) +pfcFact(F, C) :- + filter_to_pattern_call(F, P, Call), + pfcFact1(P, C), + pfcCallSystem(Call). + +%% pfcFact1(+Predicate, +Condition) is semidet. +% Helper predicate for pfcFact/2. +% Predicate - The fact to check. +% Condition - The condition to check. +pfcFact1(P, C) :- + pfcGetSupport(P, _), + pfcType(P, fact(_)), + pfcCallSystem(C). + +%% pfcFacts(-ListofPfcFacts) is det. +% Returns a list of facts added to the Pfc database. +% ListofPfcFacts - The list of facts. +pfcFacts(L) :- pfcFacts(_, true, L). + +%% pfcFacts(+Pattern, -ListofPfcFacts) is det. +% Returns a list of facts added to the Pfc database that match a given pattern. +% Pattern - The pattern to match facts against. +% ListofPfcFacts - The list of facts. +pfcFacts(P, L) :- pfcFacts(P, true, L). + +%% pfcFacts(+Pattern, +Condition, -ListofPfcFacts) is det. +% Returns a list of facts added to the Pfc database that match a given pattern and condition. +% Pattern - The pattern to match facts against. +% Condition - The condition to filter facts. +% ListofPfcFacts - The list of facts. +pfcFacts(P, C, L) :- setof_or_nil(P, pfcFact(P, C), L). + +%% brake(+Predicate) is det. +% Calls a system predicate and breaks execution. +% Predicate - The predicate to call. +brake(X) :- pfcCallSystem(X), ibreak. + +%% pfcTraceAdd(+Predicate) is det. +% Adds a predicate to the Pfc trace. +% Predicate - The predicate to trace. +pfcTraceAdd(P) :- + % this is here for upward compat. - should go away eventually. + pfcTraceAdd(P, (o, o)). + +%% pfcTraceAdd(+Trigger, +Support) is det. +% Adds a trigger and its support to the Pfc trace. +% Trigger - The trigger to trace. +% Support - The support of the trigger. +pfcTraceAdd('$pt$'(_, _), _) :- !. % Never trace positive triggers. +pfcTraceAdd('$nt$'(_, _), _) :- !. % Never trace negative triggers. + +pfcTraceAdd(P, S) :- + pfcTraceAddPrint(P, S), + pfcTraceBreak(P, S). + +%% pfcTraceAddPrint(+Predicate, +Support) is det. +% Prints a predicate being added to the Pfc trace. +% Predicate - The predicate to print. +% Support - The support of the predicate. +pfcTraceAddPrint(P, S) :- + pfcIsTraced(P), + !, + \+ \+ (pretty_numbervars(P, Pcopy), + % numbervars(Pcopy,0,_), + matches_why_UU(UU), + (S=UU + -> pfcPrintf("Adding (u) ~@", [fmt_cl(Pcopy)]) + ; pfcPrintf("Adding ~@", [fmt_cl(Pcopy)]))). + +pfcTraceAddPrint(_, _). + +%% pfcTraceBreak(+Predicate, +Support) is det. +% Breaks execution if a predicate is spied in the Pfc trace. +% Predicate - The predicate to check. +% Support - The support of the predicate. +pfcTraceBreak(P, _S) :- + pfcSpied(P, +) -> + (pretty_numbervars(P, Pcopy), + % numbervars(Pcopy,0,_), + pfcPrintf("Breaking on pfcAdd(~p)", [Pcopy]), + ibreak) + ; true. + +%% pfcTraceRem(+Trigger) is det. +% Removes a trigger from the Pfc trace. +% Trigger - The trigger to remove. +pfcTraceRem('$pt$'(_, _)) :- !. % Never trace positive triggers. +pfcTraceRem('$nt$'(_, _)) :- !. % Never trace negative triggers. + +pfcTraceRem(P) :- + (pfcIsTraced(P) + -> pfcPrintf("Removing: ~p.", [P]) + ; true), + (pfcSpied(P, -) + -> (pfcPrintf("Breaking on pfcRem(~p)", [P]), + ibreak) + ; true). + +%% pfcIsTraced(+Predicate) is semidet. +% Checks if a predicate is being traced. +% Predicate - The predicate to check. +pfcIsTraced(P) :- pfcIsNotTraced(P),!,fail. +pfcIsTraced(P) :- compound_eles(1, P, Arg), pfcTraced(Arg). + +%% pfcIsNotTraced(+Predicate) is semidet. +% Checks if a predicate is not being traced. +% Predicate - The predicate to check. +pfcIsNotTraced(P) :- compound_eles(1, P, Arg), pfcIgnored(Arg). + +:- dynamic(pfcIgnored/1). + +%% compound_eles(+Level, +Compound, -Element) is det. +% Extracts elements from a compound term. +% Level - The level of extraction. +% Compound - The compound term. +% Element - The extracted element. +compound_eles(Lvl, P, Arg) :- var(P),!, get_attr(P, A, AV), compound_eles(Lvl, attvar(A, AV), Arg). +compound_eles(Lvl, P, Arg) :- (\+ compound(P); Lvl<1),!, Arg=P. +compound_eles(Lvl, P, Arg) :- LvlM1 is Lvl-1, compound_eles(P, E), compound_eles(LvlM1, E, Arg). + +compound_eles(P, E) :- is_list(P),!, member(E, P). +compound_eles(P, E) :- compound(P), compound_name_arguments(P, F, Args),!, member(E, [F|Args]). + +%% mpred_trace_exec is det. +% Enables tracing and watching in Pfc. +mpred_trace_exec :- pfcWatch, pfcTrace. + +%% mpred_notrace_exec is det. +% Disables tracing and watching in Pfc. +mpred_notrace_exec :- pfcNoTrace, pfcNoWatch. +%% pfcTrace is det. +% Enables tracing in Pfc. +pfcTrace :- pfcTrace(_). + +%% pfcTrace(+Form) is det. +% Enables tracing for a specific form in Pfc. +% Form - The form to trace. +pfcTrace(Form) :- + assert(pfcTraced(Form)). + +%% pfcTrace(+Form, +Condition) is det. +% Enables tracing for a specific form under a given condition in Pfc. +% Form - The form to trace. +% Condition - The condition under which to trace the form. +pfcTrace(Form, Condition) :- + assert((pfcTraced(Form) :- Condition)). + +%% pfcSpy(+Form) is det. +% Adds a form to the Pfc spy list. +% Form - The form to spy on. +pfcSpy(Form) :- pfcSpy(Form, [+,-], true). + +%% pfcSpy(+Form, +Modes) is det. +% Adds a form to the Pfc spy list with specific modes. +% Form - The form to spy on. +% Modes - The modes to use for spying. +pfcSpy(Form, Modes) :- pfcSpy(Form, Modes, true). + +%% pfcSpy(+Form, +Modes, +Condition) is det. +% Adds a form to the Pfc spy list with specific modes and a condition. +% Form - The form to spy on. +% Modes - The modes to use for spying. +% Condition - The condition under which to spy the form. +pfcSpy(Form, [H|T], Condition) :- + !, + pfcSpy1(Form, H, Condition), + pfcSpy(Form, T, Condition). + +pfcSpy(Form, Mode, Condition) :- + pfcSpy1(Form, Mode, Condition). + +%% pfcSpy1(+Form, +Mode, +Condition) is det. +% Helper predicate for pfcSpy/3. +% Form - The form to spy on. +% Mode - The mode to use for spying. +% Condition - The condition under which to spy the form. +pfcSpy1(Form, Mode, Condition) :- + assert((pfcSpied(Form, Mode) :- Condition)). + +%% pfcNospy is det. +% Removes all forms from the Pfc spy list. +pfcNospy :- pfcNospy(_,_,_). + +%% pfcNospy(+Form) is det. +% Removes a specific form from the Pfc spy list. +% Form - The form to remove. +pfcNospy(Form) :- pfcNospy(Form,_,_). + +%% pfcNospy(+Form, +Mode, +Condition) is det. +% Removes a specific form from the Pfc spy list with a given mode and condition. +% Form - The form to remove. +% Mode - The mode to remove. +% Condition - The condition to remove. +pfcNospy(Form, Mode, Condition) :- + clause(pfcSpied(Form, Mode), Condition, Ref), + erase(Ref), + fail. + +pfcNospy(_,_,_). + +%% pfcNoTrace is det. +% Disables tracing in Pfc. +pfcNoTrace :- pfcUntrace. + +%% pfcUntrace is det. +% Untraces all forms in Pfc. +pfcUntrace :- pfcUntrace(_). + +%% pfcUntrace(+Form) is det. +% Untraces a specific form in Pfc. +% Form - The form to untrace. +pfcUntrace(Form) :- retractall(pfcTraced(Form)). + +%% pfcTraceMsg(+Message) is det. +% Traces a message in Pfc. +% Message - The message to trace. +pfcTraceMsg(Msg) :- pfcTraceMsg('~p', [Msg]). + +%% pfcTraceMsg(+Message, +Arguments) is det. +% Traces a message with arguments in Pfc. +% Message - The message to trace. +% Arguments - The arguments for the message. +pfcTraceMsg(Msg, Args) :- + pfcTraceExecution, + !, + pfcPrintf(user_output, Msg, Args). +pfcTraceMsg(Msg, Args) :- + member(P, Args), pfcIsTraced(P), + !, + pfcPrintf(user_output, Msg, Args). +pfcTraceMsg(_, _). + +%% pfcPrintf(+Message, +Arguments) is det. +% Prints a formatted message in Pfc. +% Message - The message to print. +% Arguments - The arguments for the message. +pfcPrintf(Msg, Args) :- + pfcPrintf(user_output, Msg, Args). + +%% pfcPrintf(+Where, +Message, +Arguments) is det. +% Prints a formatted message to a specific location in Pfc. +% Where - The location to print the message. +% Message - The message to print. +% Arguments - The arguments for the message. +pfcPrintf(Where, Msg, Args) :- + format(Where, '~N', []), + with_output_to(Where, + color_g_mesg_ok(blue, format(Msg, Args))). + +%% pfcWatch is det. +% Enables execution tracing in Pfc. +pfcWatch :- clause(pfcTraceExecution, true),!. +pfcWatch :- assert(pfcTraceExecution). + +%% pfcNoWatch is det. +% Disables execution tracing in Pfc. +pfcNoWatch :- retractall(pfcTraceExecution). + +%% pfcError(+Message) is det. +% Prints an error message in Pfc. +% Message - The error message to print. +pfcError(Msg) :- pfcError(Msg, []). + +%% pfcError(+Message, +Arguments) is det. +% Prints an error message with arguments in Pfc. +% Message - The error message to print. +% Arguments - The arguments for the message. +pfcError(Msg, Args) :- + format("~N~nERROR/Pfc: ", []), + format(Msg, Args). + +% % +% % These control whether or not warnings are printed at all. +% % pfcWarn. +% % nopfcWarn. +% % +% % These print a warning message if the flag pfcWarnings is set. +% % pfcWarn(+Message) +% % pfcWarn(+Message,+ListOfArguments) +% % + + + + + + +%% pfcWarn is det. +% Enables warning messages in Pfc. +pfcWarn :- + retractall(pfcWarnings(_)), + assert(pfcWarnings(true)). + +%% nopfcWarn is det. +% Disables warning messages in Pfc. +nopfcWarn :- + retractall(pfcWarnings(_)), + assert(pfcWarnings(false)). + +%% pfcWarn(+Message) is det. +% Prints a warning message in Pfc. +% Message - The warning message to print. +pfcWarn(Msg) :- pfcWarn('~p', [Msg]). + +%% pfcWarn(+Message, +Arguments) is det. +% Prints a warning message with arguments in Pfc. +% Message - The warning message to print. +% Arguments - The arguments for the message. +pfcWarn(Msg, Args) :- + pfcWarnings(true), + !, + ansi_format([underline, fg(red)], "~N==============WARNING/Pfc================~n", []), + ansi_format([fg(yellow)], Msg, Args), + printLine. +pfcWarn(_, _). + +%% pfcWarnings is det. +% Enables warning messages in Pfc. +% sets flag to cause pfc warning messages to print. +pfcWarnings :- + retractall(pfcWarnings(_)), + assert(pfcWarnings(true)). + +%% pfcNoWarnings is det. +% Disables warning messages in Pfc. +% sets flag to cause pfc warning messages not to print. +pfcNoWarnings :- + retractall(pfcWarnings(_)). + +%% pp_facts is semidet. +% Pretty prints all facts in the Pfc database. +pp_facts :- pp_facts(_, true). + +%% pp_facts(+Pattern) is semidet. +% Pretty prints facts in the Pfc database that match a given pattern. +% Pattern - The pattern to match facts against. +pp_facts(Pattern) :- pp_facts(Pattern, true). + +%% pp_facts(+Pattern, +Condition) is semidet. +% Pretty prints facts in the Pfc database that match a given pattern and condition. +% Pattern - The pattern to match facts against. +% Condition - The condition to filter facts. +pp_facts(P, C) :- + pfcFacts(P, C, L), + pfc_classify_facts(L, User, Pfc, _Rule), + draw_line, + fmt("User added facts:", []), + pp_items(user, User), + draw_line, + draw_line, + fmt("MettaLog-Pfc added facts:", []), + pp_items(system, Pfc), + draw_line. + +%% pp_deds is semidet. +% Pretty prints all deduced facts in the Pfc database. +pp_deds :- pp_deds(_, true). + +%% pp_deds(+Pattern) is semidet. +% Pretty prints deduced facts in the Pfc database that match a given pattern. +% Pattern - The pattern to match facts against. +pp_deds(Pattern) :- pp_deds(Pattern, true). + +%% pp_deds(+Pattern, +Condition) is semidet. +% Pretty prints deduced facts in the Pfc database that match a given pattern and condition. +% Pattern - The pattern to match facts against. +% Condition - The condition to filter facts. +pp_deds(P, C) :- + pfcFacts(P, C, L), + pfc_classify_facts(L, _User, Pfc, _Rule), + draw_line, + fmt("MettaLog-Pfc added facts:", []), + pp_items(system, Pfc), + draw_line. + +%% show_deds_w(+Pattern) is semidet. +% Shows deduced facts that match a given pattern. +% Pattern - The pattern to match deduced facts against. +show_deds_w(F) :- pp_deds(F). + +%% show_info(+Pattern) is semidet. +% Shows information about facts that match a given pattern. +% Pattern - The pattern to match facts against. +show_info(F) :- + pfcFacts(_, true, L), + include(sub_functor(F), L, FL), + pfc_classify_facts(FL, User, Pfc, _Rule), + draw_line, + fmt("User added facts with ~q:", [F]), + pp_items(user, User), + draw_line, + draw_line, + fmt("MettaLog-Pfc added facts with ~q:", [F]), + pp_items(system, Pfc), + draw_line. + +%% maybe_filter_to_pattern_call(+Pattern, +Predicate, -Condition) is det. +% Converts a pattern and predicate to a condition for filtering. +% Pattern - The pattern to filter. +% Predicate - The predicate to filter. +% Condition - The resulting condition. +maybe_filter_to_pattern_call(F, _, true) :- var(F), !, fail. +maybe_filter_to_pattern_call(F, P, true) :- atom(F), !, (P = F ; freeze(P, (P \== F, sub_functor(F, P)))). +maybe_filter_to_pattern_call(F, P, true) :- \+ compound(F), !, P = _ ; freeze(P, (P \== F, sub_functor(F, P))). +maybe_filter_to_pattern_call(F/A, P, true) :- !, freeze(P, (P \== F, sub_functor(F/A, P))). +%maybe_filter_to_pattern_call(F,P,true):-P=F. + +%% filter_to_pattern_call(+Pattern, +Predicate, -Condition) is det. +% Converts a pattern and predicate to a condition for filtering, with alternative handling. +% Pattern - The pattern to filter. +% Predicate - The predicate to filter. +% Condition - The resulting condition. +filter_to_pattern_call(F, P, Call) :- + maybe_filter_to_pattern_call(F, P, Call) *-> true; alt_filter_to_pattern_call(F, P, Call). + +%% alt_filter_to_pattern_call(+Pattern, +Predicate, -Condition) is det. +% Alternative handling for filter_to_pattern_call/3. +% Pattern - The pattern to filter. +% Predicate - The predicate to filter. +% Condition - The resulting condition. +alt_filter_to_pattern_call(P, P, true). + +%% sub_functor(+Functor, +Term) is semidet. +% Checks if a term contains a specific functor. +% Functor - The functor to check for. +% Term - The term to check. +sub_functor(F-UnF, Term) :- !, sub_functor(F, Term), \+ sub_functor(UnF, Term). +sub_functor(F, Term) :- var(F), !, sub_var(F, Term), !. +sub_functor(F/A, Term) :- !, sub_term(E, Term), compound(E), compound_name_arity(E, F, A). +sub_functor(F, Term) :- sub_term(E, Term), E =@= F, !. +sub_functor(F, Term) :- sub_term(E, Term), compound(E), compound_name_arity(E, FF, AA), (AA == F ; FF == F). + +%% pp_items(+Type, +Items) is semidet. +% Pretty prints a list of items. +% Type - The type of items. +% Items - The list of items to print. +pp_items(_Type, []) :- !. +pp_items(Type, [H|T]) :- + ignore(pp_item(Type, H)), !, + pp_items(Type, T). +pp_items(Type, H) :- ignore(pp_item(Type, H)). + +:- thread_local t_l:print_mode/1. + +%% pp_item(+Mode, +Item) is semidet. +% Pretty prints a single item. +% Mode - The mode for printing. +% Item - The item to print. +pp_item(_M, H) :- pp_filtered(H), !. +pp_item(MM, (H :- B)) :- B == true, pp_item(MM, H). +pp_item(MM, H) :- flag(show_asserions_offered, X, X+1), find_and_call(get_print_mode(html)), (\+ \+ if_defined(pp_item_html(MM, H))), !. + +pp_item(MM, '$spft$'(W0, U, ax)) :- W = (_KB:W0), !, pp_item(MM, U:W). +pp_item(MM, '$spft$'(W0, F, U)) :- W = (_KB:W0), atom(U), !, fmt('~N%~n', []), pp_item(MM, U:W), fmt('rule: ~p~n~n', [F]), !. +pp_item(MM, '$spft$'(W0, F, U)) :- W = (_KB:W0), !, fmt('~w~nd: ~p~nformat: ~p~n', [MM, W, F]), pp_item(MM, U). +pp_item(MM, '$nt$'(Trigger0, Test, Body)) :- Trigger = (_KB:Trigger0), !, fmt('~w n-trigger(-): ~p~ntest: ~p~nbody: ~p~n', [MM, Trigger, Test, Body]). +pp_item(MM, '$pt$'(F0, Body)) :- F = (_KB:F0), !, fmt('~w p-trigger(+):~n', [MM]), pp_item('', (F:-Body)). +pp_item(MM, '$bt$'(F0, Body)) :- F = (_KB:F0), !, fmt('~w b-trigger(?):~n', [MM]), pp_item('', (F:-Body)). + +pp_item(MM, U:W) :- !, format(string(S), '~w ~w:', [MM, U]), !, pp_item(S, W). +pp_item(MM, H) :- \+ \+ (get_clause_vars_for_print(H, HH), fmt("~w ~p~N", [MM, HH])). +%% get_clause_vars_for_print(+Clause, -ClauseWithVars) is det. +% Prepares a clause for printing by handling variables. +% Clause - The clause to prepare. +% ClauseWithVars - The clause with variables prepared for printing. +get_clause_vars_for_print(HB, HB) :- ground(HB), !. +get_clause_vars_for_print(I, I) :- is_listing_hidden(skipVarnames), fail. +get_clause_vars_for_print(H0, MHB) :- get_clause_vars_copy(H0, MHB), H0 \=@= MHB, !. +get_clause_vars_for_print(HB, HB) :- numbervars(HB, 0, _, [singletons(true), attvars(skip)]), !. + +%% pfc_classify_facts(+Facts, -UserFacts, -PfcFacts, -Rules) is det. +% Classifies facts into user facts, Pfc deductions, and rules. +% Facts - The facts to classify. +% UserFacts - The User Added facts. +% PfcFacts - The System Added facts. +% Rules - Classified as rules +pfc_classify_facts([],[],[],[]). + +pfc_classify_facts([H|T],User,Pfc,[H|Rule]) :- + pfcType(H,rule), + !, + pfc_classify_facts(T,User,Pfc,Rule). + +pfc_classify_facts([H|T],[H|User],Pfc,Rule) :- + pfcGetSupport(H,(mfl4(_VarNameZ,_,_,_),ax)), + !, + pfc_classify_facts(T,User,Pfc,Rule). + +pfc_classify_facts([H|T],User,[H|Pfc],Rule) :- + pfc_classify_facts(T,User,Pfc,Rule). + + +%= + +% % print_db_items( ?T, ?I) is semidet. +% +% Print Database Items. +% T - The title or label for the items being printed. +% I - The items or goals to be printed. +% +print_db_items(T, I):- + draw_line, % Draw a separator line before printing. + fmt("~N~w ...~n",[T]), % Print the title. + print_db_items(I), % Print the database items. + draw_line, % Draw a separator line after printing. + !. + +%= + +%% print_db_items( ?I) is semidet. +% +% Print Database Items. +% I - The predicate or item to be printed. +% +print_db_items(F/A):- + number(A),!, % Check if A is a number, ensuring F/A is a valid functor/arity pair. + safe_functor(P,F,A),!, % Safely create a functor from F and A. + print_db_items(P). % Print the functor. +print_db_items(H):- + bagof(H,clause(H,true),R1), % Collect all clauses matching H into a list R1. + pp_items((':'),R1), % Pretty print the collected items. + R1\==[],!. % Succeed if the list is non-empty. +print_db_items(H):- + \+ current_predicate(_,H),!. % Succeed if H is not a current predicate. +print_db_items(H):- + catch( ('$find_predicate'(H,_),call_u(listing(H))),_,true),!, % Try to list the predicate, catching any errors. + nl,nl. % Print two newlines after listing. + +%= + +% % pp_rules is semidet. +% +% Pretty Print Rules. +% This predicate prints different types of rules and facts in the database. +% +pp_rules :- + print_db_items("Forward Rules",(_ ==> _)), % Print forward rules. + print_db_items("Bidirectional Rules",(_ <==> _)), % Print bidirectional rules. + print_db_items("Implication Rules",=>(_ , _)), % Print implication rules. + print_db_items("Bi-conditional Rules",<=>(_ , _)), % Print bi-conditional rules. + print_db_items("Backchaining Rules",(_ <- _)), % Print backchaining rules. + print_db_items("Positive Facts",(==>(_))), % Print positive facts. + print_db_items("Negative Facts",(~(_))). % Print negative facts. + +%= + +% % draw_line is semidet. +% +% Draw Line. +% This predicate draws a line separator in the console output. +% +draw_line:- + \+ thread_self_main,!. % Do nothing if not in the main thread. +draw_line:- printLine,!. % Attempt to use printLine to draw a line. +draw_line:- + (t_l:print_mode(H)->true;H=unknown), % Get the current print mode or set to unknown. + fmt("~N% % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %~n",[]), % Draw the line using format. + H=H. + +:- meta_predicate loop_check_just(0). + +%= + +% % loop_check_just( :GoalG) is semidet. +% +% Loop Check Justification. +% GoalG - The goal to check for loops. +% +loop_check_just(G):- + loop_check(G,ignore(arg(1,G,[]))). % Perform loop check, ignoring goals with an empty first argument. + +%= + +% % show_pred_info( ?F) is semidet. +% +% Show Predicate Info. +% PI - The predicate indicator (F/A) for which information is to be shown. +% +show_pred_info(PI):- + (( + pi_to_head_l(PI,Head), % Convert predicate indicator to head. + % doall(show_call(why,call_u(isa(Head,_)))), + safe_functor(Head,F,_), % Extract the functor from the head. + doall(show_call(why,call_u(isa(F,_)))), % Show all instances where F is a certain type. + ((current_predicate(_,M:Head), (\+ predicate_property(M:Head,imported_from(_)))) + -> show_pred_info_0(M:Head); % Show predicate info if not imported. + wdmsg_pretty(cannot_show_pred_info(Head))))),!. % Display a message if unable to show info. + +%= + +% % show_pred_info_0( ?Head) is semidet. +% +% Show Predicate Info Primary Helper. +% Head - The head of the predicate for which information is to be shown. +% +show_pred_info_0(Head):- + doall(show_call(why,predicate_property(Head,_))), % Show all properties of the predicate. + (has_cl(Head)->doall((show_call(why,clause(Head,_))));quietly((listing(Head)))),!. % List the predicate clauses or show the listing. + +% =================================================== +% Pretty Print Formula +% =================================================== + +%= + +% % print_db_items( ?Title, ?Mask, ?What) is semidet. +% +% Print Database Items. +% Title - The title to be printed. +% Mask - The mask or pattern to match. +% What - The items to print. +% +print_db_items(Title,Mask,What):- + print_db_items(Title,Mask,Mask,What). % Print items with the given title, mask, and what parameters. + +%= + + +%% print_db_items(+Title, +Mask, +Show, +What) is semidet. +% Prints database items based on a mask, show predicate, and a condition. +% Title - The title for the items. +% Mask - The mask to filter items. +% Show - The show predicate for the items. +% What - The condition to filter items. +print_db_items(Title, Mask, Show, What0) :- + get_pi(Mask, H), get_pi(What0, What), + format(atom(Showing), '~p for ~p...', [Title, What]), + statistics(cputime, Now), Max is Now + 2, !, + gripe_time(1.0, + doall((once(statistics(cputime, NewNow)), NewNow < Max, clause_or_call(H, B), + quietly(pfc_contains_term(What, (H:-B))), + flag(print_db_items, LI, LI+1), + ignore(quietly(pp_item(Showing, Show)))))), + ignore(pp_item(Showing, done)),!. + +%% pfc_contains_term(+Term, +Inside) is semidet. +% Checks if a term contains another term. +% Term - The term to check. +% Inside - The term to look for inside the term. +pfc_contains_term(What, _) :- is_ftVar(What), !. +pfc_contains_term(What, Inside) :- compound(What), !, (\+ \+ ((copy_term_nat(Inside, Inside0), snumbervars(Inside0), occurs:contains_term(What, Inside0)))), !. +pfc_contains_term(What, Inside) :- (\+ \+ once((subst(Inside, What, foundZadooksy, Diff), Diff \=@= Inside ))), !. + +%% hook_pfc_listing(+What) is semidet. +% Hook for Pfc listing. +% What - The condition to filter items. +:- current_prolog_flag(pfc_shared_module, BaseKB), + assert_if_new((BaseKB:hook_pfc_listing(What) :- on_x_debug(pfc_list_triggers(What)))). + +:- thread_local t_l:pfc_list_triggers_disabled/0. +% listing(L):-locally(t_l:pfc_list_triggers_disabled,listing(L)). + + +%% pfc_list_triggers(+What) is semidet. +% Lists triggers in the Pfc database. +% What - The condition to filter triggers. +pfc_list_triggers(_) :- t_l:pfc_list_triggers_disabled, !. +pfc_list_triggers(What) :- loop_check(pfc_list_triggers_nlc(What)). + +%% pfc_list_triggers_nlc(+What) is semidet. +% Lists triggers in the Pfc database (no loop check). +% What - The condition to filter triggers. +:- meta_predicate(pfc_list_triggers_nlc(?)). +pfc_list_triggers_nlc(MM:What) :- atom(MM), !, MM:pfc_list_triggers(What). +pfc_list_triggers_nlc(What) :- loop_check(pfc_list_triggers_0(What), true). + +%% pfc_list_triggers_0(+What) is semidet. +% Lists triggers in the Pfc database (primary helper). +% What - The condition to filter triggers. +pfc_list_triggers_0(What) :- get_pi(What, PI), PI \=@= What, pfc_list_triggers(PI). +pfc_list_triggers_0(What) :- nonvar(What), What = ~(Then), !, \+ \+ pfc_list_triggers_1(Then), \+ \+ pfc_list_triggers_1(What). +pfc_list_triggers_0(What) :- \+ \+ pfc_list_triggers_1(~(What)), \+ \+ pfc_list_triggers_1(What). + +%% pfc_list_triggers_types(-TriggerType) is semidet. +% Lists trigger types in the Pfc database. +% TriggerType - The trigger type to list. +pfc_list_triggers_types('Triggers'). +pfc_list_triggers_types('Instances'). +pfc_list_triggers_types('Subclasses'). +pfc_list_triggers_types('ArgTypes'). +pfc_list_triggers_types('Arity'). +pfc_list_triggers_types('Forward'). +pfc_list_triggers_types('Bidirectional'). +pfc_list_triggers_types('Backchaining'). +pfc_list_triggers_types('Negative'). +pfc_list_triggers_types('Sources'). +pfc_list_triggers_types('Supports'). +pfc_list_triggers_types('Edits'). + +%% print_db_items_and_neg(+Title, +Fact, +What) is semidet. +% Prints database items and their negations. +% Title - The title for the items. +% Fact - The fact to check. +% What - The condition to filter items. +print_db_items_and_neg(Title, Fact, What) :- print_db_items(Title, Fact, What). +print_db_items_and_neg(Title, Fact, What) :- print_db_items(Title, ~(Fact), What). + +%% pfc_list_triggers_1(+What) is semidet. +% Lists triggers in the Pfc database (secondary helper). +% What - The condition to filter triggers. +pfc_list_triggers_1(What) :- var(What), !. +pfc_list_triggers_1(~(What)) :- var(What), !. +pfc_list_triggers_1(~(_What)) :- !. +pfc_list_triggers_1(What) :- + print_db_items('Supports User', spft_precanonical(P, mfl4(VarNameZ, _, _, _), ax), '$spft$'(P, mfl4(VarNameZ, _, _, _), ax), What), + print_db_items('Forward Facts', (nesc(F)), F, What), + print_db_items('Forward Rules', (_==>_), What), + ignore((What\= ~(_), safe_functor(What, IWhat, _), + print_db_items_and_neg('Instance Of', isa(IWhat, _), IWhat), + print_db_items_and_neg('Instances: ', isa(_, IWhat), IWhat), + print_db_items_and_neg('Subclass Of', genls(IWhat, _), IWhat), + print_db_items_and_neg('Subclasses: ', genls(_, IWhat), IWhat))), + forall(suggest_m(M), print_db_items('PFC Watches', pfc_prop(M, _, _, _), What)), + print_db_items('Triggers Negative', '$nt$'(_, _, _, _), What), + print_db_items('Triggers Goal', '$bt$'(_, _, _), What), + print_db_items('Triggers Positive', '$pt$'(_, _, _), What), + print_db_items('Bidirectional Rules', (_<==>_), What), + dif(A, B), print_db_items('Supports Deduced', spft_precanonical(P, A, B), '$spft$'(P, A, B), What), + dif(G, ax), print_db_items('Supports Nonuser', spft_precanonical(P, G, G), '$spft$'(P, G, G), What), + print_db_items('Backchaining Rules', (_<-_), What), + % print_db_items('Edits',is_disabled_clause(_),What), + print_db_items('Edits', is_edited_clause(_, _, _), What), + print_db_items('Instances', isa(_, _), What), + print_db_items('Subclasses', genls(_, _), What), + print_db_items('Negative Facts', ~(_), What), + + print_db_items('ArgTypes', argGenls(_, _, _), What), + print_db_items('ArgTypes', argIsa(_, _, _), What), + print_db_items('ArgTypes', argQuotedIsa(_, _, _), What), + print_db_items('ArgTypes', meta_argtypes(_), What), + print_db_items('ArgTypes', predicate_property(G, meta_predicate(G)), What), + print_db_items('ArgTypes', resultGenls(_, _), What), + print_db_items('ArgTypes', resultIsa(_, _), What), + print_db_items('Arity', arity(_, _), What), + print_db_items('Arity', current_predicate(_), What), + print_db_items('MetaFacts Predicate', predicate_property(_, _), What), + print_db_items('Sources', module_property(_, _), What), + print_db_items('Sources', predicateConventionMt(_, _), What), + print_db_items('Sources', source_file(_, _), What), + print_db_items('Sources', _:man_index(_, _, _, _, _), What), + print_db_items('Sources', _:'$pldoc'(_, _, _, _), What), + print_db_items('Sources', _:'$pred_option'(_, _, _, _), What), + print_db_items('Sources',_:'$mode'(_,_),What), + !. + +%% pinfo(+Functor_Arity) is semidet. +% Shows predicate information for a specific functor and arity. +% F - Functor of the predicate. +% A - Arity of the predicate. +pinfo(F/A) :- + listing(F/A), % List the definition of the predicate. + safe_functor(P,F,A), % Create a functor from F/A. + findall(Prop, predicate_property(P,Prop), List), % Collect all properties of the predicate. + wdmsg_pretty(pinfo(F/A) == List), % Display the properties in a formatted way. + !. + + + +%% pp_DB is semidet. +% Pretty print all facts, rules, triggers, and supports in the default module. + +%pp_DB:- defaultAssertMt(M),clause_b(mtHybrid(M)),!,pp_DB(M). +%pp_DB:- forall(clause_b(mtHybrid(M)),pp_DB(M)). +pp_DB :- prolog_load_context(module, M), pp_DB(M). + +%% with_exact_kb(+Module, +Goal) is det. +% Executes a goal within the context of a specific module. +% Module - The module context. +% Goal - The goal to execute. +with_exact_kb(M, G) :- M:call(G). + +%% pp_DB(+Module) is semidet. +% Pretty prints the Pfc database for a specific module. +% Module - The module context. +pp_DB(M) :- + with_exact_kb(M, + M:must_det_l(( + pp_db_facts, + pp_db_rules, + pp_db_triggers, + pp_db_supports))). + +%% pp_db_facts is semidet. +% Pretty prints all facts in the current module's Pfc database. +pp_db_facts :- context_module(M), pp_db_facts(M). + +%% pp_db_rules is semidet. +% Pretty prints all rules in the current module's Pfc database. +pp_db_rules :- context_module(M), pp_db_rules(M). + +%% pp_db_triggers is semidet. +% Pretty prints all triggers in the current module's Pfc database. +pp_db_triggers :- context_module(M), pp_db_triggers(M). + +%% pp_db_supports is semidet. +% Pretty prints all supports in the current module's Pfc database. +pp_db_supports :- context_module(M), pp_db_supports(M). + +:- system:import(pp_DB/0). +:- system:export(pp_DB/0). + +%% pp_db_facts(+Module) is semidet. +% Pretty prints all facts in a specific module's Pfc database. +% Module - The module context. +pp_db_facts(MM) :- ignore(pp_db_facts(MM, _, true)). + +%% pp_db_facts(+Module, +Pattern) is semidet. +% Pretty prints facts in a specific module's Pfc database that match a given pattern. +% Module - The module context. +% Pattern - The pattern to match facts against. +pp_db_facts(MM, Pattern) :- pp_db_facts(MM, Pattern, true). + +%% pp_db_facts(+Module, +Pattern, +Condition) is semidet. +% Pretty prints facts in a specific module's Pfc database that match a given pattern and condition. +% Module - The module context. +% Pattern - The pattern to match facts against. +% Condition - The condition to filter facts. +pp_db_facts(MM, P, C) :- + pfc_facts_in_kb(MM, P, C, L), + pfc_classifyFacts(L, User, Pfc, _ZRule), + length(User, UserSize), length(Pfc, PfcSize), + format("~N~nUser added facts in [~w]: ~w", [MM, UserSize]), + pp_db_items(User), + format("~N~nSystem added facts in [~w]: ~w", [MM, PfcSize]), + pp_db_items(Pfc). + +%% pp_db_items(+Items) is det. +% Pretty prints a list of database items. +% Items - The list of items to print. + +pp_db_items(Var):-var(Var),!,format("~N ~p",[Var]). +pp_db_items([]) :- !. +pp_db_items([H|T]) :- !, + % numbervars(H,0,_), + format("~N ~p", [H]), + nonvar(T), pp_db_items(T). + +pp_db_items((P >= FT)) :- is_hidden_pft(P, FT), !. + +pp_db_items(Var) :- + format("~N ~p", [Var]). + +%% is_hidden_pft(+Predicate, +FactType) is semidet. +% Checks if a fact type should be hidden. +% Predicate - The predicate to check. +% FactType - The fact type to check. +is_hidden_pft(_,(mfl4(_VarNameZ, BaseKB, _, _), ax)) :- current_prolog_flag(pfc_shared_module, BaseKB), !. +is_hidden_pft(_,(why_marked(_), ax)). + +%% pp_mask(+Type, +Module, +Mask) is semidet. +% Prints masked items in a module's Pfc database. +% Type - The type of items. +% Module - The module context. +% Mask - The mask to filter items. +pp_mask(Type, MM, Mask) :- + bagof_or_nil(Mask, lookup_kb(MM, Mask), Nts), + list_to_set_variant(Nts, NtsSet), !, + pp_mask_list(Type, MM, NtsSet). + +%% pp_mask_list(+Type, +Module, +List) is semidet. +% Pretty prints a list of masked items. +% Type - The type of items. +% Module - The module context. +% List - The list of masked items. +pp_mask_list(Type, MM, []) :- !, + format("~N~nNo ~ws in [~w]...~n", [Type, MM]). +pp_mask_list(Type, MM, NtsSet) :- length(NtsSet, Size), !, + format("~N~n~ws (~w) in [~w]...~n", [Type, Size, MM]), + pp_db_items(NtsSet). + +%% pfc_classifyFacts(+Facts, -UserFacts, -PfcFacts, -Rules) is det. +% Classifies facts into user facts, Pfc facts, and rule facts. +% Facts - The facts to classify. +% UserFacts - The classified Output list of user-added facts. +% PfcFacts - The classified Output list of system-added facts. +% Rules - The classified Output list of rules. +pfc_classifyFacts([], [], [], []). + +pfc_classifyFacts([H|T], User, Pfc, [H|Rule]) :- + pfcType(H, rule(_)), !, + pfc_classifyFacts(T, User, Pfc, Rule). + +pfc_classifyFacts([H|T], [H|User], Pfc, Rule) :- + % get_source_uu(UU), + get_first_user_reason(H, _UU), !, + pfc_classifyFacts(T, User, Pfc, Rule). + +pfc_classifyFacts([H|T], User, [H|Pfc], Rule) :- + pfc_classifyFacts(T, User, Pfc, Rule). + +%% pp_db_rules(+Module) is det. +% Pretty print all types of rules in a specified module. +% Module - The module to operate within. +pp_db_rules(MM) :- + pp_mask("Forward Rule", MM, ==>(_,_)), + pp_mask("Bidirectional Rule", MM, <==>(_,_)), + pp_mask("Backchaining Rule", MM, <-(_, _)), + pp_mask("Implication Rule", MM, =>(_, _)), + pp_mask("Bi-conditional Rule", MM, <=>(_, _)), + pp_mask("Negative Fact",MM,(~(_))), +%pp_mask("Material-implRule",MM,<=(_,_)), +%pp_mask("PrologRule",MM,:-(_,_)), +!. + +%% pp_db_triggers(+Module) is det. +% Pretty prints all triggers in a specific module's Pfc database. +% Module - The module to operate within. +pp_db_triggers(MM) :- + pp_mask("Positive trigger(+)", MM, '$pt$'(_, _)), + pp_mask("Negative trigger(-)", MM, '$nt$'(_, _, _)), + pp_mask("Goal trigger(?)", MM, '$bt$'(_, _)), !. + +%% pp_db_supports(+Module) is semidet. +% Pretty prints all supports in a specific module's Pfc database. +% Module - The module context. +pp_db_supports(MM) :- + % temporary hack. + format("~N~nSupports in [~w]...~n", [MM]), + with_exact_kb(MM, bagof_or_nil((P >= S), pfcGetSupport(P, S), L)), + list_to_set_variant(L, LS), + pp_db_items(LS), !. + +%% list_to_set_variant(+List, -Unique) is det. +% Convert a list to a set, removing variants. +% List - The input list. +% Unique - The output set. +list_to_set_variant(List, Unique) :- + list_unique_1(List, [], Unique), !. + +%% list_unique_1(+List, +So_far, -Unique) is det. +% Helper predicate for list_to_set_variant/2. +% List - The input list. +% So_far - Accumulator of unique items. +% Unique - The output set. +list_unique_1([], _, []). +list_unique_1([X|Xs], So_far, Us) :- + memberchk_variant(X, So_far), !, + list_unique_1(Xs, So_far, Us). +list_unique_1([X|Xs], So_far, [X|Us]) :- + list_unique_1(Xs, [X|So_far], Us). + +%% memberchk_variant(+Val, +List) is semidet. +% Deterministic check of membership using =@= rather than +% unification. + +memberchk_variant(X, [Y|Ys]) :- + (X =@= Y -> true ; memberchk_variant(X, Ys)). + +%% lookup_kb(+MM, -MHB) is nondet. +% Lookup a clause in the knowledge base module. +% MM - The module to operate within. +% MHB - The head-body clause found. +lookup_kb(MM, MHB) :- + strip_module(MHB,M,HB), + expand_to_hb(HB, H, B), + (MM:clause(M:H, B, Ref) *-> true; M:clause(MM:H, B, Ref)), + %clause_ref_module(Ref), + clause_property(Ref, module(MM)). + +%% has_cl(+Head) is semidet. +% Checks if a clause exists for a specific head. +% Head - The head to check. +has_cl(H) :- predicate_property(H, number_of_clauses(_)). + +%% clause_or_call( +H, ?B) is semidet. +% Determine if a predicate can be called directly or needs to match a clause. + +% PFC2.0 clause_or_call(M:H,B):-is_ftVar(M),!,no_repeats(M:F/A,(f_to_mfa(H,M,F,A))),M:clause_or_call(H,B). +% PFC2.0 clause_or_call(isa(I,C),true):-!,call_u(isa_asserted(I,C)). +% PFC2.0 clause_or_call(genls(I,C),true):-!,on_x_log_throw(call_u(genls(I,C))). +clause_or_call(H, B) :- clause(src_edit(_Before, H), B). +clause_or_call(H, B) :- + predicate_property(H, number_of_clauses(C)), + predicate_property(H, number_of_rules(R)), + ((R*2 < C) -> (clause(H, B) *-> ! ; fail) ; clause(H, B)). + +% PFC2.0 clause_or_call(H,true):- call_u(should_call_for_facts(H)),no_repeats(on_x_log_throw(H)). + + /* + + + +% as opposed to simply using clause(H,true). + +% % should_call_for_facts( +H) is semidet. +% +% Should Call For Facts. +% +should_call_for_facts(H):- get_functor(H,F,A),call_u(should_call_for_facts(H,F,A)). + +% % should_call_for_facts( +VALUE1, ?F, ?VALUE3) is semidet. +% +% Should Call For Facts. +% +should_call_for_facts(_,F,_):- a(prologSideEffects,F),!,fail. +should_call_for_facts(H,_,_):- modulize_head(H,HH), \+ predicate_property(HH,number_of_clauses(_)),!. +should_call_for_facts(_,F,A):- clause_b(pfc_prop(_M,F,A,pfcRHS)),!,fail. +should_call_for_facts(_,F,A):- clause_b(pfc_prop(_M,F,A,pfcMustFC)),!,fail. +should_call_for_facts(_,F,_):- a(prologDynamic,F),!. +should_call_for_facts(_,F,_):- \+ a(pfcControlled,F),!. + + */ + +%% no_side_effects(+Predicate) is semidet. +% Checks if a predicate has no side effects. +% Predicate - The predicate to check. +no_side_effects(P) :- (\+ is_side_effect_disabled -> true; (get_functor(P, F, _), a(prologSideEffects, F))). + +%% pfc_facts_in_kb(+Module, +Pattern, +Condition, -Facts) is det. +% Retrieves facts from a specific module's knowledge base. +% Module - The module context. +% Pattern - The pattern to match facts against. +% Condition - The condition to filter facts. +% Facts - The retrieved facts. +pfc_facts_in_kb(MM, P, C, L) :- with_exact_kb(MM, setof_or_nil(P, pfcFact(P, C), L)). + +%% lookup_spft(+Predicate, -Fact, -Type) is nondet. +% Looks up a support fact type for a specific predicate. +% Predicate - The predicate to look up. +% Fact - The support fact. +% Type - The support type. +lookup_spft(P, F, T) :- pfcGetSupport(P, (F, T)). +% why_dmsg(Why,Msg):- with_current_why(Why,dmsg_pretty(Msg)). + +%% u_to_uu(+U, -UU) is det. +% Converts a user fact or support to a user fact type (U to UU). +% U - The user fact or support. +% UU - The resulting user fact type. +u_to_uu(U, (U, ax)) :- var(U), !. +u_to_uu(U, U) :- nonvar(U), U = (_, _), !. +u_to_uu([U|More], UU) :- list_to_conjuncts([U|More], C), !, u_to_uu(C, UU). +u_to_uu(U, (U, ax)) :- !. + +%% get_source_uu(-UU) is det. +% Retrieves the source reference for the current context. +% UU - The retrieved source reference. +% (Current file or User) +:- module_transparent((get_source_uu)/1). +get_source_uu(UU) :- must_ex((get_source_ref1(U), u_to_uu(U, UU))), !. +%% get_source_ref1(-U) is det. +% Retrieves the source reference for the current context (helper predicate). +% U - The retrieved source reference. +get_source_ref1(U) :- quietly_ex((current_why(U), nonvar(U))); ground(U), !. +get_source_ref1(U) :- quietly_ex((get_source_mfl(U))), !. + +%% get_why_uu(-UU) is det. +% Retrieves the current "why" reference as a user fact type (UU). +% UU - The retrieved user fact type. +:- module_transparent((get_why_uu)/1). +get_why_uu(UU) :- findall(U, current_why(U), Whys), Whys \== [], !, u_to_uu(Whys, UU). +get_why_uu(UU) :- get_source_uu(UU), !. + +%% get_startup_uu(-UU) is det. +% Retrieves the startup "why" reference as a user fact type (UU). +% UU - The retrieved user fact type. +get_startup_uu(UU) :- + prolog_load_context(module, CM), + u_to_uu((isRuntime, mfl4(VarNameZ, CM, user_input, _)), UU), varnames_load_context(VarNameZ). + +%% is_user_reason(+UserFact) is semidet. +% Checks if a user fact is a valid user reason. +% UserFact - The user fact to check. +is_user_reason((_, U)) :- atomic(U). +only_is_user_reason((U1, U2)) :- freeze(U2, is_user_reason((U1, U2))). + +%% is_user_fact(+Predicate) is semidet. +% Checks if a predicate is a user-added fact. +% Predicate - The predicate to check. +is_user_fact(P) :- get_first_user_reason(P, UU), is_user_reason(UU). + +%% get_first_real_user_reason(+Predicate, -UU) is semidet. +% Retrieves the first real user reason for a predicate. +% Predicate - The predicate to check. +% UU - The retrieved user reason. +get_first_real_user_reason(P, UU) :- nonvar(P), UU = (F, T), + quietly_ex(((((lookup_spft(P, F, T))), is_user_reason(UU)) *-> true; + ((((lookup_spft(P, F, T))), \+ is_user_reason(UU)) *-> (!, fail) ; fail))). + +%% get_first_user_reason(+Predicate, -UU) is semidet. +% Retrieves the first user reason for a predicate. +% Predicate - The predicate to check. +% UU - The retrieved user reason. +get_first_user_reason(P, (F, T)) :- + UU = (F, T), + ((((lookup_spft(P, F, T))), is_user_reason(UU)) *-> true; + ((((lookup_spft(P, F, T))), \+ is_user_reason(UU)) *-> (!, fail) ; + (clause_asserted(P), get_source_uu(UU), is_user_reason(UU)))), !. +get_first_user_reason(_, UU) :- get_why_uu(UU), is_user_reason(UU), !. +get_first_user_reason(_, UU) :- get_why_uu(UU), !. +get_first_user_reason(P, UU) :- must_ex(ignore((get_first_user_reason0(P, UU)))), !. +%get_first_user_reason(_,UU):- get_source_uu(UU),\+is_user_reason(UU). % ignore(get_source_uu(UU)). + + + +%% get_first_user_reason0(+Predicate, -UU) is semidet. +% Helper predicate for get_first_user_reason/2. +% Predicate - The predicate to check. +% UU - The retrieved user reason. +get_first_user_reason0(_, (M, ax)) :- get_source_mfl(M). + +%:- export(pfc_at_box:defaultAssertMt/1). +%:- system:import(defaultAssertMt/1). +%:- pfc_lib:import(pfc_at_box:defaultAssertMt/1). + +%% get_source_mfl(-MFL) is det. +% Retrieves the source reference for the current module/file location. +% MFL - The retrieved source reference. +:- module_transparent((get_source_mfl)/1). +get_source_mfl(M):- current_why(M), nonvar(M) , M =mfl4(_VarNameZ,_,_,_). +get_source_mfl(mfl4(VarNameZ, M, F, L)) :- defaultAssertMt(M), current_source_location(F, L), varnames_load_context(VarNameZ). +get_source_mfl(mfl4(VarNameZ, M, F, L)) :- defaultAssertMt(M), current_source_file(F:L), varnames_load_context(VarNameZ). +get_source_mfl(mfl4(VarNameZ, M, F, _L)) :- defaultAssertMt(M), current_source_file(F), varnames_load_context(VarNameZ). +get_source_mfl(mfl4(VarNameZ, M, _F, _L)) :- defaultAssertMt(M), varnames_load_context(VarNameZ). +%get_source_mfl(M):-(defaultAssertMt(M)->true;(atom(M)->(module_property(M,class(_)),!);(var(M),module_property(M,class(_))))). +get_source_mfl(M):-fail,dtrace, +((defaultAssertMt(M)->!; +(atom(M)->(module_property(M,class(_)),!); +pfcError(no_source_ref(M))))). + +is_source_ref1(_). + +defaultAssertMt(M):-prolog_load_context(module,M). + + + +%% pfc_pp_db_justifications(+Predicate, +Justifications) is det. +% Pretty prints the justifications for a predicate. +% Predicate - The predicate to print justifications for. +% Justifications - The justifications to print. +pfc_pp_db_justifications(P, Js) :- + show_current_source_location, + must_ex(quietly_ex((format("~NJustifications for ~p:", [P]), + pfc_pp_db_justification1('', Js, 1)))). + +%% pfc_pp_db_justification1(+Prefix, +Justifications, +N) is det. +% Helper predicate for pfc_pp_db_justifications/2. +% Prefix - The prefix for printing. +% Justifications - The justifications to print. +% N - The current justification number. +pfc_pp_db_justification1(_, [], _). +pfc_pp_db_justification1(Prefix, [J|Js], N) :- + % show one justification and recurse. + nl, + pfc_pp_db_justifications2(Prefix, J, N, 1), + %reset_shown_justs, + N2 is N+1, + pfc_pp_db_justification1(Prefix, Js, N2). + +%% pfc_pp_db_justifications2(+Prefix, +Justification, +JustNo, +StepNo) is det. +% Helper predicate for pfc_pp_db_justification1/3. +% Prefix - The prefix for printing. +% Justification - The justification to print. +% JustNo - The current justification number. +% StepNo - The current step number. +pfc_pp_db_justifications2(_, [], _, _). +pfc_pp_db_justifications2(Prefix, [C|Rest], JustNo, StepNo) :- +(nb_hasval('$last_printed',C)-> dmsg_pretty(chasVal(C)) ; + ((StepNo==1->fmt('~N~n',[]);true), + backward_compatibility:sformat(LP,' ~w.~p.~p',[Prefix,JustNo,StepNo]), + nb_pushval('$last_printed',LP), + format("~N ~w ~p",[LP,C]), + ignore(loop_check(pfcWhy_sub_sub(C))), + StepNext is 1+StepNo, + pfc_pp_db_justifications2(Prefix,Rest,JustNo,StepNext))). + + +%% pfcWhy_sub_sub(+Predicate) is det. +% Sub-function for pfcWhy to handle sub-subjustifications. +% Predicate - The predicate to check. +pfcWhy_sub_sub(P) :- + justifications(P, Js), + clear_proofs, + % retractall_u(t_l:whybuffer(_,_)), + (nb_hasval('$last_printed', P) -> dmsg_pretty(hasVal(P)) ; + (( + assertz(t_l:whybuffer(P, Js)), + nb_getval('$last_printed', LP), + ((pfc_pp_db_justification1(LP, Js, 1), fmt('~N~n', [])))))). + +% File : pfcwhy.pl +% Author : Tim Finin, finin@prc.unisys.com +% Updated: +% Purpose: predicates for interactively exploring Pfc justifications. + +% ***** predicates for browsing justifications ***** + +:- use_module(library(lists)). + +:- dynamic(t_l:whybuffer/2). + +%% pfcWhy is semidet. +% Interactively explores Pfc justifications. +pfcWhy :- + t_l:whybuffer(P, _), + pfcWhy(P). + +%% pfcTF(+Predicate) is semidet. +% Prints the truth value of a predicate. +% Predicate - The predicate to check. +pfcTF(P) :- pfc_call(P) *-> foreach(pfcTF1(P), true); pfcTF1(P). + +%% pfcTF1(+Predicate) is semidet. +% Helper predicate for pfcTF/1. +% Predicate - The predicate to check. +pfcTF1(P) :- + ansi_format([underline], "~N=========================================", []), + (ignore(pfcWhy(P))), ignore(pfcWhy(~P)), + printLine. + +%% pfcWhy(+N) is semidet. +%% pfcWhy(+Predicate) is semidet. +% Interactively explores the Nth justification for a predicate. +% N - The justification number. +% Predicate - The predicate to explore. +pfcWhy(N) :- + number(N), !, + t_l:whybuffer(P, Js), + pfcWhyCommand(N, P, Js). +pfcWhy(P) :- + justifications(P, Js), + retractall(t_l:whybuffer(_,_)), + assert(t_l:whybuffer(P, Js)), + pfcWhyBrouse(P, Js). + +%% pfcWhy1(+Predicate) is semidet. +% Interactively explores the first justification for a predicate. +% Predicate - The predicate to explore. +pfcWhy1(P) :- + justifications(P, Js), + pfcWhyBrouse(P, Js). + +%% pfcWhy2(+Predicate, +N) is semidet. +% Interactively explores the Nth justification for a predicate. +% Predicate - The predicate to explore. +% N - The justification number. +pfcWhy2(P, N) :- + justifications(P, Js), pfcShowJustification1(Js, N). + +%% pfcWhyBrouse(+Predicate, +Justifications) is semidet. +% Interactively explores justifications for a predicate. +% Predicate - The predicate to explore. +% Justifications - The justifications to explore. +pfcWhyBrouse(P, Js) :- + % rtrace(pfc_pp_db_justifications(P,Js)), + pfcShowJustifications(P, Js), + nop((pfcAsk(' >> ', Answer), + pfcWhyCommand(Answer, P, Js))). + +%% pfcWhyCommand(+Command, +Predicate, +Justifications) is semidet. +% Executes a command during Pfc justification exploration. +% Command - The command to execute. +% Predicate - The predicate being explored. +% Justifications - The justifications being explored. +pfcWhyCommand(q, _, _) :- !. % Quit. +pfcWhyCommand(h, _, _) :- !, % Help. + format("~nJustification Browser Commands: + q quit. + N focus on Nth justification. + N.M browse step M of the Nth justification + u up a level~n", []). + +pfcWhyCommand(N, _P, Js) :- float(N), !, + pfcSelectJustificationNode(Js, N, Node), + pfcWhy1(Node). + +pfcWhyCommand(u, _, _) :- !. % Up a level. + +pfcCommand(N, _, _) :- integer(N), !, + pfcPrintf("~p is a yet unimplemented command.", [N]), + fail. + +pfcCommand(X, _, _) :- pfcPrintf("~p is an unrecognized command, enter h. for help.", [X]), + fail. + +%% pfcShowJustifications(+Predicate, +Justifications) is semidet. +% Pretty prints justifications for a predicate. +% Predicate - The predicate to print justifications for. +% Justifications - The justifications to print. +pfcShowJustifications(P, Js) :- + show_current_source_location, + reset_shown_justs, + %color_line(yellow,1), + format("~N~nJustifications for ", []), + ansi_format([fg(green)], '~@', [pp(P)]), + format(" :~n", []), + pfcShowJustification1(Js, 1),!, + printLine. + +%% pfcShowJustification1(+Justifications, +N) is semidet. +% Pretty prints the Nth justification in a list. +% Justifications - The list of justifications. +% N - The justification number. +pfcShowJustification1([J|Js], N) :- !, + % show one justification and recurse. + %reset_shown_justs, + pfcShowSingleJustStep(N, J),!, + N2 is N+1, + pfcShowJustification1(Js, N2). + +pfcShowJustification1(J, N) :- + %reset_shown_justs, % nl, + pfcShowSingleJustStep(N, J),!. + +%% pfcShowSingleJustStep(+JustNo, +Justification) is semidet. +% Pretty prints a single step in a justification. +% JustNo - The justification number. +% Justification - The justification step. +pfcShowSingleJustStep(N, J) :- + pfcShowSingleJust(N, step(1), J),!. +pfcShowSingleJustStep(N, J) :- + pp(pfcShowSingleJustStep(N, J)),!. + +%% incrStep(+StepNo, -Step) is det. +% Increments the step number. +% StepNo - The current step number. +% Step - The incremented step number. +incrStep(StepNo, Step) :- compound(StepNo), arg(1, StepNo, Step), X is Step+1, nb_setarg(1, StepNo, X). + +%% pfcShowSingleJust(+JustNo, +StepNo, +Justification) is semidet. +% Pretty prints a single justification step. +% JustNo - The justification number. +% StepNo - The step number. +% Justification - The justification step. +pfcShowSingleJust(JustNo, StepNo, C) :- is_ftVar(C), !, incrStep(StepNo, Step), + ansi_format([fg(cyan)], "~N ~w.~w ~w ", [JustNo, Step, C]), !, maybe_more_c(C). +pfcShowSingleJust(_JustNo,_StepNo,[]):-!. +pfcShowSingleJust(JustNo, StepNo, (P, T)) :- !, + pfcShowSingleJust(JustNo, StepNo, P), + pfcShowSingleJust(JustNo, StepNo, T). +pfcShowSingleJust(JustNo, StepNo, (P, F, T)) :- !, + pfcShowSingleJust1(JustNo, StepNo, P), + pfcShowSingleJust(JustNo, StepNo, F), + pfcShowSingleJust1(JustNo, StepNo, T). +pfcShowSingleJust(JustNo, StepNo, (P *-> T)) :- !, + pfcShowSingleJust1(JustNo, StepNo, P), format(' *-> ', []), + pfcShowSingleJust1(JustNo, StepNo, T). + +pfcShowSingleJust(JustNo, StepNo, (P :- T)) :- !, + pfcShowSingleJust1(JustNo, StepNo, P), format(':- ~p.', [T]). + +pfcShowSingleJust(JustNo, StepNo, (P : - T)) :- !, + pfcShowSingleJust1(JustNo, StepNo, P), format(' :- ', []), + pfcShowSingleJust(JustNo, StepNo, T). + +pfcShowSingleJust(JustNo, StepNo, (P :- T)) :- !, + pfcShowSingleJust1(JustNo, StepNo, call(T)), + pfcShowSingleJust1(JustNo, StepNo, P). + +pfcShowSingleJust(JustNo, StepNo, [P|T]) :- !, + pfcShowSingleJust(JustNo, StepNo, P), + pfcShowSingleJust(JustNo, StepNo, T). + +pfcShowSingleJust(JustNo, StepNo, '$pt$'(P, Body)) :- !, + pfcShowSingleJust1(JustNo, StepNo, '$pt$'(P)), + pfcShowSingleJust(JustNo, StepNo, Body). + +pfcShowSingleJust(JustNo, StepNo, C) :- + pfcShowSingleJust1(JustNo, StepNo, C). + +%% fmt_cl(+Clause) is det. +% Formats and writes a clause to the output. +% Clause - The clause to format. +fmt_cl(P) :- \+ \+ (numbervars(P, 666, _, [attvars(skip), singletons(true)]), write_src(P)), !. +fmt_cl(P) :- \+ \+ (pretty_numbervars(P, PP), numbervars(PP, 126, _, [attvar(skip), singletons(true)]), + write_term(PP, [portray(true), portray_goal(fmt_cl)])), write('.'). +fmt_cl(S,_):- term_is_ansi(S), !, write_keeping_ansi(S). +fmt_cl(G,_):- is_grid(G),write('"'),user:print_grid(G),write('"'),!. +% fmt_cl(P,_):- catch(arc_portray(P),_,fail),!. +fmt_cl(P,_):- is_list(P),catch(p_p_t_no_nl(P),_,fail),!. +%ptg(PP,Opts):- is_list(PP),select(portray_goal(ptg),Opts,Never),write_term(PP,Never). + + + +%% unwrap_litr(+Clause, -UnwrappedClause) is det. +% Unwraps a literal clause. +% Clause - The clause to unwrap. +% UnwrappedClause - The unwrapped clause. +unwrap_litr(C, CCC+VS) :- copy_term(C, CC, VS), + numbervars(CC+VS, 0, _), + unwrap_litr0(CC, CCC), !. +unwrap_litr0(call(C), CC) :- unwrap_litr0(C, CC). +unwrap_litr0('$pt$'(C), CC) :- unwrap_litr0(C, CC). +unwrap_litr0(body(C), CC) :- unwrap_litr0(C, CC). +unwrap_litr0(head(C), CC) :- unwrap_litr0(C, CC). +unwrap_litr0(C, C). + +:- thread_local t_l:shown_why/1. + +%% pfcShowSingleJust1(+JustNo, +StepNo, +Clause) is det. +% Pretty prints a single clause in a justification. +% JustNo - The justification number. +% StepNo - The step number. +% Clause - The clause to print. +pfcShowSingleJust1(JustNo, _, MFL) :- is_mfl(MFL), JustNo \== 1, !. +pfcShowSingleJust1(JustNo, StepNo, C) :- unwrap_litr(C, CC), !, pfcShowSingleJust4(JustNo, StepNo, C, CC). + +%% pfcShowSingleJust4(+JustNo, +StepNo, +Clause, +UnwrappedClause) is det. +% Helper predicate for pfcShowSingleJust1/3. +% JustNo - The justification number. +% StepNo - The step number. +% Clause - The clause to print. +% UnwrappedClause - The unwrapped clause to print. +pfcShowSingleJust4(_, _, _, CC) :- t_l:shown_why(C), C =@= CC, !. +pfcShowSingleJust4(_, _, _, MFL) :- is_mfl(MFL), !. +pfcShowSingleJust4(JustNo, StepNo, C, CC) :- assert(t_l:shown_why(CC)), !, + incrStep(StepNo, Step), + ansi_format([fg(cyan)], "~N ~w.~w ~@ ", [JustNo, Step, user:fmt_cl(C)]), + %write('<'), + pfcShowSingleJust_C(C),!,%write('>'), + format('~N'), + ignore((maybe_more_c(C))), + assert(t_l:shown_why(C)), + format('~N'), !. + +%% is_mfl(+Term) is semidet. +% Checks if a term is an mfl (module/file/line) reference. +% Term - The term to check. +is_mfl(MFL) :- compound(MFL), MFL = mfl4(_, _, _, _). + +%% maybe_more_c(+Term) is det. +% Triggers exploration of more clauses if needed. +% Term - The term to check. +maybe_more_c(MFL) :- is_mfl(MFL), !. +maybe_more_c(_) :- t_l:shown_why(no_recurse). +maybe_more_c(C) :- t_l:shown_why(more(C)), !. +maybe_more_c(C) :- t_l:shown_why((C)), !. +maybe_more_c(C) :- assert(t_l:shown_why(more(C))), assert(t_l:shown_why((C))), + locally(t_l:shown_why(no_recurse), + locally(t_l:shown_why((C)), locally(t_l:shown_why(more(C)), + ignore(catch(pfcWhy2(C, 1.1), E, fbugio(E)))))), !. + +%% pfcShowSingleJust_C(+Clause) is det. +% Helper predicate for pfcShowSingleJust1/3. +% Clause - The clause to print. +pfcShowSingleJust_C(C) :- is_file_ref(C), !. +pfcShowSingleJust_C(C) :- find_mfl(C, MFL), assert(t_l:shown_why(MFL)), !, pfcShowSingleJust_MFL(MFL). +pfcShowSingleJust_C(_) :- ansi_format([hfg(black)], " % [no_mfl] ", []), !. + +%% short_filename(+File, -ShortFilename) is det. +% Extracts a short filename from a full file path. +% File - The full file path. +% ShortFilename - The extracted short filename. +short_filename(F, FN) :- symbolic_list_concat([_, FN], '/pack/', F), !. +short_filename(F, FN) :- symbolic_list_concat([_, FN], swipl, F), !. +short_filename(F, FN) :- F = FN, !. + +%% pfcShowSingleJust_MFL(+MFL) is det. +% Helper predicate for pfcShowSingleJust_C/1. +% MFL - The mfl (module/file/line) reference to print. +pfcShowSingleJust_MFL(MFL) :- MFL = mfl4(VarNameZ, _M, F, L), atom(F), short_filename(F, FN), !, varnames_load_context(VarNameZ), + ansi_format([hfg(black)], " % [~w:~w] ", [FN, L]). + +pfcShowSingleJust_MFL(MFL) :- MFL = mfl4(V, M, F, L), my_maplist(var, [V, M, F, L]), !. +pfcShowSingleJust_MFL(MFL) :- ansi_format([hfg(black)], " % [~w] ", [MFL]), !. + +%% pfcAsk(+Message, -Answer) is det. +% Asks the user for input during Pfc justification exploration. +% Message - The message to display. +% Answer - The user's input. +pfcAsk(Msg, Ans) :- + format("~n~w", [Msg]), + read(Ans). + +%% pfcSelectJustificationNode(+Justifications, +Index, -Node) is det. +% Selects a specific node in a justification based on an index. +% Justifications - The list of justifications. +% Index - The index to select. +% Node - The selected node. +pfcSelectJustificationNode(Js, Index, Step) :- + JustNo is integer(Index), + nth1(JustNo, Js, Justification), + StepNo is 1 + integer(Index*10 - JustNo*10), + nth1(StepNo, Justification, Step). diff --git a/.Attic/canary_docme/metta_eval.pl b/.Attic/canary_docme/metta_eval.pl new file mode 100644 index 00000000000..da5789a84d4 --- /dev/null +++ b/.Attic/canary_docme/metta_eval.pl @@ -0,0 +1,2622 @@ +/* + * 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. + */ + +% +% post match modew +%:- style_check(-singleton). +:- multifile(fake_notrace/1). +:- meta_predicate(fake_notrace(0)). +:- meta_predicate(color_g_mesg(+,0)). +:- multifile(color_g_mesg/2). + +self_eval0(X):- \+ callable(X),!. +self_eval0(X):- py_is_py(X),!. +%self_eval0(X):- py_type(X,List), List\==list,!. +self_eval0(X):- is_valid_nb_state(X),!. +%self_eval0(X):- string(X),!. +%self_eval0(X):- number(X),!. +%self_eval0([]). +self_eval0(X):- is_metta_declaration(X),!. +self_eval0([_,Ar,_]):- (Ar=='-->';Ar=='<->';Ar=='<--'),!. +self_eval0([F|X]):- !, is_list(X),length(X,Len),!,nonvar(F), is_self_eval_l_fa(F,Len),!. +self_eval0(X):- typed_list(X,_,_),!. +%self_eval0(X):- compound(X),!. +%self_eval0(X):- is_ref(X),!,fail. +self_eval0('True'). self_eval0('False'). % self_eval0('F'). +self_eval0('Empty'). +self_eval0([]). +self_eval0('%Undefined%'). +self_eval0(X):- atom(X),!, \+ nb_bound(X,_),!. + + +nb_bound(Name,X):- atom(Name), atom_concat('&', _, Name), + nb_current(Name, X). + + +coerce(Type,Value,Result):- nonvar(Value),Value=[Echo|EValue], Echo == echo, EValue = [RValue],!,coerce(Type,RValue,Result). +coerce(Type,Value,Result):- var(Type), !, Value=Result, freeze(Type,coerce(Type,Value,Result)). +coerce('Atom',Value,Result):- !, Value=Result. +coerce('Bool',Value,Result):- var(Value), !, Value=Result, freeze(Value,coerce('Bool',Value,Result)). +coerce('Bool',Value,Result):- is_list(Value),!,as_tf(call_true(Value),Result), +set_list_value(Value,Result). + +set_list_value(Value,Result):- nb_setarg(1,Value,echo),nb_setarg(1,Value,[Result]). + +%is_self_eval_l_fa('S',1). % cheat to comment + +% these should get uncomented with a flag +%is_self_eval_l_fa(':',2). +% is_self_eval_l_fa('=',2). +% eval_20(Eq,RetType,Depth,Self,['quote',Eval],RetVal):- !, Eval = RetVal, check_returnval(Eq,RetType,RetVal). +is_self_eval_l_fa('quote',_). +is_self_eval_l_fa('Error',_). +is_self_eval_l_fa('{...}',_). +is_self_eval_l_fa('[...]',_). + +self_eval(X):- notrace(self_eval0(X)). + +:- set_prolog_flag(access_level,system). +hyde(F/A):- functor(P,F,A), redefine_system_predicate(P),'$hide'(F/A), '$iso'(F/A). +:- 'hyde'(option_else/2). +:- 'hyde'(atom/1). +:- 'hyde'(quietly/1). +%:- 'hyde'(fake_notrace/1). +:- 'hyde'(var/1). +:- 'hyde'(is_list/1). +:- 'hyde'(copy_term/2). +:- 'hyde'(nonvar/1). +:- 'hyde'(quietly/1). +%:- 'hyde'(option_value/2). + + +is_metta_declaration([F|_]):- F == '->',!. +is_metta_declaration([F,H,_|T]):- T ==[], is_metta_declaration_f(F,H). + +is_metta_declaration_f(F,H):- F == ':<', !, nonvar(H). +is_metta_declaration_f(F,H):- F == ':>', !, nonvar(H). +is_metta_declaration_f(F,H):- F == '=', !, is_list(H), \+ (current_self(Space), is_user_defined_head_f(Space,F)). + +% is_metta_declaration([F|T]):- is_list(T), is_user_defined_head([F]),!. + +% Sets the current self space to '&self'. This is likely used to track the current context or scope during the evaluation of Metta code. +:- nb_setval(self_space, '&self'). + +%! eval_to(+X,+Y) is semidet. +% checks if X evals to Y +evals_to(XX,Y):- Y=@=XX,!. +evals_to(XX,Y):- Y=='True',!, is_True(XX),!. + +%current_self(Space):- nb_current(self_space,Space). + +do_expander('=',_,X,X):-!. +do_expander(':',_,X,Y):- !, get_type(X,Y)*->X=Y. + +get_type(Arg,Type):- eval_H(['get-type',Arg],Type). + + +%! eval_true(+X) is semidet. +% Evaluates the given term X and succeeds if X is not a constraint (i.e. \+ iz_conz(X)) and is callable, and calling X succeeds. +% +% If X is not callable, this predicate will attempt to evaluate the arguments of X (using eval_args/2) and succeed if the result is not False. +eval_true(X):- \+ iz_conz(X), callable(X), call(X). +eval_true(X):- eval_args(X,Y), once(var(Y) ; \+ is_False(Y)). + +eval(Depth,Self,X,Y):- eval('=',_,Depth,Self,X,Y). +eval(Eq,RetType,Depth,Self,X,Y):- + catch_metta_return(eval_args(Eq,RetType,Depth,Self,X,Y),Y). + +%:- set_prolog_flag(gc,false). +/* +eval_args(Eq,RetTyp e,Depth,Self,X,Y):- + locally(set_prolog_flag(gc,true), + rtrace_on_existence_error( + eval(Eq,RetType,Depth,Self,X,Y))). +*/ + + +%! eval_args(+X,-Y) is semidet. +eval_args(X,Y):- current_self(Self), eval_args(500,Self,X,Y). +%eval_args(Eq,RetType,Depth,_Self,X,_Y):- forall(between(6,Depth,_),write(' ')),writeqln(eval_args(Eq,RetType,X)),fail. +eval_args(Depth,Self,X,Y):- eval_args('=',_RetType,Depth,Self,X,Y). + +eval_args(_Eq,_RetType,_Dpth,_Slf,X,Y):- var(X),nonvar(Y),!,X=Y. +eval_args(_Eq,_RetType,_Dpth,_Slf,X,Y):- notrace(self_eval(X)),!,Y=X. +eval_args(Eq,RetType,Depth,Self,X,Y):- + notrace(nonvar(Y)), var(RetType), + get_type(Depth,Self,Y,WasType), + can_assign(WasType,RetType), + nonvar(RetType),!, + eval_args(Eq,RetType,Depth,Self,X,Y). +eval_args(Eq,RetType,Depth,Self,X,Y):- notrace(nonvar(Y)),!, + eval_args(Eq,RetType,Depth,Self,X,XX),evals_to(XX,Y). + +eval_args(Eq,RetType,_Dpth,_Slf,[X|T],Y):- T==[], number(X),!, do_expander(Eq,RetType,X,YY),Y=[YY]. + +/* +eval_args(Eq,RetType,Depth,Self,[F|X],Y):- + (F=='superpose' ; ( option_value(no_repeats,false))), + notrace((D1 is Depth-1)),!, + eval_args(Eq,RetType,D1,Self,[F|X],Y). +*/ + +eval_args(Eq,RetType,Depth,Self,X,Y):- atom(Eq), ( Eq \== ('='), Eq \== ('match')) ,!, + call(call,Eq,'=',RetType,Depth,Self,X,Y). + +eval_args(_Eq,_RetType,_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. +eval_args(Eq,RetType,Depth,Self,X,Y):- + eval_00(Eq,RetType,Depth,Self,X,Y). +%eval_ret(Eq,RetType,1000,Self,X,Y):- !, +% catch_metta_return(eval_ret(Eq,RetType,99,Self,X,Y),Y). + +eval_ret(Eq,RetType,Depth,Self,X,Y):- + eval_00(Eq,RetType,Depth,Self,X,Y), is_returned(Y). + +catch_metta_return(G,Y):- + catch(G,metta_return(Y),ignore(retract(thrown_metta_return(Y)))). + +allow_repeats_eval_(_):- !. +allow_repeats_eval_(_):- option_value(no_repeats,false),!. +allow_repeats_eval_(X):- \+ is_list(X),!,fail. +allow_repeats_eval_([F|_]):- atom(F),allow_repeats_eval_f(F). +allow_repeats_eval_f('superpose'). +allow_repeats_eval_f('collapse'). + + +:- nodebug(metta(overflow)). +eval_00(_Eq,_RetType,_Depth,_Slf,X,Y):- self_eval(X),!,X=Y. +eval_00(Eq,RetType,Depth,Self,X,YO):- + eval_01(Eq,RetType,Depth,Self,X,YO). +eval_01(Eq,RetType,Depth,Self,X,YO):- + if_t((Depth<1, trace_on_overflow), + debug(metta(eval_args))), + notrace((Depth2 is Depth-1, copy_term(X, XX))), + trace_eval(eval_20(Eq,RetType),e,Depth2,Self,X,M), + (self_eval(M)-> YO=M ; + (((M=@=XX)-> Y=M + ;eval_01(Eq,RetType,Depth2,Self,M,Y)), + eval_02(Eq,RetType,Depth2,Self,Y,YO))). + +eval_02(Eq,RetType,Depth2,Self,Y,YO):- + once(if_or_else((subst_args_here(Eq,RetType,Depth2,Self,Y,YO)), + if_or_else((fail,finish_eval(Eq,RetType,Depth2,Self,Y,YO)), + Y=YO))). + + + subst_args_here(Eq,RetType,Depth2,Self,Y,YO):- + Y =@= [ house, _59198,_59204,==,fish,fish],!,break. + +subst_args_here(Eq,RetType,Depth2,Self,Y,YO):- + subst_args(Eq,RetType,Depth2,Self,Y,YO), + nop(notrace(if_t(Y\=@=YO,wdmsg(subst_args(Y,YO))))). + +finish_eval_here(Eq,RetType,Depth2,Self,Y,YO):- + finish_eval(Eq,RetType,Depth2,Self,Y,YO), + notrace(if_t(Y\=@=YO,wdmsg(finish_eval(Y,YO)))). + +:- nodebug(metta(e)). + +:- discontiguous eval_20/6. +:- discontiguous eval_40/6. +:- discontiguous eval_70/6. +%:- discontiguous eval_30fz/5. +%:- discontiguous eval_31/5. +%:- discontiguous eval_maybe_defn/5. + +eval_20(Eq,RetType,_Dpth,_Slf,Name,Y):- + atom(Name), !, + (nb_bound(Name,X)->do_expander(Eq,RetType,X,Y); + Y = Name). + + +eval_20(Eq,RetType,_Dpth,_Slf,X,Y):- no_eval(X),!,do_expander(Eq,RetType,X,Y). + +args_not_evaled(X):- ( \+ is_list(X); maplist(no_eval,X)),!. +no_eval(X):- self_eval(X),!. +no_eval([SL|X]):- atomic(SL), !, is_sl(SL), args_not_evaled(X). +no_eval([SL|X]):- ( \+ atom(SL), \+ is_list(SL)), !, + args_not_evaled(X). +is_sl(N):- number(N). +is_sl('ExtSet'). +is_sl('IntSet'). +%is_sl('___'). + +% ================================================================= +% ================================================================= +% ================================================================= +% VAR HEADS/ NON-LISTS +% ================================================================= +% ================================================================= +% ================================================================= + +eval_20(Eq,RetType,_Dpth,_Slf,[X|T],Y):- T==[], \+ callable(X),!, do_expander(Eq,RetType,X,YY),Y=[YY]. +%eval_20(Eq,RetType,_Dpth,Self,[X|T],Y):- T==[], atom(X), +% \+ is_user_defined_head_f(Self,X), +% do_expander(Eq,RetType,X,YY),!,Y=[YY]. + +eval_20(Eq,RetType,Depth,Self,X,Y):- atom(Eq), ( Eq \== ('=')) ,!, + call(Eq,'=',RetType,Depth,Self,X,Y). + + +eval_20(_Eq,_RetType,_Depth,_Self,[V|VI],VO):- atomic(V), py_is_object(V),!, + is_list(VI),!, py_eval_object([V|VI],VO). + +eval_20(Eq,RetType,Depth,Self,[V|VI],VO):- is_list(V), V \== [], + eval_20(Eq,_FRype,Depth,Self,V,VV), V\==VV, atomic(VV), !, + eval_20(Eq,RetType,Depth,Self,[VV|VI],VO). + +eval_20(Eq,RetType,Depth,Self,[F,[Eval,V]|VI],VO):- Eval == eval,!, + ((eval_args(Eq,_FRype,Depth,Self,V,VV), V\=@=VV)*-> true; VV = V), + eval_20(Eq,RetType,Depth,Self,[F,VV|VI],VO). + + +% DMILES @ TODO make sure this isnt an implicit curry +eval_20(Eq,_RetType,Depth,Self,[V|VI],VO):- \+ callable(V), is_list(VI),!, + maplist(eval_ret(Eq,_ArgRetType,Depth,Self),[V|VI],VOO),VO=VOO. + + +eval_20(Eq,RetType,Depth,Self,[V|VI],VVO):- \+ is_list(VI),!, + eval_args(Eq,RetType,Depth,Self,VI,VM), + ( VM\==VI -> eval_args(Eq,RetType,Depth,Self,[V|VM],VVO) ; + (eval_args(Eq,RetType,Depth,Self,V,VV), (V\==VV -> eval_args(Eq,RetType,Depth,Self,[VV|VI],VVO) ; VVO = [V|VI]))). + +eval_20(Eq,RetType,_Dpth,_Slf,X,Y):- \+ is_list(X),!,do_expander(Eq,RetType,X,Y). + +eval_20(Eq,_RetType,Depth,Self,[V|VI],[V|VO]):- var(V),is_list(VI),!,maplist(eval_args(Eq,_ArgRetType,Depth,Self),VI,VO). + +eval_20(_,_,_,_,['echo',Value],Value):- !. +eval_20(=,Type,_,_,['coerce',Type,Value],Result):- !, coerce(Type,Value,Result). + +% ================================================================= +% ================================================================= +% ================================================================= +% LET* +% ================================================================= +% ================================================================= +% ================================================================= + + %eval_20(Eq,RetType,Depth2,Self,[Qw,X,Y],YO):- Qw == ('=='),!, + % eval_args(X,XX),eval_args(Y,YY), !, as_tf(XX==YY,YO). + + + eval_20(Eq,RetType,Depth,Self,['let*',Lets,Body],RetVal):- + expand_let_star(Lets,Body,NewLet),!, + eval_20(Eq,RetType,Depth,Self,NewLet,RetVal). + + + +expand_let_star(Lets,Body,Body):- Lets==[],!. +expand_let_star([H|LetRest],Body,['let',V,E,NewBody]):- + is_list(H), H = [V,E], !, + expand_let_star(LetRest,Body,NewBody). + +eval_20(Eq,RetType,Depth,Self,X,RetVal):- + once(expand_eval(X,XX)),X\==XX,!, + %fbug(expand_eval(X,XX)), + eval_20(Eq,RetType,Depth,Self,XX,RetVal). + +expand_eval(X,Y):- \+ is_list(X),!, X=Y. +expand_eval([H|A],[H|AA]):- \+ ground(H),!,maplist(expand_eval,A,AA). +expand_eval(['let*',Lets,Body],NewBody):- expand_let_star(Lets,Body,NewBody),!. +expand_eval([H|A],[H|AA]):- maplist(expand_eval,A,AA). + +% ================================================================= +% ================================================================= +% ================================================================= +% EVAL LAZY +% ================================================================= +% ================================================================= +% ================================================================= + + +is_progn(C):- var(C),!,fail. +is_progn('chain-body'). +is_progn('progn'). + +eval_20(Eq,RetType,Depth,Self,[Comma,X ],Res):- is_progn(Comma),!, eval_args(Eq,RetType,Depth,Self,X,Res). +%eval_20(Eq,RetType,Depth,Self,[Comma,X,Y],Res):- is_progn(Comma),!, eval_args(Eq,_,Depth,Self,X,_), +% eval_args(Eq,RetType,Depth,Self,Y,Res). +eval_20(Eq,RetType,Depth,Self,[Comma,X|Y],Res):- is_progn(Comma),!, eval_args(Eq,_,Depth,Self,X,_), + eval_args(Eq,RetType,Depth,Self,[Comma|Y],Res). + +eval_20(Eq,RetType,Depth,Self,['chain',Atom,Var|Y],Res):- !, eval_args(Eq,_RetType,Depth,Self,Atom,R), + Var = R, eval_args(Eq,RetType,Depth,Self,['chain-body'|Y],Res). + +%eval_20(Eq,RetType,Depth,Self,['chain-body',X],Res):- !,eval_args(Eq,RetType,Depth,Self,X,Res). +%eval_20(Eq,RetType,Depth,Self,['chain-body',X|Y],Res):- !, eval_args(Eq,RetType,Depth,Self,X,_), eval_args(Eq,RetType,Depth,Self,['chain-body'|Y],Res). + +eval_20(Eq,RetType,Depth,Self,['eval',X],Res):- !, + eval_args(Eq,RetType,Depth,Self,X, Res). + + +eval_20(Eq,RetType,Depth,Self,['eval-for',Type,X],Res):- !, + ignore(Type=RetType), + eval_args(Eq,Type,Depth,Self,X, Res). + +eval_20(Eq,RetType,Depth,Self,['eval-for',_Why,Type,X],Res):- !, + ignore(Type=RetType), + eval_args(Eq,Type,Depth,Self,X, Res). + + +% ================================================================= +% ================================================================= +% ================================================================= +% LET +% ================================================================= +% ================================================================= +% ================================================================= + + + +eval_until_unify(_Eq,_RetType,_Dpth,_Slf,X,X):- !. +eval_until_unify(Eq,RetType,Depth,Self,X,Y):- eval_until_eq(Eq,RetType,Depth,Self,X,Y),!. + +eval_until_eq(Eq,RetType,_Dpth,_Slf,X,Y):- X=Y,check_returnval(Eq,RetType,Y). +%eval_until_eq(Eq,RetType,Depth,Self,X,Y):- var(Y),!,eval_in_steps_or_same(Eq,RetType,Depth,Self,X,XX),Y=XX. +%eval_until_eq(Eq,RetType,Depth,Self,Y,X):- var(Y),!,eval_in_steps_or_same(Eq,RetType,Depth,Self,X,XX),Y=XX. +eval_until_eq(Eq,RetType,Depth,Self,X,Y):- \+is_list(Y),!,eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),Y=XX. +eval_until_eq(Eq,RetType,Depth,Self,Y,X):- \+is_list(Y),!,eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),Y=XX. +eval_until_eq(Eq,RetType,Depth,Self,X,Y):- eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),eval_until_eq(Eq,RetType,Depth,Self,Y,XX). +eval_until_eq(_Eq,_RetType,_Dpth,_Slf,X,Y):- length(X,Len), \+ length(Y,Len),!,fail. +eval_until_eq(Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), + EX=EY,!, maplist(eval_until_eq(Eq,RetType,Depth,Self),RX,RY). +eval_until_eq(Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), + ((var(EX);var(EY)),eval_until_eq(Eq,RetType,Depth,Self,EX,EY)), + maplist(eval_until_eq(Eq,RetType,Depth,Self),RX,RY). +eval_until_eq(Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), + h((is_list(EX);is_list(EY)),eval_until_eq(Eq,RetType,Depth,Self,EX,EY)), + maplist(eval_until_eq(Eq,RetType,Depth,Self),RX,RY). + + eval_1change(Eq,RetType,Depth,Self,EX,EXX):- + eval_20(Eq,RetType,Depth,Self,EX,EXX), EX \=@= EXX. + +eval_complete_change(Eq,RetType,Depth,Self,EX,EXX):- + eval_args(Eq,RetType,Depth,Self,EX,EXX), EX \=@= EXX. + +eval_in_steps_some_change(_Eq,_RetType,_Dpth,_Slf,EX,_):- \+ is_list(EX),!,fail. +eval_in_steps_some_change(Eq,RetType,Depth,Self,EX,EXX):- eval_1change(Eq,RetType,Depth,Self,EX,EXX). +eval_in_steps_some_change(Eq,RetType,Depth,Self,X,Y):- append(L,[EX|R],X),is_list(EX), + eval_in_steps_some_change(Eq,RetType,Depth,Self,EX,EXX), EX\=@=EXX, + append(L,[EXX|R],XX),eval_in_steps_or_same(Eq,RetType,Depth,Self,XX,Y). + +eval_in_steps_or_same(Eq,RetType,Depth,Self,X,Y):-eval_in_steps_some_change(Eq,RetType,Depth,Self,X,Y). +eval_in_steps_or_same(Eq,RetType,_Dpth,_Slf,X,Y):- X=Y,check_returnval(Eq,RetType,Y). + + % (fail,make_nop(RetType,[],Template))). + + +possible_type(_Self,_Var,_RetTypeV). + +eval_20(Eq,RetType,Depth,Self,['let',E,V,Body],OO):- var(V), nonvar(E), !, + %(var(V)->true;trace), + possible_type(Self,V,RetTypeV), + eval_args(Eq,RetTypeV,Depth,Self,E,ER), V=ER, + eval_args(Eq,RetType,Depth,Self,Body,OO). + +eval_20(Eq,RetType,Depth,Self,['let',V,E,Body],OO):- !, % var(V), nonvar(E), !, + %(var(V)->true;trace), + possible_type(Self,V,RetTypeV), + eval_args(Eq,RetTypeV,Depth,Self,E,ER), V=ER, + eval_args(Eq,RetType,Depth,Self,Body,OO). +/* + +eval_20(Eq,RetType,Depth,Self,['let',V,E,Body],OO):- nonvar(V),nonvar(E),!, + possible_type(Self,V,RetTypeV), + possible_type(Self,E,RetTypeV), + ((V=E,fail) -> true; + (eval_args(Eq,RetTypeV,Depth,Self,E,ER), + (V=ER -> true; + (eval_args(Eq,RetTypeV,Depth,Self,V,VR), + (E=VR -> true; ER=VR))))), + eval_args(Eq,RetType,Depth,Self,Body,OO). + + +eval_20(Eq,RetType,Depth,Self,['let',V,E,Body],OO):- var(V), nonvar(E), !, + %(var(V)->true;trace), + possible_type(Self,V,RetTypeV), + eval_args(Eq,RetTypeV,Depth,Self,E,ER), V=ER, + eval_args(Eq,RetType,Depth,Self,Body,OO). + +eval_20(Eq,RetType,Depth,Self,['let',V,E,Body],OO):- var(V), var(E), !, + V=E, eval_args(Eq,RetType,Depth,Self,Body,OO). + + +%eval_20(Eq,RetType,Depth,Self,['let',V,E,Body],BodyO):- !,eval_args(Eq,RetType,Depth,Self,E,V),eval_args(Eq,RetType,Depth,Self,Body,BodyO). +eval_20(Eq,RetType,Depth,Self,['let*',[],Body],RetVal):- !, eval_args(Eq,RetType,Depth,Self,Body,RetVal). +%eval_20(Eq,RetType,Depth,Self,['let*',[[Var,Val]|LetRest],Body],RetVal):- !, +% eval_until_unify(Eq,_RetTypeV,Depth,Self,Val,Var), +% eval_20(Eq,RetType,Depth,Self,['let*',LetRest,Body],RetVal). +eval_20(Eq,RetType,Depth,Self,['let*',[[Var,Val]|LetRest],Body],RetVal):- !, + eval_20(Eq,RetType,Depth,Self,['let',Var,Val,['let*',LetRest,Body]],RetVal). +*/ +% ================================================================= +% ================================================================= +% ================================================================= +% TRACE/PRINT +% ================================================================= +% ================================================================= +% ================================================================= + +eval_20(Eq,RetType,_Dpth,_Slf,['repl!'],Y):- !, repl,check_returnval(Eq,RetType,Y). +%eval_20(Eq,RetType,Depth,Self,['enforce',Cond],Res):- !, enforce_true(Eq,RetType,Depth,Self,Cond,Res). +eval_20(Eq,RetType,Depth,Self,['!',Cond],Res):- !, call(eval_args(Eq,RetType,Depth,Self,Cond,Res)). +eval_20(Eq,RetType,Depth,Self,['rtrace!',Cond],Res):- !, rtrace(eval_args(Eq,RetType,Depth,Self,Cond,Res)). +eval_20(Eq,RetType,Depth,Self,['no-rtrace!',Cond],Res):- !, quietly(eval_args(Eq,RetType,Depth,Self,Cond,Res)). +eval_20(Eq,RetType,Depth,Self,['trace!',A,B],C):- !, % writeln(trace(A)), + stream_property(S,file_no(2)),!, + eval_args(Eq,RetType,Depth,Self,B,C), + ignore((eval_args(Eq,_RetType,Depth,Self,A,AA), + with_output_to(S,(format('~N'), write_src(AA),format('~N'))))). +eval_20(Eq,RetType,Depth,Self,['trace',Cond],Res):- !, with_debug(eval_args,eval_args(Eq,RetType,Depth,Self,Cond,Res)). +eval_20(Eq,RetType,Depth,Self,['profile!',Cond],Res):- !, time_eval(profile(Cond),profile(eval_args(Eq,RetType,Depth,Self,Cond,Res))). +eval_20(Eq,RetType,Depth,Self,['time!',Cond],Res):- !, time_eval(eval_args(Cond),eval_args(Eq,RetType,Depth,Self,Cond,Res)). +eval_20(Eq,RetType,Depth,Self,['print',Cond],Res):- !, eval_args(Eq,RetType,Depth,Self,Cond,Res),format('~N'),print(Res),format('~N'). +% !(print! $1) +eval_20(Eq,RetType,Depth,Self,['princ!'|Cond],Res):- !, + maplist(eval_args(Eq,RetType,Depth,Self),Cond,Out), + maplist(princ_impl,Out), + make_nop(RetType,[],Res),check_returnval(Eq,RetType,Res). +% !(println! $1) +eval_20(Eq,RetType,Depth,Self,['println!'|Cond],Res):- !, + maplist(eval_args(Eq,RetType,Depth,Self),Cond,Out), + maplist(println_impl,Out), + make_nop(RetType,[],Res),check_returnval(Eq,RetType,Res). + +println_impl(X):- format("~N~@~N",[write_sln(X)]),!. +println_impl(X):- user_io((ansi_format(fg('#c7ea46'),"~N~@~N",[write_sln(X)]))). + +princ_impl(X):- format("~@",[write_sln(X)]),!. + +write_sln(X):- string(X), !, write(X). +write_sln(X):- write_src_woi(X). + +with_output_to_str( Sxx , Goal ):- + wots( Sxx , Goal ). + +% ================================================================= +% ================================================================= +% ================================================================= +% UNIT TESTING/assert +% ================================================================= +% ================================================================= +% ================================================================= + + +eval_20(Eq,RetType,Depth,Self,['assertTrue', X],TF):- !, + eval_20(Eq,RetType,Depth,Self,['assertEqual',X,'True'],TF). +eval_20(Eq,RetType,Depth,Self,['assertFalse',X],TF):- !, + eval_20(Eq,RetType,Depth,Self,['assertEqual',X,'False'],TF). + +eval_20(Eq,_RetType,Depth,Self,['assertEqual',X,Y],RetVal):- !, + loonit_assert_source_tf_empty( + ['assertEqual',X,Y],XX,YY, + (findall_eval(Eq,_ARetType,Depth,Self,X,XX), + findall_eval(Eq,_BRetType,Depth,Self,Y,YY)), + equal_enough_for_test(XX,YY), RetVal). + +eval_20(Eq,_RetType,Depth,Self,['assertNotEqual',X,Y],RetVal):- !, + loonit_assert_source_tf_empty( + ['assertNotEqual',X,Y],XX,YY, + (findall_eval(Eq,_ARetType,Depth,Self,X,XX), + findall_eval(Eq,_BRetType,Depth,Self,Y,YY)), + ( \+ equal_enough(XX,YY)), RetVal). + +eval_20(Eq,_RetType,Depth,Self,['assertEqualToResult',X,Y],RetVal):- !, + loonit_assert_source_tf_empty( + ['assertEqualToResult',X,Y],XX,YY, + (findall_eval(Eq,_ARetType,Depth,Self,X,XX), + =(Y,YY)), + equal_enough_for_test(XX,YY), RetVal). + +loonit_assert_source_tf_empty(Src,XX,YY,Goal,Check,RetVal):- + loonit_assert_source_tf(Src,Goal,Check,TF), + tf_to_empty(TF,['Error'(got(XX),expected(YY))],RetVal). + +tf_to_empty(TF,Else,RetVal):- + (TF=='True'->as_nop(RetVal);RetVal=Else). + +val_sort(Y,YY):- is_list(Y),!,sort(Y,YY). +val_sort(Y,[Y]). + +loonit_assert_source_tf(_Src,Goal,Check,TF):- fail, \+ is_testing,!, + reset_eval_num, + call(Goal), + as_tf(Check,TF),!. + +loonit_assert_source_tf(Src,Goal,Check,TF):- + copy_term(Goal,OrigGoal), + reset_eval_num, + call_cleanup(loonit_asserts(Src, time_eval('\n; EVAL TEST\n;',Goal), Check), + (as_tf(notrace(Check),TF),!, + ignore(( + once((TF='True', trace_on_pass);(TF='False', trace_on_fail)), + with_debug((eval_args),time_eval('Trace',OrigGoal)))))). + +sort_result(Res,Res):- \+ compound(Res),!. +sort_result([And|Res1],Res):- is_and(And),!,sort_result(Res1,Res). +sort_result([T,And|Res1],Res):- is_and(And),!,sort_result([T|Res1],Res). +sort_result([H|T],[HH|TT]):- !, sort_result(H,HH),sort_result(T,TT). +sort_result(Res,Res). + + +unify_case(A,B):- A=@=B,!,A=B. +unify_case(A,B):- A=B,!. + +unify_enough(L,L). +unify_enough(L,C):- into_list_args(L,LL),into_list_args(C,CC),unify_lists(CC,LL). + +%unify_lists(C,L):- \+ compound(C),!,L=C. +%unify_lists(L,C):- \+ compound(C),!,L=C. +unify_lists(L,L):-!. +unify_lists([C|CC],[L|LL]):- unify_enough(L,C),!,unify_lists(CC,LL). + +is_blank(X):- var(X),!,fail. +is_blank(E):- is_empty(E),!. +is_blank([]). +is_blank([X]):-!,is_blank(X). +has_let_star(Y):- sub_var('let*',Y). + +sort_univ(L,S):- cl_list_to_set(L,E),sort(E,S). +% !(pragma! unit-tests tollerant) ; tollerant or exact +is_tollerant:- \+ option_value('unit-tests','exact'). + +equal_enough_for_test(X,Y):- X==Y,!. +equal_enough_for_test(X,Y):- X=@=Y,!. +equal_enough_for_test(X,Y):- is_list(X),is_list(Y),sort(X,X0),sort(Y,Y0), + Y0=[YY],X0=[XX],!,equal_enough_for_test(XX,YY). +equal_enough_for_test(X,Y):- is_list(X),is_list(Y),X=[ErrorX|_],Y=[ErrorY|_],ErrorX=='Error', + ErrorY == ErrorX,!. +equal_enough_for_test(X,Y):- is_blank(X),!,is_blank(Y). +equal_enough_for_test(X,Y):- has_let_star(Y),!,\+ is_blank(X). +equal_enough_for_test(X,Y):- is_list(X),is_list(Y), + Y=[YY],X=[XX],!,equal_enough_for_test(XX,YY). + %length(XX,XL),length(YY,YL), + +%equal_enough_for_test(X,Y):-!,fail. + +equal_enough_for_test(X,Y):- must_det_ll((subst_vars(X,XX),subst_vars(Y,YY))),!, + equal_enough_for_test2(XX,YY),!. +equal_enough_for_test2(X,Y):- equal_enough(X,Y). + +equal_enough(R,V):- is_list(R),is_list(V),sort_univ(R,RR),sort_univ(V,VV),!,equal_enouf(RR,VV),!. +equal_enough(R,V):- copy_term(R,RR),copy_term(V,VV),equal_enouf(R,V),!,R=@=RR,V=@=VV. +equal_enouf(R,V):- is_ftVar(R), is_ftVar(V), R=V,!. +equal_enouf(X,Y):- is_blank(X),!,is_blank(Y). +equal_enouf(X,Y):- symbol(X),symbol(Y),atom_concat('&',_,X),atom_concat('Grounding',_,Y). +equal_enouf(R,V):- R=@=V, R=V, !. +equal_enouf(_,V):- V=@='...',!. + +equal_enouf(L,C):- is_tollerant, is_list(L),is_list(C), + maybe_remove_nils(C,CC),equal_enouf(L,CC). + +equal_enouf(L,C):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). +equal_enouf(C,L):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). +%equal_enouf(R,V):- (var(R),var(V)),!, R=V. +equal_enouf(R,V):- (var(R);var(V)),!, R==V. +equal_enouf(R,V):- number(R),number(V),!, RV is abs(R-V), RV < 0.03 . +equal_enouf(R,V):- atom(R),!,atom(V), has_unicode(R),has_unicode(V). +equal_enouf(R,V):- (\+ compound(R) ; \+ compound(V)),!, R==V. +equal_enouf(L,C):- into_list_args(L,LL),into_list_args(C,CC),!,equal_enouf_l(CC,LL). + +equal_enouf_l([S1,V1|_],[S2,V2|_]):- S1 == 'State',S2 == 'State',!, equal_enouf(V1,V2). +equal_enouf_l(C,L):- \+ compound(C),!,L=@=C. +equal_enouf_l(L,C):- \+ compound(C),!,L=@=C. +equal_enouf_l([C|CC],[L|LL]):- !, equal_enouf(L,C),!,equal_enouf_l(CC,LL). + +maybe_remove_nils(I,O):- always_remove_nils(I,O),!,I\=@=O. +always_remove_nils(I,O):- \+ compound(I),!,I=O. +always_remove_nils([H|T], TT):- H==[],!, always_remove_nils(T,TT). +always_remove_nils([H|T], TT):- H=='Empty',!, always_remove_nils(T,TT). +always_remove_nils([H|T],[H|TT]):- always_remove_nils(T,TT). + +has_unicode(A):- atom_codes(A,Cs),member(N,Cs),N>127,!. + +set_last_error(_). + +% ================================================================= +% ================================================================= +% ================================================================= +% SPACE EDITING +% ================================================================= +% ================================================================= +% ================================================================= + +eval_20(Eq,RetType,_Dpth,_Slf,['new-space'],Space):- !, 'new-space'(Space),check_returnval(Eq,RetType,Space). + +eval_20(Eq,RetType,Depth,Self,[Op,Space|Args],Res):- is_space_op(Op),!, + eval_space_start(Eq,RetType,Depth,Self,[Op,Space|Args],Res). +eval_20(Eq,RetType,Depth,Self,['unify',Space|Args],Res):- !, + eval_space_start(Eq,RetType,Depth,Self,['match',Space|Args],Res). + +eval_space_start(Eq,RetType,_Depth,_Self,[_Op,_Other,Atom],Res):- + (Atom == [] ; Atom =='Empty'; Atom =='Nil'),!,make_nop(RetType,'False',Res),check_returnval(Eq,RetType,Res). + +eval_space_start(Eq,RetType,Depth,Self,[Op,Other|Args],Res):- + into_space(Depth,Self,Other,Space), + eval_space(Eq,RetType,Depth,Self,[Op,Space|Args],Res). + + +eval_space(Eq,RetType,_Dpth,_Slf,['add-atom',Space,PredDecl],Res):- !, + do_metta(python,load,Space,PredDecl,TF),make_nop(RetType,TF,Res),check_returnval(Eq,RetType,Res). + +eval_space(Eq,RetType,_Dpth,_Slf,['remove-atom',Space,PredDecl],Res):- !, + do_metta(python,unload_all,Space,PredDecl,TF), + make_nop(RetType,TF,Res),check_returnval(Eq,RetType,Res). + +eval_space(Eq,RetType,_Dpth,_Slf,['atom-count',Space],Count):- !, + ignore(RetType='Number'),ignore(Eq='='), + 'atom-count'(Space, Count). + %findall(Atom, metta_atom(Space, Atom),Atoms), + %length(Atoms,Count). + +eval_space(Eq,RetType,_Dpth,_Slf,['atom-replace',Space,Rem,Add],TF):- !, + copy_term(Rem,RCopy), as_tf((metta_atom_iter_ref(Space,RCopy,Ref), RCopy=@=Rem,erase(Ref), do_metta(Space,load,Add)),TF), + check_returnval(Eq,RetType,TF). + +eval_space(Eq,RetType,_Dpth,_Slf,['get-atoms',Space],Atom):- !, + ignore(RetType='Atom'), + get_metta_atom_from(Space, Atom), + check_returnval(Eq,RetType,Atom). + +% Match-ELSE +eval_space(Eq,RetType,Depth,Self,['match',Other,Goal,Template,Else],Template):- !, + ((eval_space(Eq,RetType,Depth,Self,['match',Other,Goal,Template],Template), + \+ make_nop(RetType,[],Template))*->true;Template=Else). +% Match-TEMPLATE + +eval_space(Eq,RetType,Depth,Self,['match',Other,Goal,Template],Res):- !, + metta_atom_iter(Eq,Depth,Self,Other,Goal), + eval_args(Eq,RetType,Depth,Self,Template,Res). + +%metta_atom_iter(Eq,_Depth,_Slf,Other,[Equal,[F|H],B]):- Eq == Equal,!, % trace, +% metta_eq_def(Eq,Other,[F|H],B). + +/* +metta_atom_iter(Eq,Depth,Self,Other,[Equal,[F|H],B]):- Eq == Equal,!, % trace, + metta_eq_def(Eq,Other,[F|H],BB), + eval_sometimes(Eq,_RetType,Depth,Self,B,BB). +*/ + +metta_atom_iter(_Eq,Depth,_,_,_):- Depth<3,!,fail. +metta_atom_iter(Eq,Depth,Self,Other,[And|Y]):- atom(And), is_comma(And),!, + (Y==[] -> true ; + ( D2 is Depth -1, Y = [H|T], + metta_atom_iter(Eq,D2,Self,Other,H),metta_atom_iter(Eq,D2,Self,Other,[And|T]))). + +%metta_atom_iter(Eq,Depth,_Slf,Other,X):- dcall0000000000(eval_args_true(Eq,_RetType,Depth,Other,X)). +metta_atom_iter(Eq,Depth,Self,Other,X):- + %copy_term(X,XX), + dcall0000000000(metta_atom_true(Eq,Depth,Self,Other,XX)), X=XX. + +metta_atom_true(_Eq,Depth,Self,Other,H):- + can_be_ok(metta_atom_true,H), + into_space(Depth,Self,Other,Space), + metta_atom(Space,H). +% is this OK? +%metta_atom_true(Eq,Depth,Self,Other,H):- nonvar(H), metta_eq_def(Eq,Other,H,B), D2 is Depth -1, eval_args_true(Eq,_,D2,Self,B). +% is this OK? +%metta_atom_true(Eq,Depth,Self,Other,H):- Other\==Self, nonvar(H), metta_eq_def(Eq,Other,H,B), D2 is Depth -1, eval_args_true(Eq,_,D2,Other,B). + + + +eval_args_true_r(Eq,RetType,Depth,Self,X,TF1):- + ((eval_ne(Eq,RetType,Depth,Self,X,TF1), \+ is_False(TF1)); + ( \+ is_False(TF1),metta_atom_true(Eq,Depth,Self,Self,X))). + +eval_args_true(Eq,RetType,Depth,Self,X):- + % can_be_ok(eval_args_true,X), + % metta_atom_true(Eq,Depth,Self,Self,X); + (nonvar(X),eval_ne(Eq,RetType,Depth,Self,X,TF1), \+ is_False(TF1)). + + +metta_atom_iter_ref(Other,H,Ref):-clause(metta_atom_asserted(Other,H),true,Ref). +can_be_ok(A,B):- cant_be_ok(A,B),!,fbug(cant_be_ok(A,B)),trace. +can_be_ok(_,_). + +cant_be_ok(_,[Let|_]):- Let==let. +% ================================================================= +% ================================================================= +% ================================================================= +% CASE/SWITCH +% ================================================================= +% ================================================================= +% ================================================================= +% Macro: case +:- nodebug(metta(case)). + +eval_20(Eq,RetType,Depth,Self,['switch',A,CL|T],Res):- !, + eval_20(Eq,RetType,Depth,Self,['case',A,CL|T],Res). + +% if there is only a void then always return nothing for each Case +eval_20(Eq,_RetType,Depth,Self,['case',A,[[Void,_]]],Res):- + '%void%' == Void, + eval_args(Eq,_UnkRetType,Depth,Self,A,_),!,Res =[]. + +% if there is nothing for case just treat like a collapse +eval_20(Eq,RetType,Depth,Self,['case',A,[]],NoResult):- !, + %forall(eval_args(Eq,_RetType2,Depth,Self,Expr,_),true), + once(eval_args(Eq,_RetType2,Depth,Self,A,_)), + make_nop(RetType,[],NoResult). + + +into_case_keys(_,[],[]). +into_case_keys(Nth,[Case0|CASES],[Key-Value|KVs]):- + Nth1 is Nth+1, + is_case(Key,Case0,Value), + if_trace((case),(format('~N'),writeqln(c(Nth,Key)=Value))), + into_case_keys(Nth1,CASES,KVs). + +% Macro: case +eval_20(Eq,RetType,Depth,Self,['case',A,CL|T],Res):- !, + must_det_ll(T==[]), + into_case_list(CL,CASES), + into_case_keys(1,CASES,KVs), + eval_case(Eq,RetType,Depth,Self,A,KVs,Res). + +eval_case(Eq,CaseRetType,Depth,Self,A,KVs,Res):- + if_trace((case),(writeqln('case'=A))), + ((eval_args(Eq,_UnkRetType,Depth,Self,A,AA), + if_trace((case),writeqln('switch'=AA)), + (select_case(Depth,Self,AA,KVs,Value)->true;(member(Void -Value,KVs),Void=='%void%'))) + *->true;(member(Void -Value,KVs),Void=='%void%')), + eval_args(Eq,CaseRetType,Depth,Self,Value,Res). + + select_case(Depth,Self,AA,Cases,Value):- + (best_key(AA,Cases,Value) -> true ; + (maybe_special_keys(Depth,Self,Cases,CasES), + (best_key(AA,CasES,Value) -> true ; + (member(Void -Value,CasES),Void=='%void%')))). + + best_key(AA,Cases,Value):- member(Match-Value,Cases),AA = Match,!. + best_key(AA,Cases,Value):- + ((member(Match-Value,Cases),AA ==Match)->true; + ((member(Match-Value,Cases),AA=@=Match)->true; + (member(Match-Value,Cases),AA = Match))). + + into_case_list(CASES,CASES):- is_list(CASES),!. + is_case(AA,[AA,Value],Value):-!. + is_case(AA,[AA|Value],Value). + + maybe_special_keys(Depth,Self,[K-V|KVI],[AK-V|KVO]):- + eval_args(Depth,Self,K,AK), K\=@=AK,!, + maybe_special_keys(Depth,Self,KVI,KVO). + maybe_special_keys(Depth,Self,[_|KVI],KVO):- + maybe_special_keys(Depth,Self,KVI,KVO). + maybe_special_keys(_Depth,_Self,[],[]). + + +% ================================================================= +% ================================================================= +% ================================================================= +% COLLAPSE/SUPERPOSE +% ================================================================= +% ================================================================= +% ================================================================= + +%;; collapse-bind because `collapse` doesnt guarentee shared bindings +eval_20(Eq,RetType,Depth,Self,['collapse-bind',List],Res):-!, + maplist_ok_fails(eval_ne(Eq,RetType,Depth,Self),List,Res). + +maplist_ok_fails(Pred2,[A|AA],BBB):- !, + (call(Pred2,A,B) -> (BBB=[B|BB], maplist_ok_fails(Pred2,AA,BB)) + ; maplist_ok_fails(Pred2,AA,BBB)). +maplist_ok_fails(_Pred2,[],[]). + +%;; superpose-bind because `superpose` doesnt guarentee shared bindings +% @TODO need to keep bindings +eval_20(Eq,RetType,Depth,Self,['superpose-bind',List],Res):- !, + re_member(Res,E,List), + eval_ret(Eq,RetType,Depth,Self,E,Res). + +re_member(Res,E,List):- term_variables(Res+E+List,TV),copy_term(TV,Copy), + member(E,List),TV=Copy. + +%[collapse,[1,2,3]] +eval_20(Eq,RetType,Depth,Self,['collapse',List],Res):-!, + findall_eval(Eq,RetType,Depth,Self,List,Res). + + +eval_20(Eq,RetType,Depth,Self,['superpose',List],Res):- !, + member(E,List), + eval_ret(Eq,RetType,Depth,Self,E,Res). + +%[superpose,[1,2,3]] +old_eval_20(_Eq,RetType,_Depth,_Self,['superpose',List],Res):- List==[], !, + make_empty(RetType,[],Res). +old_eval_20(Eq,RetType,Depth,Self,['superpose',List],Res):- !, + ((( + is_user_defined_head(Eq,Self,List) ,eval_args(Eq,RetType,Depth,Self,List,UList), + List\=@=UList) + *-> eval_20(Eq,RetType,Depth,Self,['superpose',UList],Res) + ; ((member(E,List),eval_args(Eq,RetType,Depth,Self,E,Res))*->true;make_nop(RetType,[],Res)))), + \+ Res = 'Empty'. + +%[sequential,[1,2,3]] +eval_20(Eq,RetType,Depth,Self,['sequential',List],Res):- !, + (((fail,is_user_defined_head(Eq,Self,List) ,eval_args(Eq,RetType,Depth,Self,List,UList), List\=@=UList) + *-> eval_20(Eq,RetType,Depth,Self,['sequential',UList],Res) + ; ((member(E,List),eval_ne(Eq,RetType,Depth,Self,E,Res))*->true;make_nop(RetType,[],Res)))). + + +get_sa_p1(P3,E,Cmpd,SA):- compound(Cmpd), get_sa_p2(P3,E,Cmpd,SA). +get_sa_p2(P3,E,Cmpd,call(P3,N1,Cmpd)):- arg(N1,Cmpd,E). +get_sa_p2(P3,E,Cmpd,SA):- arg(_,Cmpd,Arg),get_sa_p1(P3,E,Arg,SA). +eval20_failed(Eq,RetType,Depth,Self, Term, Res):- + notrace(( get_sa_p1(setarg,ST,Term,P1), % ST\==Term, + compound(ST), ST = [F,List],F=='superpose',nonvar(List), %maplist(atomic,List), + call(P1,Var))), !, + %max_counting(F,20), + member(Var,List), + eval_args(Eq,RetType,Depth,Self, Term, Res). + + +sub_sterm(Sub,Sub). +sub_sterm(Sub,Term):- sub_sterm1(Sub,Term). +sub_sterm1(_ ,List):- \+ compound(List),!,fail. +sub_sterm1(Sub,List):- is_list(List),!,member(SL,List),sub_sterm(Sub,SL). +sub_sterm1(_ ,[_|_]):-!,fail. +sub_sterm1(Sub,Term):- arg(_,Term,SL),sub_sterm(Sub,SL). +eval20_failed_2(Eq,RetType,Depth,Self, Term, Res):- + notrace(( get_sa_p1(setarg,ST,Term,P1), + compound(ST), ST = [F,List],F=='collapse',nonvar(List), %maplist(atomic,List), + call(P1,Var))), !, findall_eval(Eq,RetType,Depth,Self,List,Var), + eval_args(Eq,RetType,Depth,Self, Term, Res). + + +% ================================================================= +% ================================================================= +% ================================================================= +% NOP/EQUALITU/DO +% ================================================================= +% ================================================================= +% ================================================================ +eval_20(_Eq,RetType,_Depth,_Self,['nop'], NoResult ):- !, + make_nop(RetType,[], NoResult). +eval_20(_Eq,RetType,_Depth,_Self,['empty'], Empty ):- !, + make_empty(RetType, Empty). +eval_20(_Eq,RetType,Depth,Self,['nop',Expr], NoResult ):- !, + make_nop(RetType,[], NoResult), + ignore(eval_args('=',_RetType2,Depth,Self,Expr,_)). + + +eval_20(Eq,RetType,Depth,Self,['do',Expr], NoResult):- !, + forall(eval_args(Eq,_RetType2,Depth,Self,Expr,_),true), + %eval_ne(Eq,_RetType2,Depth,Self,Expr,_),!, + make_empty(RetType,[],NoResult). + +eval_20(_Eq,_RetType1,_Depth,_Self,['call!',S], TF):- !, eval_call(S,TF). +eval_20(_Eq,_RetType1,_Depth,_Self,['call-fn!',S], R):- !, eval_call_fn(S,R). +eval_20(_Eq,_RetType1,_Depth,_Self,['call-fn-nth!',Nth,S], R):- + length(Left,Nth), + append(Left,Right,S), + append(Left,[R|Right],NewS),!, + eval_call(NewS,_). + +max_counting(F,Max):- flag(F,X,X+1), X true; (flag(F,_,10),!,fail). + + +% ================================================================= +% ================================================================= +% ================================================================= +% CONS/DECONS +% ================================================================= +% ================================================================= +% ================================================================= + +must_unify(A,A):-!. +must_unify(A,B):- fail, throw('Error-last-form'(must_unify(A,B))). % @TODO + +% OLD +eval_20(_Eq,_RetType,_Depth,_Self,['decons-atom',OneArg],[H,T]):- OneArg==[], !, fail. %H=[],T=[],!. +eval_20(_Eq,_RetType,_Depth,_Self,['decons-atom',OneArg],[H,T]):- !, must_unify(OneArg,[H|T]). +eval_20(_Eq,_RetType,_Depth,_Self,['cons-atom'|TwoArgs],[H|T]):-!, must_unify(TwoArgs,[H,T]). +% NEW +eval_20(_Eq,_RetType,_Depth,_Self,['decons',OneArg],[H,T]):- !, must_unify(OneArg,[H|T]). +eval_20(_Eq,_RetType,_Depth,_Self,['cons'|TwoArgs],[H|T]):-!, must_unify(TwoArgs,[H,T]). + + +% ================================================================= +% ================================================================= +% ================================================================= +% if/If +% ================================================================= +% ================================================================= +% ================================================================= + +eval_20(Eq,RetType,Depth,Self,['unify',X,Y,Then,Else],Res):- !, + (X=Y + -> eval_args(Eq,RetType,Depth,Self,Then,Res) + ; eval_args(Eq,RetType,Depth,Self,Else,Res)). + + +eval_20(Eq,RetType,Depth,Self,['if-equal',X,Y,Then,Else],Res):- !, + eval_args(Eq,'Bool',Depth,Self,['==',X,Y],TF), + (is_True(TF) + -> eval_args(Eq,RetType,Depth,Self,Then,Res) + ; eval_args(Eq,RetType,Depth,Self,Else,Res)). + + +eval_20(Eq,RetType,Depth,Self,['if',Cond,Then,Else],Res):- !, + eval_args(Eq,'Bool',Depth,Self,Cond,TF), + (is_True(TF) + -> eval_args(Eq,RetType,Depth,Self,Then,Res) + ; eval_args(Eq,RetType,Depth,Self,Else,Res)). + +eval_20(Eq,RetType,Depth,Self,['If',Cond,Then,Else],Res):- !, + eval_args(Eq,'Bool',Depth,Self,Cond,TF), + (is_True(TF) + -> eval_args(Eq,RetType,Depth,Self,Then,Res) + ; eval_args(Eq,RetType,Depth,Self,Else,Res)). + +eval_20(Eq,RetType,Depth,Self,['If',Cond,Then],Res):- !, + eval_args(Eq,'Bool',Depth,Self,Cond,TF), + (is_True(TF) -> eval_args(Eq,RetType,Depth,Self,Then,Res) ; + (!, fail,Res = [],!)). + +eval_20(Eq,RetType,Depth,Self,['if',Cond,Then],Res):- !, + eval_args(Eq,'Bool',Depth,Self,Cond,TF), + (is_True(TF) -> eval_args(Eq,RetType,Depth,Self,Then,Res) ; + (!, fail,Res = [],!)). + + +eval_20(Eq,RetType,_Dpth,_Slf,[_,Nothing],NothingO):- + 'Nothing'==Nothing,!,do_expander(Eq,RetType,Nothing,NothingO). + + +% ================================================================= +% ================================================================= +% ================================================================= +% CONS/CAR/CDR +% ================================================================= +% ================================================================= +% ================================================================= + + + +into_pl_list(Var,Var):- var(Var),!. +into_pl_list(Nil,[]):- Nil == 'Nil',!. +into_pl_list([Cons,H,T],[HH|TT]):- Cons == 'Cons', !, into_pl_list(H,HH),into_pl_list(T,TT),!. +into_pl_list(X,X). + +into_metta_cons(Var,Var):- var(Var),!. +into_metta_cons([],'Nil'):-!. +into_metta_cons([Cons, A, B ],['Cons', AA, BB]):- 'Cons'==Cons, no_cons_reduce, !, + into_metta_cons(A,AA), into_metta_cons(B,BB). +into_metta_cons([H|T],['Cons',HH,TT]):- into_metta_cons(H,HH),into_metta_cons(T,TT),!. +into_metta_cons(X,X). + +into_listoid(AtomC,Atom):- AtomC = [Cons,H,T],Cons=='Cons',!, Atom=[H,[T]]. +into_listoid(AtomC,Atom):- is_list(AtomC),!,Atom=AtomC. +into_listoid(AtomC,Atom):- typed_list(AtomC,_,Atom),!. + +:- if( \+ current_predicate( typed_list / 3 )). +typed_list(Cmpd,Type,List):- compound(Cmpd), Cmpd\=[_|_], compound_name_arguments(Cmpd,Type,[List|_]),is_list(List). +:- endif. + +%eval_20(Eq,RetType,Depth,Self,['colapse'|List], Flat):- !, maplist(eval_args(Eq,RetType,Depth,Self),List,Res),flatten(Res,Flat). + +%eval_20(Eq,RetType,Depth,Self,['flatten'|List], Flat):- !, maplist(eval_args(Eq,RetType,Depth,Self),List,Res),flatten(Res,Flat). + + +eval_20(Eq,RetType,_Dpth,_Slf,['car-atom',Atom],CAR_Y):- !, Atom=[CAR|_],!,do_expander(Eq,RetType,CAR,CAR_Y). +eval_20(Eq,RetType,_Dpth,_Slf,['cdr-atom',Atom],CDR_Y):- !, Atom=[_|CDR],!,do_expander(Eq,RetType,CDR,CDR_Y). + +eval_20(Eq,RetType,Depth,Self,['Cons', A, B ],['Cons', AA, BB]):- no_cons_reduce, !, + eval_args(Eq,RetType,Depth,Self,A,AA), eval_args(Eq,RetType,Depth,Self,B,BB). + +%eval_20(_Eq,_RetType,Depth,Self,['::'|PL],Prolog):- maplist(as_prolog(Depth,Self),PL,Prolog),!. +%eval_20(_Eq,_RetType,Depth,Self,['@'|PL],Prolog):- as_prolog(Depth,Self,['@'|PL],Prolog),!. + +eval_20(Eq,RetType,Depth,Self,['Cons', A, B ],[AA|BB]):- \+ no_cons_reduce, !, + eval_args(Eq,RetType,Depth,Self,A,AA), eval_args(Eq,RetType,Depth,Self,B,BB). + + + +% ================================================================= +% ================================================================= +% ================================================================= +% STATE EDITING +% ================================================================= +% ================================================================= +% ================================================================= + +eval_20(Eq,RetType,Depth,Self,['change-state!',StateExpr, UpdatedValue], Ret):- !, + call_in_shared_space(((eval_args(Eq,RetType,Depth,Self,StateExpr,StateMonad), + eval_args(Eq,RetType,Depth,Self,UpdatedValue,Value), + catch_metta_return('change-state!'(Depth,Self,StateMonad, Value, Ret),Ret)))). +eval_20(Eq,RetType,Depth,Self,['new-state',UpdatedValue],StateMonad):- !, + call_in_shared_space(((eval_args(Eq,RetType,Depth,Self,UpdatedValue,Value), 'new-state'(Depth,Self,Value,StateMonad)))). +eval_20(Eq,RetType,Depth,Self,['get-state',StateExpr],Value):- !, + call_in_shared_space((eval_args(Eq,RetType,Depth,Self,StateExpr,StateMonad), 'get-state'(StateMonad,Value))). + +call_in_shared_space(G):- call_in_thread(main,G). + +% eval_20(Eq,RetType,Depth,Self,['get-state',Expr],Value):- !, eval_args(Eq,RetType,Depth,Self,Expr,State), arg(1,State,Value). + + +check_state_type:- !. +check_type:- option_else(typecheck,TF,'False'),!, TF=='True'. + +:- dynamic is_registered_state/1. +:- flush_output. +:- setenv('RUST_BACKTRACE',full). + +% Function to check if an value is registered as a state name +:- dynamic(is_registered_state/1). +is_nb_state(G):- is_valid_nb_state(G) -> true ; + is_registered_state(G),nb_bound(G,S),is_valid_nb_state(S). + + +:- multifile(state_type_method/3). +:- dynamic(state_type_method/3). +state_type_method(is_nb_state,new_state,init_state). +state_type_method(is_nb_state,clear_state,clear_nb_values). +state_type_method(is_nb_state,add_value,add_nb_value). +state_type_method(is_nb_state,remove_value,'change-state!'). +state_type_method(is_nb_state,replace_value,replace_nb_value). +state_type_method(is_nb_state,value_count,value_nb_count). +state_type_method(is_nb_state,'get-state','get-state'). +state_type_method(is_nb_state,value_iter,value_nb_iter). +%state_type_method(is_nb_state,query,state_nb_query). + +% Clear all values from a state +clear_nb_values(StateNameOrInstance) :- + fetch_or_create_state(StateNameOrInstance, State), + nb_setarg(1, State, []). + + + +% Function to confirm if a term represents a state +is_valid_nb_state(State):- compound(State),compound_name_arity(State,'State',N),N>0. + +% Find the original name of a given state +state_original_name(State, Name) :- + is_registered_state(Name), + call_in_shared_space(nb_bound(Name, State)). + +% Register and initialize a new state +init_state(Name) :- + State = 'State'(_,_), + asserta(is_registered_state(Name)), + call_in_shared_space(nb_setval(Name, State)). + +% Change a value in a state +'change-state!'(Depth,Self,StateNameOrInstance, UpdatedValue, Out) :- + fetch_or_create_state(StateNameOrInstance, State), + arg(2, State, Type), + ( (check_type,\+ get_type(Depth,Self,UpdatedValue,Type)) + -> (Out = ['Error', UpdatedValue, 'BadType']) + ; (nb_setarg(1, State, UpdatedValue), Out = State) ). + +% Fetch all values from a state +'get-state'(StateNameOrInstance, Values) :- + fetch_or_create_state(StateNameOrInstance, State), + arg(1, State, Values). + +'new-state'(Depth,Self,Init,'State'(Init, Type)):- check_type->get_type(Depth,Self,Init,Type);true. + +'new-state'(Init,'State'(Init, Type)):- check_type->get_type(10,'&self',Init,Type);true. + +fetch_or_create_state(Name):- fetch_or_create_state(Name,_). +% Fetch an existing state or create a new one + +fetch_or_create_state(State, State) :- is_valid_nb_state(State),!. +fetch_or_create_state(NameOrInstance, State) :- + ( atom(NameOrInstance) + -> (is_registered_state(NameOrInstance) + -> nb_bound(NameOrInstance, State) + ; init_state(NameOrInstance), + nb_bound(NameOrInstance, State)) + ; is_valid_nb_state(NameOrInstance) + -> State = NameOrInstance + ; writeln('Error: Invalid input.') + ), + is_valid_nb_state(State). + +% ================================================================= +% ================================================================= +% ================================================================= +% GET-TYPE +% ================================================================= +% ================================================================= +% ================================================================= + +eval_20(_Eq,_RetType,Depth,Self,['get-types',Val],TypeO):- !, + get_types(Depth,Self,Val,TypeO). + +% use default self +eval_20(Eq,RetType,Depth,Self,['get-type',Val,Self],Type):- current_self(Self), !, + eval_20(Eq,RetType,Depth,Self,['get-type',Val],Type). + +% use other space +eval_20(Eq,RetType,Depth,Self,['get-type',Val,Other],Type):- !, + into_space(Depth,Self,Other,Space), + eval_20(Eq,RetType,Depth,Space,['get-type',Val],Type). + +eval_20(_Eq,_RetType,Depth,Self,['get-type',Val],Type):- is_list(Val), !, + catch_metta_return(get_type(Depth,Self,Val,Type),TypeM), + var(TypeM). + +eval_20(Eq,RetType,Depth,Self,['get-type',Val],TypeO):- !, + if_or_else(get_type(Depth,Self,Val,Type),Type='%Undefined%'), + %term_singletons(Type,[]), + %Type\==[], Type\==Val,!, + do_expander(Eq,RetType,Type,TypeO). + +% eval_20(Eq,RetType,Depth,Self,['get-type-space',Other,Val],Type):- !, +% into_space(Depth,Self,Other,Space), +% eval_20(Eq,RetType,Depth,Space,['get-type',Val],Type). + +eval_20(Eq,RetType,Depth,Self,['length',L],Res):- !, eval_args(Eq,RetType,Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). +eval_20(Eq,RetType,Depth,Self,['CountElement',L],Res):- !, eval_args(Eq,RetType,Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). + +eval_20(_Eq,_RetType,_Depth,_Self,['get-metatype',Val],TypeO):- !, + 'get-metatype'(Val,TypeO). + +'get-metatype'(Val,Type):- get_metatype0(Val,Was),!,Type=Was. + get_metatype0(Val,'Variable'):- var(Val),!. + get_metatype0(Val,Type):- symbol(Val), !, get_symbol_metatype(Val,Type). + get_metatype0(Val,'Expression'):- is_list(Val),!. +get_metatype0(_Val,'Grounded'). + +get_symbol_metatype(Val,Type):- get_type(Val,Want),get_symbol_metatype(Val,Want,Type). +get_symbol_metatype(_Vl,'Bool','Grounded'). +get_symbol_metatype(Val,_Want,Type):- nb_current(Val,NewVal),'get-metatype'(NewVal,Type). +get_symbol_metatype(_Vl,'%Undefined%','Symbol'). +get_symbol_metatype(_Vl,_Want,'Grounded'). + +% ================================================================= +% ================================================================= +% ================================================================= +% STRINGS +% ================================================================= +% ================================================================= +% ================================================================= + +as_metta_char(X,'#\\'(X)). + +eval_20(Eq,RetType,Depth,Self,['stringToChars',String],Chars):- !, eval_args(Eq,RetType,Depth,Self,String,SS), string_chars(SS,Chars0), maplist(as_metta_char,Chars0,Chars). +eval_20(Eq,RetType,Depth,Self,['charsToString',Chars],String):- !, eval_args(Eq,RetType,Depth,Self,Chars,CC), maplist(as_metta_char,CC0,CC), string_chars(String,CC0). + +% We deal with indexing, but not formatting (the stuff following the ':')(yet) +% https://doc.rust-lang.org/std/fmt/ used as a reference + +format_args_get_index([C|FormatRest1], FormatRest2, Index2) :- char_code(C, Ccode), Ccode >= 48, Ccode =< 57, !, % in the range ['0'..'9'] + Index1 is Ccode-48, + format_args_get_index1(FormatRest1, FormatRest2, Index1, Index2). +format_args_get_index(FormatRest, FormatRest, none). + +% have at least one digit already. This is separate from format_args_get_index to distinguish {} and {0} cases +format_args_get_index1([C|FormatRest1], FormatRest2, Index1, Index3) :- char_code(C, Ccode), Ccode >= 48, Ccode =< 57, !, % in the range ['0'..'9'] + Index2 is (Index1*10)+(Ccode-48), + format_args_get_index1(FormatRest1, FormatRest2, Index2, Index3). +format_args_get_index1(FormatRest, FormatRest, Index, Index). + +% Placeholder to deal with formatting {:} later +format_args_get_format(FormatRest, FormatRest, _). + +format_args_write(Arg,_) :- string(Arg), !, write(Arg). +format_args_write('#\\'(Arg),_) :- !, write(Arg). +format_args_write(Arg,_) :- write_src_woi(Arg). + +format_nth_args([], _, _). +format_nth_args(['{','{'|FormatRest], Iterator, Args) :- !, put('{'), format_nth_args(FormatRest, Iterator, Args). % escaped +format_nth_args(['}','}'|FormatRest], Iterator, Args) :- !, put('}'), format_nth_args(FormatRest, Iterator, Args). % escaped +format_nth_args(['{'|FormatRest1], Iterator1, Args) :- + format_args_get_index(FormatRest1, FormatRest2, Index), + format_args_get_format(FormatRest2, ['}'|FormatRest3], Format), + % check that the closing '}' is not escaped with another '}' + ((FormatRest3=[] ; ((FormatRest3=[C|_],C\='}')) )), + % The Rust behaviour of advancing the iterator if an index is not specified + (((Index == none)) + -> ((nth0(Iterator1,Args,Arg),Iterator2 is Iterator1+1)) + ; ((nth0(Index,Args,Arg), Iterator2 is Iterator1))), + format_args_write(Arg,Format), + format_nth_args(FormatRest3, Iterator2, Args). +format_nth_args([C|FormatRest], Iterator, Args) :- put(C), format_nth_args(FormatRest, Iterator, Args). + +eval_20(Eq,RetType,Depth,Self,['format-args',Format,Args],Result):- + eval_args(Eq,RetType,Depth,Self,Format,EFormat), + eval_args(Eq,RetType,Depth,Self,Args,EArgs), + is_list(EArgs),string_chars(EFormat, FormatChars), !, + user_io(with_output_to_str( Result, format_nth_args(FormatChars, 0, EArgs))). +eval_20(Eq,RetType,Depth,Self,['format-args',_Fmt,Args],_Result) :- + eval_args(Eq,RetType,Depth,Self,Args,EArgs), + \+ is_list(EArgs),!,throw_metta_return(['Error',Args,'BadType']). + +eval_20(Eq,RetType,_Depth,_Self,['flip'],Bool):- + ignore(RetType='Bool'), !, as_tf(random(0,2,0),Bool), + check_returnval(Eq,RetType,Bool). + +eval_20( Eq, RetType, Depth, Self, [ 'parse' , L ] , Exp ):- !, + eval_args( Eq, RetType, Depth, Self, L, Str ), + once(parse_sexpr_metta1( Str, Exp )). + +eval_20( _Eq, _RetType, _Depth, _Self, [ 'repr' , L ] , Sxx ):- !, + %eval_args( Eq, RetType, Depth, Self, L, Lis2 ), + with_output_to_str( Sxx , write_src_woi( L ) ). + +eval_20( Eq, RetType, Depth, Self, [ 'output-to-string' , L ] , Sxx ):- !, + with_output_to_str( Sxx , eval_args( Eq, RetType, Depth, Self, L, _ )). + +% ================================================================= +% ================================================================= +% ================================================================= +% IMPORT/BIND +% ================================================================= +% ================================================================= +% ================================================================= +nb_bind(Name,Value):- nb_current(Name,Was),same_term(Value,Was),!. +nb_bind(Name,Value):- call_in_shared_space(nb_setval(Name,Value)),!. +eval_20(_Eq,_RetType,_Dpth,_Slf,['extend-py!',Module],Res):- !, 'extend-py!'(Module,Res). +eval_20(Eq,RetType,Depth,Self,['register-module!',Dir],RetVal):- !, + eval_20(Eq,'Directory',Depth,Self,Dir,Folder), + register_module(Self,Folder),!, + %Folder = RetVal, + ignore(make_nop(RetType,Self,RetVal)). +eval_20(Eq,RetType,Depth,Self,['register-module!',Name,Dir],RetVal):- !, + eval_20(Eq,'Symbol',Depth,Self,Name,ModuleName), + eval_20(Eq,'Directory',Depth,Self,Dir,Folder), + register_module(Self,ModuleName,Folder),!, + %Folder = RetVal, + ignore(make_nop(RetType,Self,RetVal)). + + +eval_20(Eq,RetType,Depth,Self,['include!',Other,File],RetVal):- !, + into_space(Depth,Self,Other,Space), include_metta(Space,File),!, + make_nr(Eq,RetType,RetVal). +% from metta in Rust +eval_20(Eq,RetType,_Depth,Self,['include',File],RetVal):- !, + include_metta(Self,File),!, + make_nr(Eq,RetType,RetVal). +eval_20(Eq,RetType,Depth,Self,['load-ascii',Other,File],RetVal):- !, + into_space(Depth,Self,Other,Space), include_metta(Space,File),!, + make_nr(Eq,RetType,RetVal). +eval_20(Eq,RetType,Depth,Self,['import!',Other,File],RetVal):- !, + into_space(Depth,Self,Other,Space), import_metta(Space,File),!, + make_nr(Eq,RetType,RetVal). +eval_20(Eq,RetType,Depth,Self,['load-file!',Other,File],RetVal):- !, + into_space(Depth,Self,Other,Space), load_metta(Space,File),!, + make_nr(Eq,RetType,RetVal). + +make_nr(_Eq,_RetType,RetVal):- as_nop(RetVal). + + + + +eval_20(Eq,RetType,_Depth,_Slf,['bind!',Other,['new-space']],RetVal):- atom(Other),!, + assert(was_asserted_space(Other)), + make_nop(RetType,[],RetVal), check_returnval(Eq,RetType,RetVal). +eval_20(Eq,RetType,Depth,Self,['bind!',Other,Expr],RetVal):- !, + must_det_ll((into_name(Self,Other,Name),!,eval_args(Eq,RetType,Depth,Self,Expr,Value), + nb_bind(Name,Value), make_nop(RetType,Value,RetVal))), + check_returnval(Eq,RetType,RetVal). +eval_20(Eq,RetType,Depth,Self,['pragma!',Other,Expr],RetVal):- !, + must_det_ll((into_name(Self,Other,Name),nd_ignore((eval_args(Eq,RetType,Depth,Self,Expr,Value), + set_option_value_interp(Name,Value))), make_nop(RetType,Value,RetVal), + check_returnval(Eq,RetType,RetVal))). +eval_20(Eq,RetType,_Dpth,Self,['transfer!',File],RetVal):- !, must_det_ll((include_metta(Self,File), + make_nop(RetType,Self,RetVal),check_returnval(Eq,RetType,RetVal))). + + +eval_20(Eq,RetType,Depth,Self,['save-space!',Other,File],RetVal):- !, + (( into_space(Depth,Self,Other,Space), 'save-space!'(Space,File),!,make_nop(RetType,RetVal))), + check_returnval(Eq,RetType,RetVal). + + +nd_ignore(Goal):- call(Goal)*->true;true. + + +% ================================================================= +% ================================================================= +% ================================================================= +% AND/OR +% ================================================================= +% ================================================================= +% ================================================================= + +is_True(T):- atomic(T), T\=='False', T\==0. + +is_and(S):- \+ atom(S),!,fail. +%is_and(','). +is_and(S):- is_and(S,_). + +is_and(S,_):- \+ atom(S),!,fail. +%is_and('and','True'). +is_and('and2','True'). +%is_and('#COMMA','True'). %is_and(',','True'). % is_and('And'). + +is_comma(C):- var(C),!,fail. +is_comma(','). +is_comma('{}'). + +bool_xor(A,B) :- (A == 'True'; B == 'True'), \+ (A == B). + +eval_20(Eq,RetType,Depth,Self,['and',X,Y],TF):- !, + as_tf(( (eval_args_true(Eq,RetType,Depth,Self,X), + eval_args_true(Eq,RetType,Depth,Self,Y))), TF). + + +eval_20(Eq,RetType,Depth,Self,['or',X,Y],TF):- !, + as_tf(( (eval_args_true(Eq,RetType,Depth,Self,X); + eval_args_true(Eq,RetType,Depth,Self,Y))), TF). + +eval_20(Eq,RetType,Depth,Self,['xor',X,Y],TF):- !, + as_tf( (eval_args_true(Eq,RetType,Depth,Self,X)), XTF), % evaluate X + as_tf( (eval_args_true(Eq,RetType,Depth,Self,Y)), YTF), % evaluate Y + as_tf( (bool_xor(XTF,YTF)) , TF). + + +eval_20(Eq,RetType,Depth,Self,['not',X],TF):- !, + as_tf(( \+ eval_args_true(Eq,RetType,Depth,Self,X)), TF). + + +% ================================================ +% === function / return of minimal metta +eval_20(Eq,RetType,Depth,Self,['function',X],Res):- !, gensym(return_,RetF), + RetUnit=..[RetF,Res], + catch(locally(nb_setval('$rettag',RetF), + eval_args(Eq,RetType,Depth,Self,X, Res)), + return(RetUnitR),RetUnitR=RetUnit). +eval_20(Eq,RetType,Depth,Self,['return',X],_):- !, + nb_current('$rettag',RetF),RetUnit=..[RetF,Val], + eval_args(Eq,RetType,Depth,Self,X, Val), throw(return(RetUnit)). +% ================================================ + +% ================================================ +% === catch / throw of mettalog +eval_20(Eq,RetType,Depth,Self,['catch',X,EX,Handler],Res):- !, + catch(eval_args(Eq,RetType,Depth,Self,X, Res), + EX,eval_args(Eq,RetType,Depth,Self,Handler, Res)). +eval_20(Eq,_TRetType,Depth,Self,['throw',X],_):- !, + eval_args(Eq,_RetType,Depth,Self,X, Val), throw(Val). +% ================================================ + +eval_20(Eq,RetType,Depth,Self,['number-of',X],N):- !, + findall_eval(Eq,RetType,Depth,Self,X,ResL), + length(ResL,N), ignore(RetType='Number'). + +eval_20(Eq,RetType,Depth,Self,['number-of',X,N],TF):- !, + findall_eval(Eq,RetType,Depth,Self,X,ResL), + length(ResL,N), true_type(Eq,RetType,TF). + +eval_20(Eq,RetType,Depth,Self,['findall!',Template,X],ResL):- !, + findall(Template,eval_args(Eq,RetType,Depth,Self,X,_),ResL). + + + +eval_20(Eq,RetType,Depth,Self,['limit!',N,E],R):- !, eval_20(Eq,RetType,Depth,Self,['limit',N,E],R). +eval_20(Eq,RetType,Depth,Self,['limit',NE,E],R):- !, + eval_args('=','Number',Depth,Self,NE,N), + limit(N,eval_ne(Eq,RetType,Depth,Self,E,R)). + +eval_20(Eq,RetType,Depth,Self,['offset!',N,E],R):- !, eval_20(Eq,RetType,Depth,Self,['offset',N,E],R). +eval_20(Eq,RetType,Depth,Self,['offset',NE,E],R):- !, + eval_args('=','Number',Depth,Self,NE,N), + offset(N,eval_ne(Eq,RetType,Depth,Self,E,R)). + +eval_20(Eq,RetType,Depth,Self,['max-time!',N,E],R):- !, eval_20(Eq,RetType,Depth,Self,['max-time',N,E],R). +eval_20(Eq,RetType,Depth,Self,['max-time',NE,E],R):- !, + eval_args('=','Number',Depth,Self,NE,N), + cwtl(N,eval_ne(Eq,RetType,Depth,Self,E,R)). + + +eval_20(Eq,RetType,Depth,Self,['call-cleanup!',NE,E],R):- !, + call_cleanup(eval_args(Eq,RetType,Depth,Self,NE,R), + eval_args(Eq,_U_,Depth,Self,E,_)). + +eval_20(Eq,RetType,Depth,Self,['setup-call-cleanup!',S,NE,E],R):- !, + setup_call_cleanup( + eval_args(Eq,_,Depth,Self,S,_), + eval_args(Eq,RetType,Depth,Self,NE,R), + eval_args(Eq,_,Depth,Self,E,_)). + +eval_20(Eq,RetType,Depth,Self,['with-output-to!',S,NE],R):- !, + eval_args(Eq,'Sink',Depth,Self,S,OUT), + with_output_to_stream(OUT, + eval_args(Eq,RetType,Depth,Self,NE,R)). + + + +% ================================================================= +% ================================================================= +% ================================================================= +% DATA FUNCTOR +% ================================================================= +% ================================================================= +% ================================================================= +eval20_failked(Eq,RetType,Depth,Self,[V|VI],[V|VO]):- + nonvar(V),is_metta_data_functor(V),is_list(VI),!, + maplist(eval_args(Eq,RetType,Depth,Self),VI,VO). + + +% ================================================================= +% ================================================================= +% ================================================================= +% EVAL FAILED +% ================================================================= +% ================================================================= +% ================================================================= + +eval_failed(Depth,Self,T,TT):- + eval_failed('=',_RetType,Depth,Self,T,TT). + +finish_eval(Depth,Self,T,TT):- + finish_eval('=',_RetType,Depth,Self,T,TT). + +eval_failed(Eq,RetType,Depth,Self,T,TT):- + finish_eval(Eq,RetType,Depth,Self,T,TT). + +%finish_eval(Eq,RetType,_,_,X,X):-!. + +finish_eval(_Eq,_RetType,_Dpth,_Slf,T,TT):- var(T),!,TT=T. +finish_eval(_Eq,_RetType,_Dpth,_Slf,[],[]):-!. +finish_eval(Eq,RetType,Depth,Self,[F|LESS],Res):- + once(eval_selfless(Eq,RetType,Depth,Self,[F|LESS],Res)),fake_notrace([F|LESS]\==Res),!. +%finish_eval(Eq,RetType,Depth,Self,[V|Nil],[O]):- Nil==[], once(eval_args(Eq,RetType,Depth,Self,V,O)),V\=@=O,!. +finish_eval(Eq,RetType,Depth,Self,[H|T],[HH|TT]):- !, + eval_args(Depth,Self,H,HH), + finish_eval(Eq,RetType,Depth,Self,T,TT). +finish_eval(_Eq,_RetType,Depth,Self,T,TT):- eval_args(Depth,Self,T,TT). + + %eval_args(Eq,RetType,Depth,Self,X,Y):- eval_20(Eq,RetType,Depth,Self,X,Y)*->true;Y=[]. + +%eval_20(Eq,RetType,Depth,_,_,_):- Depth<1,!,fail. +%eval_20(Eq,RetType,Depth,_,X,Y):- Depth<3, !, ground(X), (Y=X). +%eval_20(Eq,RetType,_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. + +% Kills zero arity functions eval_20(Eq,RetType,Depth,Self,[X|Nil],[Y]):- Nil ==[],!,eval_args(Eq,RetType,Depth,Self,X,Y). + + + +% ================================================================= +% ================================================================= +% ================================================================= +% METTLOG PREDEFS +% ================================================================= +% ================================================================= +% ================================================================= + + +eval_20(Eq,RetType,Depth,Self,['maplist!',Pred,ArgL1],ResL):- !, + maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ResL). +eval_20(Eq,RetType,Depth,Self,['maplist!',Pred,ArgL1,ArgL2],ResL):- !, + maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ArgL2,ResL). +eval_20(Eq,RetType,Depth,Self,['maplist!',Pred,ArgL1,ArgL2,ArgL3],ResL):- !, + maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ArgL2,ArgL3,ResL). + + eval_pred(Eq,RetType,Depth,Self,Pred,Arg1,Res):- + eval_args(Eq,RetType,Depth,Self,[Pred,Arg1],Res). + eval_pred(Eq,RetType,Depth,Self,Pred,Arg1,Arg2,Res):- + eval_args(Eq,RetType,Depth,Self,[Pred,Arg1,Arg2],Res). + eval_pred(Eq,RetType,Depth,Self,Pred,Arg1,Arg2,Arg3,Res):- + eval_args(Eq,RetType,Depth,Self,[Pred,Arg1,Arg2,Arg3],Res). + +eval_20(Eq,RetType,Depth,Self,['concurrent-maplist!',Pred,ArgL1],ResL):- !, + metta_concurrent_maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ResL). +eval_20(Eq,RetType,Depth,Self,['concurrent-maplist!',Pred,ArgL1,ArgL2],ResL):- !, + concurrent_maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ArgL2,ResL). +eval_20(Eq,RetType,Depth,Self,['concurrent-maplist!',Pred,ArgL1,ArgL2,ArgL3],ResL):- !, + concurrent_maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ArgL2,ArgL3,ResL). +eval_20(Eq,RetType,Depth,Self,['concurrent-forall!',Gen,Test|Options],NoResult):- !, + maplist(s2p,Options,POptions), + call(thread:concurrent_forall( + user:eval_ne(Eq,RetType,Depth,Self,Gen,_), + user:forall(eval_args(Eq,RetType,Depth,Self,Test,_),true), + POptions)), + make_nop(RetType,[],NoResult). + +eval_20(Eq,RetType,Depth,Self,['hyperpose',ArgL],Res):- !, metta_hyperpose(Eq,RetType,Depth,Self,ArgL,Res). + + +% ================================================================= +% ================================================================= +% ================================================================= +% METTLOG COMPILER PREDEFS +% ================================================================= +% ================================================================= +% ================================================================= + + +eval_20(_Eq,_RetType,_Dpth,_Slf,['predicate-arity',F],A):- !, + eval_for('Symbol',F,FF), + predicate_arity(FF,A). +eval_20(_Eq,_RetType,_Dpth,_Slf,['function-arity',F],A):- !, + eval_for('Symbol',F,FF), + function_arity(FF,A). + + + +eval_20(_Eq,_RetType,_Depth,_Self,['compile-space!'],Res):- !, + as_nop('compile-space!'(_), Res). + +eval_20(_Eq,_RetType,_Depth,_Self,['compile-space!',Space],Res):- !, + as_nop('compile-space!'(Space), Res). + +'compile-space!'(X,TF):- + as_tf('compile-space!'(X), TF). + +'compile-space!'(KB):- + load_ontology, + %((ignore(pfcRemove(do_compile_space(X))), + % pfcWatch, + pfcAdd_Now(do_compile_space(KB)), + forall(function_arity(KB,F,_Len),'compile!'(F)), + % pfcNoWatch, + true,!. + + +eval_20(_Eq,_RetType,_Depth,_Self,['compile!'],Res):- !, + as_nop('compile!'(_), Res). + +eval_20(_Eq,_RetType,_Depth,_Self,['compile!',Space],Res):- !, + as_nop('compile!'(Space), Res). + +'compile!'(X,TF):- + as_tf('compile!'(X), TF). + +'compile!'(X):- X=='S',!. +'compile!'(X):- + load_ontology, + current_self(KB), + %((ignore(pfcRemove(do_compile(KB,X,_))), + % pfcWatch, + pfcAdd_Now(do_compile(KB,X,_)), + if_t( \+ current_predicate(X/_), + forall(metta_defn(KB,[X | Args] ,BodyFn), + compile_metta_defn(KB,X,Len,Args,BodyFn,_Clause))), + if_t( \+ current_predicate(X/_), + (ignore(nortrace),forall(metta_defn(KB,[X | Args] ,BodyFn), + (trace,compile_metta_defn(KB,X,Len,Args,BodyFn,_ClauseU))))), + % pfcNoWatch, + true,!, + notrace(catch((wdmsg(?-listing(X)),listing(X)),E, + (!,write_src(E),fail))),!. + + +empty('Empty'). +','(A,B,(AA,BB)):- eval_args(A,AA),eval_args(B,BB). +':'(A,B,[':',A,B]). +'<'(A,B,TFO):- as_tf(A'(A,B,TFO):- as_tf(A Len,!, + append(AdjustedM1,[Res],Adjusted), + Call =.. [Pred|Adjusted], + %indentq2(2,call_pl_rv(Call)), + catch_warn(efbug(show_call,rtrace_on_error(Call))). + +eval_201(_Eq,_RetType,_Depth,_Self,Pred,Adjusted,_Arity,_Len,Res):- + Call =.. [Pred|Adjusted], + %indentq2(2,call_pl_tf(Call)), + catch_warn(efbug(show_call,eval_call(rtrace_on_error(Call),Res))). + + + +% ================================================================= +% ================================================================= +% ================================================================= +% METTLOG EXTRA PREDEFS +% ================================================================= +% ================================================================= +% ================================================================= + +%eval_20(Eq,RetType,_Dpth,_Slf,['trace!',A],A):- !, format('~N'),fbug(A),format('~N'). + +eval_20(Eq,RetType,_Dpth,_Slf,List,YY):- is_list(List),maplist(self_eval,List),List=[H|_], \+ atom(H), !,Y=List,do_expander(Eq,RetType,Y,YY). + +eval_20(Eq,_ListOfRetType,Depth,Self,['TupleConcat',A,B],OO):- fail, !, + eval_args(Eq,RetType,Depth,Self,A,AA), + eval_args(Eq,RetType,Depth,Self,B,BB), + append(AA,BB,OO). +eval_20(Eq,OuterRetType,Depth,Self,['range',A,B],OO):- fail, (is_list(A);is_list(B)), + ((eval_args(Eq,RetType,Depth,Self,A,AA), + eval_args(Eq,RetType,Depth,Self,B,BB))), + ((AA+BB)\=@=(A+B)), + eval_20(Eq,OuterRetType,Depth,Self,['range',AA,BB],OO),!. + + +/* + fromNumber(Var1,Var2):- var(Var1),var(Var2),!, + freeze(Var1,fromNumber(Var1,Var2)), + freeze(Var2,fromNumber(Var1,Var2)). +fromNumber(0,'Z'):-!. +fromNumber(N,['S',Nat]):- integer(N), M is N -1,!,fromNumber(M,Nat). + +eval_20(Eq,RetType,Depth,Self,['fromNumber',NE],RetVal):- !, + eval_args('=','Number',Depth,Self,NE,N), + fromNumber(N,RetVal), check_returnval(Eq,RetType,RetVal). +*/ + +%% lazy_union(:P2, +E1_Call1, +E2_Call2, -E) is nondet. +% - Performs a union operation using lazy evaluation +% Arguments: +% - P2: Any arity 2 predicate +% - E1^Call1: The first goal (Call1) generating elements (E1) +% - E2^Call2: The second goal (Call2) generating elements (E2) +% - E: The resulting element that is part of the union of the two sets +lazy_union(P2, E1^Call1, E2^Call2, E) :- + % Step 1: Use lazy_findall/3 to declare that all elements satisfying Call1 are supposedly in List1 + lazy_findall(E1, Call1, List1), + % Step 2: Use lazy_findall/3 to declare that all elements satisfying Call2 are supposedly in List2 + lazy_findall(E2, Call2, List2), + % Step 3: Perform the union logic + ( % Case 1: If E is a member of List1, include it in the result + member(E, List1) + % Case 2: Otherwise, check if E is a member of List2 + % Additionally, ensure that E does not already exist in List1 + ; (member(E, List2), \+ (member(E1, List1), call(P2, E1, E))) + ). + + +variant_by_type(X,Y):- var(X),!,X==Y. +variant_by_type(X,Y):- X=@=Y. + +eval_20(Eq,RetType,Depth,Self,['unique',Eval],RetVal):- !, + term_variables(Eval+RetVal,Vars), + no_repeats_var(YY), + eval_20(Eq,RetType,Depth,Self,Eval,RetVal),YY=Vars. + +eval_20(Eq,RetType,Depth,Self,['pred-unique',P2,Eval],RetVal):- !, + no_repeats_var(P2,YY), + eval_20(Eq,RetType,Depth,Self,Eval,RetVal),YY=RetVal. + + +eval_20(Eq,RetType,Depth,Self,['subtraction',Eval1,Eval2],RetVal):- !, + lazy_subtraction(variant_by_type,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), + RetVal). + +eval_20(Eq,RetType,Depth,Self,['pred-subtraction',P2,Eval1,Eval2],RetVal):- !, + lazy_subtraction(P2,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), + RetVal). + +eval_20(Eq,RetType,Depth,Self,['union',Eval1,Eval2],RetVal):- !, + lazy_union(variant_by_type,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), + RetVal). + +eval_20(Eq,RetType,Depth,Self,['pred-union',P2,Eval1,Eval2],RetVal):- !, + lazy_union(P2,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), + RetVal). + +%eval_20(Eq,RetType,_Dpth,_Slf,['py-list',Atom_list],CDR_Y):- +% !, Atom=[_|CDR],!,do_expander(Eq,RetType,Atom_list, CDR_Y ). + +eval_20(Eq,RetType,Depth,Self,['intersection',Eval1,Eval2],RetVal):- !, + lazy_intersection(variant_by_type,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), + RetVal). + +eval_20(Eq,RetType,Depth,Self,['pred-intersection',P2,Eval1,Eval2],RetVal):- !, + lazy_intersection(P2,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), + RetVal). + +%% lazy_intersection(:P2, +E1_Call1, +E2_Call2, -E) is nondet. +% - Performs a intersection operation using lazy evaluation. +% - It intersects elements generated by Call2 from those generated by Call1. +% Arguments: +% - P2: Any arity 2 predicate +% - E1^Call1: The first goal (Call1) generating elements (E1). +% - E2^Call2: The second goal (Call2) generating elements (E2). +% - E: The resulting element after subtracting elements of the second set from the first set. +lazy_intersection(P2, E1^Call1, E2^Call2, E1) :- + % Step 1: Evaluate Call1 to generate E1 + call(Call1), + % Step 2: Use lazy_findall/3 to declare that all elements satisfying Call2 are supposedly in List2 + lazy_findall(E2, Call2, List2), + % Step 3: Perform the intersection logic + % Only return E1 if it is not a member of List2 + member(E2, List2), call(P2,E1,E2). + + +%% lazy_subtraction(:P2, +E1_Call1, +E2_Call2, -E) is nondet. +% - Performs a subtraction operation using lazy evaluation. +% - It subtracts elements generated by Call2 from those generated by Call1. +% Arguments: +% - P2: Any arity 2 predicate +% - E1^Call1: The first goal (Call1) generating elements (E1). +% - E2^Call2: The second goal (Call2) generating elements (E2). +% - E: The resulting element after subtracting elements of the second set from the first set. +lazy_subtraction(P2,E1^Call1, E2^Call2, E1) :- + % Step 1: Evaluate Call1 to generate E1 + call(Call1), + % Step 2: Use lazy_findall/3 to declare that all elements satisfying Call2 are supposedly in List2 + lazy_findall(E2, Call2, List2), + % Step 3: Perform the subtraction logic + % Only return E1 if it is not a member of List2 + \+ (member(E2, List2), call(P2, E1, E2)). + + +eval_20(Eq,RetType,Depth,Self,PredDecl,Res):- + Do_more_defs = do_more_defs(true), + clause(eval_21(Eq,RetType,Depth,Self,PredDecl,Res),Body), + Do_more_defs == do_more_defs(true), + call_ndet(Body,DET), + nb_setarg(1,Do_more_defs,false), + (DET==true -> ! ; true). + +eval_21(_Eq,_RetType,_Depth,_Self,['fb-member',Res,List],TF):-!, as_tf(fb_member(Res,List),TF). +eval_21(_Eq,_RetType,_Depth,_Self,['fb-member',List],Res):-!, fb_member(Res,List). + + +eval_21(Eq,RetType,Depth,Self,['CollapseCardinality',List],Len):-!, + findall_eval(Eq,RetType,Depth,Self,List,Res), + length(Res,Len). +/* +eval_21(_Eq,_RetType,_Depth,_Self,['TupleCount', [N]],N):- number(N),!. + + +*/ +eval_21(Eq,_RetType,Depth,Self,['Tuple-Count',List],Len):- fail,!, + (\+ is_list(List)->findall_eval(Eq,_,Depth,Self,List,Res);Res=List),!, + length(Res,Len). +eval_21(_Eq,_RetType,_Depth,_Self,['tuple-count',List],Len):-!, + length(List,Len). + + +%eval_20(Eq,RetType,Depth,Self,['colapse'|List], Flat):- !, maplist(eval_args(Eq,RetType,Depth,Self),List,Res),flatten(Res,Flat). + +eval_20(_Eq,_OuterRetType,_Depth,_Self,[P,_,B],_):-P=='/',B==0,!,fail. + + +eval_20(Eq,RetType,Depth,Self,['CountElement',L],Res):- !, eval_args(Eq,RetType,Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1),check_returnval(Eq,RetType,Res). +eval_20(Eq,RetType,_Dpth,_Slf,['make_list',List],MettaList):- !, into_metta_cons(List,MettaList),check_returnval(Eq,RetType,MettaList). + +simple_math(Var):- attvar(Var),!,fail. +simple_math([F|XY]):- !, atom(F),atom_length(F,1), is_list(XY),maplist(simple_math,XY),!. +simple_math(X):- number(X),!. + + +eval_20(_Eq,_RetType,_Depth,_Self,['call-string!',Str],NoResult):- !,'call-string!'(Str,NoResult). + +'call-string!'(Str,NoResult):- + read_term_from_atom(Str,Term,[variables(Vars)]),!, + call(Term),NoResult=Vars. + + +/* +into_values(List,Many):- List==[],!,Many=[]. +into_values([X|List],Many):- List==[],is_list(X),!,Many=X. +into_values(Many,Many). +eval_40(Eq,RetType,_Dpth,_Slf,Name,Value):- atom(Name), nb_current(Name,Value),!. +*/ +% Macro Functions +%eval_20(Eq,RetType,Depth,_,_,_):- Depth<1,!,fail. +/* +eval_40(_Eq,_RetType,Depth,_,X,Y):- Depth<3, !, fail, ground(X), (Y=X). +eval_40(Eq,RetType,Depth,Self,[F|PredDecl],Res):- + fail, + Depth>1, + fake_notrace((sub_sterm1(SSub,PredDecl), ground(SSub),SSub=[_|Sub], is_list(Sub), maplist(atomic,SSub))), + eval_args(Eq,RetType,Depth,Self,SSub,Repl), + fake_notrace((SSub\=Repl, subst(PredDecl,SSub,Repl,Temp))), + eval_args(Eq,RetType,Depth,Self,[F|Temp],Res). +*/ +% ================================================================= +% ================================================================= +% ================================================================= +% PLUS/MINUS +% ================================================================= +% ================================================================= +% ================================================================= +eval_40(Eq,RetType,Depth,Self,LESS,Res):- + ((((eval_selfless(Eq,RetType,Depth,Self,LESS,Res),fake_notrace(LESS\==Res))))),!. + +eval_40(Eq,RetType,Depth,Self,['+',N1,N2],N):- number(N1), + eval_args(Eq,RetType,Depth,Self,N2,N2Res), fake_notrace(catch_err(N is N1+N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). +eval_40(Eq,RetType,Depth,Self,['-',N1,N2],N):- number(N1), + eval_args(Eq,RetType,Depth,Self,N2,N2Res), fake_notrace(catch_err(N is N1-N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). +eval_40(Eq,RetType,Depth,Self,['*',N1,N2],N):- number(N1), + eval_args(Eq,RetType,Depth,Self,N2,N2Res), fake_notrace(catch_err(N is N1*N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). + +eval_20(_Eq,_RetType,_Depth,_Self,['rust',Bang,PredDecl],Res):- Bang == '!', !, + rust_metta_run(exec(PredDecl),Res), nop(write_src(res(Res))). +eval_20(_Eq,_RetType,_Depth,_Self,['rust',PredDecl],Res):- !, + rust_metta_run((PredDecl),Res), nop(write_src(res(Res))). +eval_20(_Eq,_RetType,_Depth,_Self,['rust!',PredDecl],Res):- !, + rust_metta_run(exec(PredDecl),Res), nop(write_src(res(Res))). + +eval_70(_Eq,_RetType,_Depth,_Self,['py-atom',Arg],Res):- !, + must_det_ll((py_atom(Arg,Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-atom',Arg,Type],Res):- !, + must_det_ll((py_atom_type(Arg,Type,Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-dot',Arg1,Arg2],Res):- !, + must_det_ll((py_dot([Arg1,Arg2],Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-list',Arg],Res):- !, + must_det_ll((py_list(Arg,Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-dict',Arg],Res):- !, + must_det_ll((py_dict(Arg,Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-tuple',Arg],Res):- !, + must_det_ll((py_tuple(Arg,Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-eval',Arg],Res):- !, + must_det_ll((py_eval(Arg,Res))). + +eval_40(Eq,RetType,Depth,Self,['length',L],Res):- !, eval_args(Depth,Self,L,LL), + (is_list(LL)->length(LL,Res);Res=1), + check_returnval(Eq,RetType,Res). + + +eval_20(Eq,RetType,Depth,Self,[P,X|More],YY):- is_list(X),X=[_,_,_],simple_math(X), + eval_selfless_2(X,XX),X\=@=XX,!, eval_20(Eq,RetType,Depth,Self,[P,XX|More],YY). + +/* +eval_40(Eq,RetType,Depth,Self,[P,A,X|More],YY):- is_list(X),X=[_,_,_],simple_math(X), + eval_selfless_2(X,XX),X\=@=XX,!, + eval_40(Eq,RetType,Depth,Self,[P,A,XX|More],YY). +*/ +%eval_40(Eq,RetType,_Dpth,_Slf,['==',X,Y],Res):- !, subst_args(Eq,RetType,_Dpth,_Slf,['==',X,Y],Res). + +eval_40(Eq,RetType,_Dpth,_Slf,[EQ,X,Y],Res):- EQ=='==', !, + suggest_type(RetType,'Bool'), + eq_unify(Eq,_SharedType, X, Y, Res). + +eval_20(_Eq,RetType,_Dpth,_Slf,[EQ,X,Y],TF):- EQ=='===', !, + suggest_type(RetType,'Bool'), + as_tf(X==Y,TF). + +eval_20(_Eq,RetType,_Dpth,_Slf,[EQ,X,Y],TF):- EQ=='====', !, + suggest_type(RetType,'Bool'), + as_tf(same_terms(X,Y),TF). + + +eq_unify(_Eq,_SharedType, X, Y, TF):- as_tf(X=:=Y,TF),!. +eq_unify(_Eq,_SharedType, X, Y, TF):- as_tf( '#='(X,Y),TF),!. +eq_unify( Eq, SharedType, X, Y, TF):- as_tf(eval_until_unify(Eq,SharedType, X, Y), TF). + + +suggest_type(_RetType,_Bool). + +naive_eval_args:- + false. + +eval_41(Eq,RetType,Depth,Self,[AE|More],Res):- naive_eval_args,!, + maplist(must_eval_args(Eq,_,Depth,Self),More,Adjusted), + eval_70(Eq,RetType,Depth,Self,[AE|Adjusted],Res), + check_returnval(Eq,RetType,Res). + +eval_41(Eq,RetType,Depth,Self,AEMore,ResOut):- \+ naive_eval_args,!, + eval_adjust_args(Eq,RetType,ResIn,ResOut,Depth,Self,AEMore,AEAdjusted), + if_trace((e;args), + (AEMore\==AEAdjusted -> color_g_mesg('#773733',indentq2(Depth,AEMore -> AEAdjusted)) + ; nop(indentq2(Depth,same(AEMore))))), + eval_70(Eq,RetType,Depth,Self,AEAdjusted,ResIn), + check_returnval(Eq,RetType,ResOut). + + +eval_20(Eq,RetType,Depth,Self,X,Y):- + (eval_40(Eq,RetType,Depth,Self,X,M)*-> M=Y ; + % finish_eval(Depth,Self,M,Y); + (eval_failed(Depth,Self,X,Y)*->true;X=Y)). +eval_40(Eq,RetType,Depth,Self,AEMore,ResOut):- eval_41(Eq,RetType,Depth,Self,AEMore,ResOut). +eval_70(Eq,RetType,Depth,Self,PredDecl,Res):- + if_or_else(eval_maybe_python(Eq,RetType,Depth,Self,PredDecl,Res), + if_or_else(eval_maybe_host_predicate(Eq,RetType,Depth,Self,PredDecl,Res), + if_or_else(eval_maybe_host_function(Eq,RetType,Depth,Self,PredDecl,Res), + if_or_else(eval_maybe_defn(Eq,RetType,Depth,Self,PredDecl,Res), + eval_maybe_subst(Eq,RetType,Depth,Self,PredDecl,Res))))). + + +eval_all_args:- true_flag. +fail_missed_defn:- true_flag. +fail_on_constructor:- true_flag. + + +eval_adjust_args(Eq,RetType,ResIn,ResOut,Depth,Self,X,Y):- + if_or_else((eval_all_args,eval_adjust_args2(Eq,RetType,ResIn,ResOut,Depth,Self,X,Y)), + eval_adjust_args1(Eq,RetType,ResIn,ResOut,Depth,Self,X,Y)). + +eval_adjust_args1(Eq,RetType,ResIn,ResOut,Depth,Self,[AE|More],[AE|Adjusted]):- + adjust_args_90(Eq,RetType,ResIn,ResOut,Depth,Self,AE,More,Adjusted). +adjust_args_90(Eq,RetType,ResIn,ResOut,Depth,Self,AE,More,Adjusted):- \+ is_debugging(eval_args),!, + adjust_args_9(Eq,RetType,ResIn,ResOut,Depth,Self,AE,More,Adjusted). +adjust_args_90(Eq,RetType,ResIn,ResOut,Depth,Self,AE,More,Adjusted):- + if_or_else(adjust_args_9(Eq,RetType,ResIn,ResOut,Depth,Self,AE,More,Adjusted), + if_or_else(with_debug(eval_args,adjust_args_9(Eq,RetType,ResIn,ResOut,Depth,Self,AE,More,Adjusted), + if_or_else(More=Adjusted, + if_or_else((trace, throw(adjust_args_9(Eq,RetType,ResIn,ResOut,Depth,Self,AE,More,Adjusted)))))))). + + + +eval_adjust_args2(Eq,_RetType,ResIn,ResOut,Depth,Self,[AE|More],[AE|Adjusted]):- + maplist(must_eval_args(Eq,_,Depth,Self),More,Adjusted), + ResIn = ResOut. + + +must_eval_args(Eq,RetType,Depth,Self,More,Adjusted):- \+ is_debugging(eval_args),!, eval_args(Eq,RetType,Depth,Self,More,Adjusted). +must_eval_args(Eq,RetType,Depth,Self,More,Adjusted):- + (eval_args(Eq,RetType,Depth,Self,More,Adjusted)*->true; + (with_debug(eval_args,eval_args(Eq,RetType,Depth,Self,More,Adjusted))*-> true; + ( + %nl,writeq(eval_args(Eq,RetType,Depth,Self,More,Adjusted)),writeln('.'), + (More=Adjusted -> true ; + (trace, throw(must_eval_args(Eq,RetType,Depth,Self,More,Adjusted))))))). + + +eval_maybe_subst(Eq,RetType,Depth,Self,PredDecl,Res):- !, + subst_args_here(Eq,RetType,Depth,Self,PredDecl,Res). + + +eval_maybe_subst(_Eq,_RetType,_Dpth,_Slf,[H|PredDecl],Res):- fail, + is_rust_operation([H|PredDecl]),!, % run + must_det_ll((rust_metta_run(exec([H|PredDecl]),Res), + nop(write_src(res(Res))))). + +eval_maybe_subst(_Eq,_RetType,_Dpth,_Slf,Res,Res):- nb_current(eval_maybe_subst,false),!. +eval_maybe_subst(Eq,RetType,Depth,Self,PredDecl,Res):- + locally(nb_setval(eval_maybe_subst,false), + finish_eval(Eq,RetType,Depth,Self,PredDecl,Res)). + +:- nb_setval(eval_maybe_subst,true). +/* +eval_maybe_subst(Eq,RetType,Depth,Self,PredDecl,Res):- + if_or_else((finish_eval(Eq,RetType,Depth,Self,PredDecl,Res), + PredDec\=@=Res), + subst_args(Eq,RetType,Depth,Self,PredDecl,Res)). +*/ + +/* +eval_70(Eq,RetType,Depth,Self,PredDecl,Res):- + Do_more_defs = do_more_defs(true), + clause(eval_80(Eq,RetType,Depth,Self,PredDecl,Res),Body), + Do_more_defs == do_more_defs(true), + call_ndet(Body,DET), + nb_setarg(1,Do_more_defs,false), + (DET==true -> ! ; true). +*/ +% ================================================================= +% ================================================================= +% ================================================================= +% inherited by system +% ================================================================= +% ================================================================= +% ================================================================= +is_system_pred(S):- atom(S),atom_concat(_,'!',S). +is_system_pred(S):- atom(S),atom_concat(_,'-fn',S). +is_system_pred(S):- atom(S),atom_concat(_,'-p',S). +%is_system_pred(S):- atom(S),upcase_symbol(S,U),downcase_symbol(S,U). + +% eval_80/6: Evaluates a Python function call within MeTTa. +% Parameters: +% - Eq: denotes get-type, match, or interpret call. +% - RetType: Expected return type of the MeTTa function. +% - Depth: Recursion depth or complexity control. +% - Self: Context or environment for the evaluation. +% - [MyFun|More]: List with MeTTa function and additional arguments. +% - RetVal: Variable to store the result of the Python function call. +eval_maybe_python(Eq, RetType, _Depth, Self, [MyFun|More], RetVal) :- + % MyFun as a registered Python function with its module and function name. + metta_atom(Self, ['registered-python-function', PyModule, PyFun, MyFun]),!, + % Tries to fetch the type definition for MyFun, ignoring failures. + %adjust_args_9(Eq,RetType,MVal,RetVal,Depth,Self,MyFun,More,Adjusted), + More=Adjusted,MVal=RetVal, + % Constructs a compound term for the Python function call with adjusted arguments. + compound_name_arguments(Call, PyFun, Adjusted), + % Optionally prints a debug tree of the Python call if tracing is enabled. + if_trace(host;python, print_tree(py_call(PyModule:Call, RetVal))), + % Executes the Python function call and captures the result in MVal which propagates to RetVal. + py_call(PyModule:Call, MVal), + % Checks the return value against the expected type and criteria. + check_returnval(Eq, RetType, RetVal). + + +%eval_80(_Eq,_RetType,_Dpth,_Slf,LESS,Res):- fake_notrace((once((eval_selfless(LESS,Res),fake_notrace(LESS\==Res))))),!. + +% predicate inherited by system +eval_maybe_host_predicate(Eq,RetType,_Depth,_Self,[AE|More],TF):- allow_host_functions, + once((is_system_pred(AE), + length(More,Len), + is_syspred(AE,Len,Pred))), + \+ (atom(AE), atom_concat(_,'-fn',AE)), + %current_predicate(Pred/Len), + %fake_notrace( \+ is_user_defined_goal(Self,[AE|More])),!, + %adjust_args(Depth,Self,AE,More,Adjusted), + maplist(as_prolog, More , Adjusted), + if_trace(host;prolog,print_tree(apply(Pred,Adjusted))), + catch_warn(efbug(show_call,eval_call(apply(Pred,Adjusted),TF))), + check_returnval(Eq,RetType,TF). + +show_ndet(G):- call(G). +%show_ndet(G):- call_ndet(G,DET),(DET==true -> ! ; fbug(show_ndet(G))). + +:- if( \+ current_predicate( adjust_args / 2 )). + + :- discontiguous eval_80/6. + +is_user_defined_goal(Self,Head):- + is_user_defined_head(Self,Head). + +:- endif. + +adjust_args_mp(_Eq,_RetType,Res,Res,_Depth,_Self,_Pred,_Len,_AE,Args,Adjusted):- Args==[],!,Adjusted=Args. +adjust_args_mp(Eq,RetType,Res,NewRes,Depth,Self,Pred,Len,AE,Args,Adjusted):- + + functor(P,Pred,Len), + predicate_property(P,meta_predicate(Needs)), + account_needs(1,Needs,Args,More),!, + adjust_args(Eq,RetType,Res,NewRes,Depth,Self,AE,More,Adjusted). +adjust_args_mp(Eq,RetType,Res,NewRes,Depth,Self,_Pred,_Len,AE,Args,Adjusted):- + adjust_args(Eq,RetType,Res,NewRes,Depth,Self,AE,Args,Adjusted). + +acct(0,A,call(eval_args(A,_))). +acct(':',A,call(eval_args(A,_))). +acct(_,A,A). +account_needs(_,_,[],[]). +account_needs(N,Needs,[A|Args],[M|More]):- arg(N,Needs,What),!, + acct(What,A,M),plus(1,N,NP1), + account_needs(NP1,Needs,Args,More). + +:- nodebug(metta(call)). +allow_host_functions. + +s2ps(S,P):- S=='Nil',!,P=[]. +s2ps(S,P):- \+ is_list(S),!,P=S. +s2ps([F|S],P):- atom(F),maplist(s2ps,S,SS),join_s2ps(F,SS,P),!. +s2ps(S,S):-!. +join_s2ps('Cons',[H,T],[H|T]):-!. +join_s2ps(F,Args,P):-atom(F),P=..[F|Args]. + +eval_call(S,TF):- + s2ps(S,P), !, + fbug(eval_call(P,'$VAR'('TF'))),as_tf(P,TF). + +eval_call_fn(S,R):- + s2ps(S,P), !, + fbug(eval_call_fn(P,'$VAR'('R'))),as_tf(call(P,R),TF),TF\=='False'. + +% function inherited from system +eval_maybe_host_function(Eq,RetType,_Depth,_Self,[AE|More],Res):- allow_host_functions, + is_system_pred(AE), + length([AE|More],Len), + is_syspred(AE,Len,Pred), + \+ (symbol(AE), symbol_concat(_,'-p',AE)), % thus maybe -fn or ! + %fake_notrace( \+ is_user_defined_goal(Self,[AE|More])),!, + %adjust_args(Depth,Self,AE,More,Adjusted),!, + %Len1 is Len+1, + %current_predicate(Pred/Len1), + maplist(as_prolog,More,Adjusted), + append(Adjusted,[Res],Args),!, + if_trace(host;prolog,print_tree(apply(Pred,Args))), + efbug(show_call,catch_warn(apply(Pred,Args))), + check_returnval(Eq,RetType,Res). + +% user defined function +%eval_20(Eq,RetType,Depth,Self,[H|PredDecl],Res):- + % fake_notrace(is_user_defined_head(Self,H)),!, + % eval_defn(Eq,RetType,Depth,Self,[H|PredDecl],Res). + +/*eval_maybe_defn(Eq,RetType,Depth,Self,PredDecl,Res):- + eval_defn(Eq,RetType,Depth,Self,PredDecl,Res). + +eval_maybe_subst(Eq,RetType,Depth,Self,PredDecl,Res):- + subst_args_h(Eq,RetType,Depth,Self,PredDecl,Res). +*/ + + + +:- if( \+ current_predicate( check_returnval / 3 )). +check_returnval(_,_RetType,_TF). +:- endif. + +:- if( \+ current_predicate( adjust_args / 5 )). +adjust_args(_Depth,_Self,_V,VI,VI). +:- endif. + + +last_element(T,E):- \+ compound(T),!,E=T. +last_element(T,E):- is_list(T),last(T,L),last_element(L,E),!. +last_element(T,E):- compound_name_arguments(T,_,List),last_element(List,E),!. + + + + +catch_warn(G):- (catch_err(G,E,(fbug(catch_warn(G)-->E),fail))). +catch_nowarn(G):- (catch_err(G,error(_,_),fail)). + + +% less Macro-ey Functions + +%Metta +as_nop([]). +%mettalog +%as_nop('Empty'). + +as_nop(G,NoResult):- G\=[_|_], rtrace_on_failure(G),!, + as_nop(NoResult). +as_tf(G,TF):- G\=[_|_], catch_nowarn((call(G)*->TF='True';TF='False')). +as_tf_tracabe(G,TF):- G\=[_|_], ((call(G)*->TF='True';TF='False')). +%eval_selfless_1(['==',X,Y],TF):- as_tf(X=:=Y,TF),!. +%eval_selfless_1(['==',X,Y],TF):- as_tf(X=@=Y,TF),!. + +is_assignment(V):- \+ atom(V),!, fail. +is_assignment('is'). is_assignment('is!'). +%is_assignment('='). +%is_assignment('=='). +%is_assignment('=:='). is_assignment(':='). + +eval_selfless(_Eq,_RetType,_Depth,_Self,E,R):- eval_selfless_0(E,R). +eval_selfless(E,R):- eval_selfless_0(E,R). + +eval_selfless_0([F|_],_):- var(F),!,fail. +eval_selfless_0([F,X,XY],TF):- is_assignment(F), fake_notrace(args_to_mathlib([X,XY],Lib)),!,eval_selfless3(Lib,['=',X,XY],TF). +eval_selfless_0([F|XY],TF):- eval_selfless_1([F|XY],TF),!. +eval_selfless_0(E,R):- eval_selfless_2(E,R). + +allow_clp:- false_flag. + +eval_selfless_1([F|XY],TF):- allow_clp, \+ ground(XY),!,fake_notrace(args_to_mathlib(XY,Lib)),!,eval_selfless3(Lib,[F|XY],TF). +eval_selfless_1(['>',X,Y],TF):-!,as_tf(X>Y,TF). +eval_selfless_1(['<',X,Y],TF):-!,as_tf(X',X,Y],TF):-!,as_tf(X>=Y,TF). +eval_selfless_1(['<=',X,Y],TF):-!,as_tf(X=',X,Y],TF):-!,as_tf(X#>Y,TF). +%compare_selfless0(clpfd,['<',X,Y],TF):-!,as_tf(X#',X,Y],TF):-!,as_tf(X#>=Y,TF). +compare_selfless0(clpfd,['<=',X,Y],TF):-!,as_tf(X#=',X,Y],TF):-!,as_tf(Lib:{X>Y},TF). +compare_selfless0(Lib,['<',X,Y],TF):-!,as_tf(Lib:{X',X,Y],TF):-!,as_tf(Lib:{X>=Y},TF). +compare_selfless0(Lib,['<=',X,Y],TF):-!,as_tf(Lib:{X=!;true). + + + +:- dynamic(is_metta_type_constructor/3). + +curried_arity(X,_,_):- var(X),!,fail. +curried_arity([F|T],F,A):-var(F),!,fail,len_or_unbound(T,A). +curried_arity([[F|T1]|T2],F,A):- nonvar(F),!,len_or_unbound(T1,A1), + (var(A1)->A=A1;(len_or_unbound(T2,A2),(var(A2)->A=A2;A is A1+A2))). +curried_arity([F|T],F,A):-len_or_unbound(T,A). + +%curried_arity(_,_,_). + + +len_or_unbound(T,A):- is_list(T),!,length(T,A). +len_or_unbound(T,A):- integer(A),!,length(T,A). +len_or_unbound(_,_). + + +:-if(true). +:- nodebug(metta('defn')). + +eval_maybe_defn(Eq,RetType,Depth,Self,X,Res):- + \+ \+ (curried_arity(X,F,A), + is_metta_type_constructor(Self,F,AA), + ( \+ AA\=A ),!, + if_trace(e,color_g_mesg('#772000', + indentq2(Depth,defs_none_cached((F/A/AA)=X))))),!, + \+ fail_on_constructor, + eval_constructor(Eq,RetType,Depth,Self,X,Res). +eval_maybe_defn(Eq,RetType,Depth,Self,X,Y):- can_be_ok(eval_maybe_defn,X),!, + trace_eval(eval_defn_choose_candidates(Eq,RetType),'defn',Depth,Self,X,Y). + +eval_constructor(Eq,RetType,Depth,Self,X,Res):- + eval_maybe_subst(Eq,RetType,Depth,Self,X,Res). + + +eval_defn_choose_candidates(Eq,RetType,Depth,Self,X,Y):- + findall((XX->B0),get_defn_expansions(Eq,RetType,Depth,Self,X,XX,B0),XXB0L),!, + eval_defn_bodies(Eq,RetType,Depth,Self,X,Y,XXB0L). +eval_defn_choose_candidates(Eq,RetType,Depth,Self,X,Y):- + eval_defn_bodies(Eq,RetType,Depth,Self,X,Y,[]),!. + +multiple_typesigs(TypesSet):- is_list(TypesSet), + length(TypesSet,Len),Len>1,maplist(is_list,TypesSet),!. + + +eval_defn_bodies(Eq,RetType,Depth,Self,X,Res,[]):- !, + \+ \+ ignore((curried_arity(X,F,A),assert(is_metta_type_constructor(Self,F,A)))),!, + if_trace(e,color_g_mesg('#773700',indentq2(Depth,defs_none(X)))),!, + \+ fail_on_constructor, + eval_constructor(Eq,RetType,Depth,Self,X,Res). + +eval_defn_bodies(Eq,RetType,Depth,Self,X,Y,XXB0L):- + if_trace(e,maplist(print_templates(Depth,' '),XXB0L)),!, + if_or_else((member(XX->B0,XXB0L), copy_term(XX->B0,USED), + eval_defn_success(Eq,RetType,Depth,Self,X,Y,XX,B0,USED)), + eval_defn_failure(Eq,RetType,Depth,Self,X,Y)). + + +eval_defn_success(Eq,RetType,Depth,Self,X,Y,XX,B0,USED):- + X=XX, Y=B0, X\=@=B0, + if_trace(e,color_g_mesg('#773700',indentq2(Depth,defs_used(USED)))), + light_eval(Eq,RetType,Depth,Self,B0,Y),!. +eval_defn_failure(_Eq,_RetType,Depth,_Self,X,Res):- + if_trace(e,color_g_mesg('#773701',indentq2(Depth,defs_failed(X)))), + !, \+ fail_missed_defn, X=Res. + + +:-else. +eval_maybe_defn(Eq,RetType,Depth,Self,X,Y):- can_be_ok(eval_maybe_defn,X),!, + trace_eval(eval_defn_choose_candidates(Eq,RetType),'defn',Depth,Self,X,Y). + +eval_defn_choose_candidates(Eq,RetType,Depth,Self,X,Y):- + findall((XX->B0),get_defn_expansions(Eq,RetType,Depth,Self,X,XX,B0),XXB0L), + XXB0L\=[],!, + Depth2 is Depth-1, + if_trace((defn;metta_defn), + maplist(print_templates(Depth,' '),XXB0L)),!, + member(XX->B0,XXB0L), X=XX, Y=B0, X\=@=B0, + %(X==B0 -> trace; eval_args(Eq,RetType,Depth,Self,B0,Y)). + light_eval(Depth2,Self,B0,Y). +eval_defn_choose_candidates(_Eq,_RetType,_Depth,_Self,_X,_Y):- \+ is_debugging(metta_defn),!,fail. +eval_defn_choose_candidates(_Eq,_RetType,_Depth,_Self,X,_Y):- + color_g_mesg('#773700',write(no_def(X))),!,fail. +:- endif. + +pl_clause_num(Head,Body,Ref,Index):- + clause(Head,Body,Ref), + nth_clause(Head,Index,Ref). + +same_len_copy(Args,NewArgs):- length(Args,N),length(NewArgs,N). + +get_defn_expansions(Eq,_RetType,_Depth,Self,[H|Args],[H|NewArgs],B0):- same_len_copy(Args,NewArgs), + metta_eq_def(Eq,Self,[H|NewArgs],B0). + +get_defn_expansions(Eq,RetType,Depth,Self,[[H|Start]|T1],[[H|NewStart]|NewT1],[Y|T1]):- is_list(Start), + same_len_copy(Start,NewStart), + X = [H|NewStart], + findall((XX->B0),get_defn_expansions(Eq,RetType,Depth,Self,X,XX,B0),XXB0L), + XXB0L\=[], if_trace((defn;metta_defn;eval_args),maplist(print_templates(Depth,'curry 1'),XXB0L)),!, + member(XX->B0,XXB0L), X=XX, Y=B0, X\=@=B0, + light_eval(Eq,RetType,Depth,Self,B0,Y), + same_len_copy(T1,NewT1). + +get_defn_expansions(Eq,RetType,Depth,Self,[[H|Start]|T1],RW,Y):- is_list(Start), append(Start,T1,Args), + get_defn_expansions(Eq,RetType,Depth,Self,[H|Args],RW,Y), + if_trace((defn;metta_defn;eval_args),indentq_d(Depth,'curry 2 ', [[[H|Start]|T1] ,'----->', RW])). + +print_templates(Depth,_T,guarded_defn(Types,XX,B0)):-!, + Depth2 is Depth+2, + if_t(is_list(Types),indentq_d(Depth,'guarded',['->'|Types])), + indentq_d(Depth2,'(=',XX), + indentq_d(Depth2,' ',ste('',B0,')')). +print_templates(Depth,_T,XX->B0):-!, + indentq_d(Depth,'(=',XX), + indentq_d(Depth,'',ste('',B0,')')). +print_templates(Depth,T,XXB0):- ignore(indentq_d(Depth,'<<>>'(T),template(XXB0))),!. + +light_eval(Depth,Self,X,B):- + light_eval(_Eq,_RetType,Depth,Self,X,B). +light_eval(_Eq,_RetType,_Depth,_Self,B,B). + +not_template_arg(TArg):- var(TArg), !, \+ attvar(TArg). +not_template_arg(TArg):- atomic(TArg),!. +%not_template_arg(TArg):- is_list(TArg),!,fail. + + +% ================================================================= +% ================================================================= +% ================================================================= +% AGREGATES +% ================================================================= +% ================================================================= +% ================================================================= + +cwdl(DL,Goal):- call_with_depth_limit(Goal,DL,R), (R==depth_limit_exceeded->(!,fail);true). + +cwtl(DL,Goal):- catch(call_with_time_limit(DL,Goal),time_limit_exceeded(_),fail). + + +%findall_eval(Eq,RetType,Depth,Self,X,L):- findall_eval(Eq,RetType,_RT,Depth,Self,X,L). +%findall_eval(Eq,RetType,Depth,Self,X,S):- findall(E,eval_ne(Eq,RetType,Depth,Self,X,E),S)*->true;S=[]. +findall_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- self_eval(X),!,L=[X]. +findall_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- typed_list(X,_Type,L),!. +findall_eval(Eq,RetType,Depth,Self,Funcall,L):- + findall_ne(E, + catch_metta_return(eval_args(Eq,RetType,Depth,Self,Funcall,E),E),L). + +%bagof_eval(Eq,RetType,Depth,Self,X,L):- bagof_eval(Eq,RetType,_RT,Depth,Self,X,L). +%bagof_eval(Eq,RetType,Depth,Self,X,S):- bagof(E,eval_ne(Eq,RetType,Depth,Self,X,E),S)*->true;S=[]. +bagof_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- self_eval(X),!,L=[X]. +bagof_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- typed_list(X,_Type,L),!. +bagof_eval(Eq,RetType,Depth,Self,Funcall,L):- + bagof_ne(E, + catch_metta_return(eval_args(Eq,RetType,Depth,Self,Funcall,E),E),L). + +setof_eval(Depth,Self,Funcall,L):- setof_eval('=',_RT,Depth,Self,Funcall,L). +setof_eval(Eq,RetType,Depth,Self,Funcall,S):- findall_eval(Eq,RetType,Depth,Self,Funcall,L), + sort(L,S). + +bagof_ne(E,Call,L):- + bagof(E,(rtrace_on_error(Call), is_returned(E)),L). + +findall_ne(E,Call,L):- + findall(E,(rtrace_on_error(Call), is_returned(E)),L). + +eval_ne(Eq,RetType,Depth,Self,Funcall,E):- + ((eval_args(Eq,RetType,Depth,Self,Funcall,E)) + *-> is_returned(E);(fail,E=Funcall)). + +is_returned(E):- notrace( \+ is_empty(E)). +is_empty(E):- notrace(( nonvar(E), sub_var('Empty',E))),!. + + +:- ensure_loaded(metta_subst). + +solve_quadratic(A, B, I, J, K) :- + %X in -1000..1000, % Define a domain for X + (X + A) * (X + B) #= I*X*X + J*X + K. % Define the quadratic equation + %label([X]). % Find solutions for X + + +as_type(B,_Type,B):- var(B),!. +as_type(B,_Type,B):- \+ compound(B),!. + +as_type([OP|B],Type,Res):- var(Type), + len_or_unbound(B,Len), + get_operator_typedef(_Self,OP,Len,_ParamTypes,RetType), + Type=RetType, + eval_for(RetType,[OP|B],Res). + +as_type(B,RetType,Res):- is_pro_eval_kind(RetType), + eval_for(RetType,B,Res). + +as_type(B,_Type,B). + +same_types(A,C,_Type,A1,C1):- + A1=A,C1=C,!. +same_types(A,C,Type,A1,C1):- + freeze(A,guess_type(A,Type)), + freeze(C,guess_type(C,Type)), + A1=A,C1=C. + +guess_type(A,Type):- + current_self(Self), + get_type(20,Self,A,Was), + can_assign(Was,Type). + +eval_for(RetType,X,Y):- + current_self(Self), + eval_args('=',RetType,20,Self,X,Y). + +%if_debugging(G):- ignore(call(G)). +if_debugging(_). +bcc:- trace, + bc_fn([:,Prf,[in_tad_with,[sequence_variant,rs15],[gene,d]]], + ['S',['S',['S',['S','Z']]]], + OUT), + write_src(prf=Prf), write_src(OUT). + + +bci:- trace, + bc_impl([:,Prf,[in_tad_with,[sequence_variant,rs15],[gene,d]]], + ['S',['S',['S',['S','Z']]]], + OUT), + write_src(prf=Prf), write_src(OUT). + + + +bcm:- % trace, + bc_impl([:,Prf,[member,_A,_B,_C]], + ['S',['S',['S','Z']]], + OUT), + write_src(prf=Prf), write_src(OUT). + + +bc_fn(A,B,C):- %trace, + same_types(A,C,_,A1,C1), + as_type(B,'Nat',B1), + bc_impl(A1,B1,C1). + +bc_impl([:, _prf, _ccln], _, [:, _prf, _ccln]) :- + if_debugging(println_impl(['bc-base', [:, _prf, _ccln]])), + metta_atom('&kb', [:, _prf, _ccln]), + if_debugging(println_impl(['bc-base-ground', [:, _prf, _ccln]])), + true. + +bc_impl([:, [_prfabs, _prfarg], _ccln], ['S', _k], [:, [_prfabs, _prfarg], _ccln]) :- + if_debugging(println_impl(['bc-rec', [:, [_prfabs, _prfarg], _ccln], ['S', _k]])), + bc_impl([:, _prfabs, ['->', _prms, _ccln]], _k, [:, _prfabs, [->, _prms, _ccln]]), + bc_impl([:, _prfarg, _prms], _k, [:, _prfarg, _prms]). + + + + + + + + + + + + + + + + +end_of_file. + + + + eval_20(Eq,RetType,Depth,Self,X,Y):- fail, + once(type_fit_childs(Eq,Depth,Self,RetType,X,XX)), + X\=@=XX, fbug(type_fit_childs(X,XX)),fail, + eval_evals(Eq,RetType,Depth,Self,XX,Y). + + + into_arg_code([],true):-!. + into_arg_code(H,TT):- \+ iz_conz(H), TT = H. + into_arg_code([H,T],TT):- H==true,!,into_arg_code(T,TT). + into_arg_code([T,H],TT):- H==true,!,into_arg_code(T,TT). + into_arg_code([H,T],','(HH,TT)):- !, into_arg_code(H,HH),into_arg_code(T,TT). + into_arg_code([H|T],TT):- H==true,!,into_arg_code(T,TT). + into_arg_code([H|T],','(HH,TT)):- !, into_arg_code(H,HH),into_arg_code(T,TT). + into_arg_code(TT,TT). + into_arg_code([H|T],next(H,TT)):- into_arg_code(T,TT). + + + % reduce args to match types even inside atoms + type_fit_childs(_Eq,_Depth,_Self,_RetType,true,X,Y):- is_ftVar(X),!,Y=X. + type_fit_childs(_Eq,_Depth,_Self,_RetType,true,X,Y):- symbolic(X),!,Y=X. + type_fit_childs(Eq,Depth,Self,RetType,CodeForArg,X,Y):- compound_non_cons(X),!, + into_list_args(X,XX),!,type_fit_childs(Eq,Depth,Self,RetType,CodeForArg,XX,Y). + type_fit_childs(_Eq,_Depth,_Self,_RetType,true,X,Y):- \+ is_list(X),iz_conz(X), trace, !,Y=X. + type_fit_childs(_Eq,_Depth,_Self,_RetType,true,X,Y):- self_eval(X),!,Y=X. + + type_fit_childs(_Eq,_Depth,_Self,_RetType,true,[H|Args],[H|Args]):- (H=='eval_args';H=='eval_args-for'),!. + + type_fit_childs(Eq,Depth,Self,RetType,CodeForArg,['let*',Lets,Body],RetVal):- !, + expand_let_star(Lets,Body,NewLet),!, + type_fit_childs(Eq,Depth,Self,RetType,CodeForArg,NewLet,RetVal). + + /* e,CodeForCond,['If',Cond,Then,Else], + pe_fit_childs(Eq,Depth,Self,RetType,CodeForCond,['If',Cond,Then,Else], + ['If',ConVal,(CodeForThen),CodeForElse]):- + type_fit_childs(Eq,Depth,Self,'Bool',CodeForCond,Cond,ConVal). + type_fit_childs(Eq,Depth,Self,RetType,CodeForThen,Then,ThenVal). + type_fit_childs(Eq,Depth,Self,RetType,CodeForElse,Else,ElseVal). + */ + + type_fit_childs(Eq,Depth,Self,RetType,FullCodeForArgs,[H|Args],Y):- H\==':', + ignore(get_operator_typedef1(Self,H,ParamTypes,RType)), + ignore(eager_for_type(RType,RetType)),!, + must_det_ll((maplist(type_fit_childs(Eq,Depth,Self),ParamTypes,CodeForArgs,Args,NewArgs), + into_arg_code(CodeForArgs,MCodeForArgs), + into_arg_code([MCodeForArgs,'eval_args'(XX,Y)],FullCodeForArgs), + + XX = [H|NewArgs], + Y = _)). + %eval_args(Eq,RetType,CodeForArg,Depth,Self,XX,Y). + + type_fit_childs(Eq,Depth,Self,RetType,FullCodeForArgs,[H|Args],Y):- + must_det_ll((ignore(get_operator_typedef1(Self,H,ParamTypes,RetType)), + maplist(type_fit_childs(Eq,Depth,Self),ParamTypes,CodeForArgs,Args,NewArgs), + into_arg_code(CodeForArgs,FullCodeForArgs), + Y = [H|NewArgs])). + type_fit_childs(_Eq,_Depth,_Self,_RetType,true,X,Y):-!,must_det_ll((X=Y)). + + eager_for_type(_RType,'Atom'):- !, fail. + eager_for_type(_RType,'Type'):- !, fail. + eager_for_type(RType,RetType):- RType==RetType,!. + eager_for_type(RType,'Expression'):- !, RType=='Expression'. + eager_for_type('Atom','Expression'):- !, fail. + eager_for_type('Symbol','Expression'):- !, fail. + eager_for_type(RType,Var):- var(Var),!,RType=Var. + eager_for_type(_RType,_):-!. + %eager_for_type(_RType,'Any'):- !. + %eager_for_type(_RType,'Number'). + %eager_for_type(_RType,'Nat'). + + + eval_evals(_Eq,_Depth,_Self,_RetType,X,Y):-self_eval(X),!,Y=X. + eval_evals(_Eq,_Depth,_Self,_RetType,X,Y):- \+ is_list(X),!,Y=X. + eval_evals(Eq,Depth,Self,RetType,[Eval,X],Y):- Eval == 'eval_args',!, + eval_evals(Eq,Depth,Self,RetType,X,XX), + eval_args(Eq,RetType,Depth,Self,XX,Y). + eval_evals(Eq,Depth,Self,RetType,[Eval,SomeType,X],Y):- Eval == 'eval_args-for',!, + eval_evals(Eq,Depth,Self,RetType,X,XX), + eval_args(Eq,SomeType,Depth,Self,XX,Y). + eval_evals(Eq,Depth,Self,RetType,[H|Args],Y):- + ignore(get_operator_typedef1(Self,H,ParamTypes,RetType)), + maplist(eval_evals(Eq,Depth,Self),ParamTypes,Args,NewArgs), + XX = [H|NewArgs],Y=XX. + eval_evals(_Eq,_Depth,_Self,_RetType,X,X):-!. + diff --git a/.Attic/canary_docme/metta_interp.pl b/.Attic/canary_docme/metta_interp.pl new file mode 100644 index 00000000000..aa087700ebc --- /dev/null +++ b/.Attic/canary_docme/metta_interp.pl @@ -0,0 +1,1814 @@ +/* + * 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. + */ + +:- encoding(utf8). +:- set_prolog_flag(encoding, utf8). +:- nb_setval(cmt_override,lse('; ',' !(" ',' ") ')). +:- set_prolog_flag(source_search_working_directory,true). +:- set_prolog_flag(backtrace,true). +:- set_prolog_flag(backtrace_depth,100). +:- set_prolog_flag(backtrace_goal_dept,100). +:- set_prolog_flag(backtrace_show_lines,true). +:- set_prolog_flag(write_attributes,portray). +:- set_prolog_flag(debug_on_interrupt,true). +:- set_prolog_flag(debug_on_error,true). +:- ensure_loaded(swi_support). +%:- set_prolog_flag(compile_meta_arguments,control). +:- (prolog_load_context(directory, Value);Value='.'), absolute_file_name('../packs/',Dir,[relative_to(Value)]), + atom_concat(Dir,'predicate_streams',PS), + atom_concat(Dir,'logicmoo_utils',LU), + attach_packs(Dir,[duplicate(replace),search(first)]), + pack_attach(PS,[duplicate(replace),search(first)]), + pack_attach(LU,[duplicate(replace),search(first)]). +% :- attach_packs. +%:- ensure_loaded(metta_interp). +is_win64:- current_prolog_flag(windows,_). +is_win64_ui:- is_win64,current_prolog_flag(hwnd,_). + +dont_change_streams:- true. + +:- dynamic(user:is_metta_src_dir/1). +:- prolog_load_context(directory,Dir), + retractall(user:is_metta_src_dir(_)), + asserta(user:is_metta_src_dir(Dir)). + +metta_root_dir(Dir):- is_metta_src_dir(Value), absolute_file_name('../../',Dir,[relative_to(Value)]). +metta_root_dir(Dir):- getenv('METTA_DIR',Dir),!. + +metta_library_dir(Dir):- metta_root_dir(Value), absolute_file_name('./library/',Dir,[relative_to(Value)]). + +metta_dir(Dir):- metta_library_dir(Value), absolute_file_name('./genome/',Dir,[relative_to(Value)]). +metta_dir(Dir):- is_metta_src_dir(Dir). +metta_dir(Dir):- metta_library_dir(Dir). +metta_dir(Dir):- metta_root_dir(Dir). +metta_dir(Dir):- is_metta_src_dir(Value), absolute_file_name('../flybase/',Dir,[relative_to(Value)]). + +:- dynamic user:file_search_path/2. +:- multifile user:file_search_path/2. +user:file_search_path(library,Dir):- metta_dir(Dir). +user:file_search_path(mettalog,Dir):- metta_dir(Dir). + + +:- is_win64 -> ensure_loaded(library(logicmoo_utils)) ; true. + +% :- initialization(attach_packs). +:- nodebug(metta(eval)). +:- nodebug(metta(exec)). +:- nodebug(metta(load)). +:- nodebug(metta(prolog)). + +:- dynamic(function_arity/2). +:- dynamic(predicate_arity/2). + + +:-multifile(user:metta_file/3). +:-dynamic(user:metta_file/3). + +:- multifile(reset_cache/0). + + :-multifile(metta_type/3). + :-dynamic(metta_type/3). + + :-multifile(metta_defn/3). + :-dynamic(metta_defn/3). + + +:-multifile(user:asserted_metta_pred/2). +:-dynamic(user:asserted_metta_pred/2). +:-multifile(user:loaded_into_kb/2). +:-dynamic(user:loaded_into_kb/2). +:- dynamic(user:is_metta_dir/1). + +once_writeq_ln(_):- \+ clause(pfcTraceExecution,true),!. +once_writeq_ln(P):- nb_current('$once_writeq_ln',W),W=@=P,!. +once_writeq_ln(P):- + \+ \+ (numbervars(P,444,_,[attvar(skip),singletons(true)]), + ansi_format([fg(cyan)],'~N~q.~n',[P])),nb_setval('$once_writeq_ln',P),!. +% TODO uncomment this next line but it is breaking the curried chainer +% pfcAdd_Now(P):- pfcAdd(P),!. +pfcAdd_Now(P):- current_predicate(pfcAdd/1),!, once_writeq_ln(pfcAdd(P)),pfcAdd(P). +pfcAdd_Now(P):- once_writeq_ln(asssert(P)),assert(P). +%:- endif. + +system:copy_term_g(I,O):- ground(I),!,I=O. +system:copy_term_g(I,O):- copy_term(I,O). + +:- ensure_loaded(metta_debug). + +is_metta_flag(What):- notrace(is_flag0(What)). + +true_flag. +false_flag:- fail. + +is_tRuE(TF):- TF=='True',!. +is_tRuE(TF):- TF=='true',!. +is_flag0(What):- nb_current(What,TF),TF\==[],!,is_tRuE(TF). +is_flag0(What):- current_prolog_flag(What,TF),TF\==[],!,is_tRuE(TF). +is_flag0(What):- + symbol_concat('--',What,FWhat),symbol_concat(FWhat,'=true',FWhatTrue), + symbol_concat('--no-',What,NoWhat),symbol_concat(FWhat,'=false',FWhatFalse), + is_flag0(What,[FWhat,FWhatTrue],[NoWhat,FWhatFalse]). + +is_flag0(What,_FWhatTrue,FWhatFalse):- + current_prolog_flag(os_argv,ArgV), + member(FWhat,FWhatFalse),member(FWhat,ArgV),!, + notrace(catch(set_prolog_flag(What,false),_,true)), + set_option_value(What,'False'),!,fail. +is_flag0(What,FWhatTrue,_FWhatFalse):- + current_prolog_flag(os_argv,ArgV), + member(FWhat,FWhatTrue),member(FWhat,ArgV),!, + notrace(catch(set_prolog_flag(What,true),_,true)), + set_option_value(What,'True'),!. +is_flag0(What,_FWhatTrue,_FWhatFalse):- + current_prolog_flag(os_argv,ArgV), + symbolic_list_concat(['--',What,'='],Starts), + member(FWhat,ArgV),symbol_concat(Starts,Rest,FWhat), + set_option_value_interp(What,Rest),!. + +is_compiling:- current_prolog_flag(os_argv,ArgV),member(E,ArgV), (E==qcompile_mettalog;E==qsave_program),!. +is_compiled:- current_prolog_flag(os_argv,ArgV), member('-x',ArgV),!. +is_compiled:- current_prolog_flag(os_argv,ArgV),\+ member('swipl',ArgV),!. + +is_converting:- is_metta_flag('convert'). + +is_compat:- is_metta_flag('compat'). + +is_mettalog:- is_win64,!. +is_mettalog:- is_metta_flag('log'). + +is_synthing_unit_tests:- notrace(is_synthing_unit_tests0). +is_synthing_unit_tests0:- is_testing. +%is_synthing_unit_tests0:- is_html. +% is_synthing_unit_tests0:- is_compatio,!,fail. + +is_testing:- is_metta_flag('test'). +is_html:- is_metta_flag('html'). + +:- ensure_loaded(metta_printer). +:- ensure_loaded(metta_loader). + + +:- nodebug(metta('trace-on-eval')). + +is_compatio:- notrace(is_compatio0). +is_compatio0:- is_win64,!,fail. +is_compatio0:- is_testing,!,fail. +is_compatio0:- is_flag0('compatio'). +is_compatio0:- is_mettalog,!,fail. +%is_compatio0:- is_html,!,fail. +is_compatio0:- !. + +keep_output:- !. +keep_output:- dont_change_streams,!. +keep_output:- is_win64,!. +keep_output:- is_mettalog,!. +keep_output:- is_testing,!. +keep_output:- is_compatio,!,fail. + + +:- volatile(original_user_output/1). +:- dynamic(original_user_output/1). +original_user_output(X):- stream_property(X,file_no(1)). +original_user_error(X):- stream_property(X,file_no(2)). +:- original_user_output(_)->true;current_output(Out),asserta(original_user_output(Out)). +unnullify_output:- current_output(MFS), original_user_output(OUT), MFS==OUT, !. +unnullify_output:- original_user_output(MFS), set_prolog_IO(user_input,MFS,user_error). + +null_output(MFS):- dont_change_streams,!, original_user_output(MFS),!. +null_output(MFS):- use_module(library(memfile)), + new_memory_file(MF),open_memory_file(MF,append,MFS). +:- volatile(null_user_output/1). +:- dynamic(null_user_output/1). +:- null_user_output(_)->true;(null_output(MFS), + asserta(null_user_output(MFS))). + + +nullify_output:- keep_output,!. +nullify_output:- dont_change_streams,!. +nullify_output:- nullify_output_really. +nullify_output_really:- current_output(MFS), null_user_output(OUT), MFS==OUT, !. +nullify_output_really:- null_user_output(MFS), set_prolog_IO(user_input,MFS,MFS). + +set_output_stream :- dont_change_streams,!. +set_output_stream :- \+ keep_output -> nullify_output; unnullify_output. +:- set_output_stream. +% :- nullify_output. + +switch_to_mettalog:- + unnullify_output, + set_option_value('compatio',false), + set_option_value('compat',false), + set_option_value('load',show), + set_option_value('load',verbose), + set_option_value('log',true), + %set_option_value('test',true), + set_output_stream. + +switch_to_mettarust:- + nullify_output, + set_option_value('compatio',true), + set_option_value('compat',true), + set_option_value('log',false), + set_option_value('test',false), + set_output_stream. + + + +show_os_argv:- is_compatio,!. +show_os_argv:- current_prolog_flag(os_argv,ArgV),write('; libswipl: '),writeln(ArgV). +is_pyswip:- current_prolog_flag(os_argv,ArgV),member( './',ArgV). +:- multifile(is_metta_data_functor/1). +:- dynamic(is_metta_data_functor/1). +:- multifile(is_nb_space/1). +:- dynamic(is_nb_space/1). +%:- '$set_source_module'('user'). +:- use_module(library(filesex)). +:- use_module(library(system)). +:- use_module(library(shell)). +%:- use_module(library(tabling)). + +:- nb_setval(self_space, '&self'). +current_self(Self):- ((nb_current(self_space,Self),Self\==[])->true;Self='&self'). +:- nb_setval(repl_mode, '+'). + +%:- set_stream(user_input,tty(true)). +%:- use_module(library(editline)). +:- set_prolog_flag(encoding,iso_latin_1). +:- set_prolog_flag(encoding,utf8). +%:- set_output(user_error). +%:- set_prolog_flag(encoding,octet). + + + +/* +Now PASSING NARS.TEC:\opt\logicmoo_workspace\packs_sys\logicmoo_opencog\MeTTa\hyperon-wam\src\pyswip\metta_interp.pl +C:\opt\logicmoo_workspace\packs_sys\logicmoo_opencog\MeTTa\hyperon-wam\src\pyswip1\metta_interp.pl +STS1.01) +Now PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.08) +Now PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.14) +Now PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.15) +Now PASSING TEST-SCRIPTS.C1-GROUNDED-BASIC.15) +Now PASSING TEST-SCRIPTS.E2-STATES.08) +PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.02) +PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.07) +PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.09) +PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.11) +PASSING TEST-SCRIPTS.C1-GROUNDED-BASIC.14) +PASSING TEST-SCRIPTS.E2-STATES.07) +----------------------------------------- +FAILING TEST-SCRIPTS.D5-AUTO-TYPES.01) +Now FAILING TEST-SCRIPTS.00-LANG-CASE.03) +Now FAILING TEST-SCRIPTS.B5-TYPES-PRELIM.19) +Now FAILING TEST-SCRIPTS.C1-GROUNDED-BASIC.20) + +*/ + + +%option_value_def('repl',auto). +option_value_def('prolog',false). +option_value_def('compat',auto). +option_value_def('compatio',true). +%option_value_def('compatio',false). +option_value_def('compile',false). +%option_value_def('compile',true). +%option_value_def('compile',full). +option_value_def('tabling',true). +option_value_def('optimize',true). +option_value_def(no_repeats,false). +%option_value_def('time',false). +option_value_def('test',false). +option_value_def('html',false). +option_value_def('python',true). +%option_value_def('halt',false). +option_value_def('doing_repl',false). +option_value_def('test-retval',false). +option_value_def('exeout','./Sav.gitlab.MeTTaLog'). + +option_value_def('synth_unit_tests',false). + +option_value_def('trace-length',500). +option_value_def('stack-max',500). +option_value_def('trace-on-overtime',4.0). +option_value_def('trace-on-overflow',false). +option_value_def('trace-on-error',true). +option_value_def('trace-on-exec',false). +option_value_def('trace-on-fail',false). +option_value_def('trace-on-pass',false). + + +option_value_def('exec',true). % vs skip + +option_value_def('trace-on-load',false). +option_value_def('load','silent'). + +option_value_def('trace-on-eval',false). +option_value_def('eval',silent). + +option_value_def('transpiler',silent). +option_value_def('result',show). + +option_value_def('maximum-result-count',inf). % infinate answers + +% MeTTaLog --log mode only +% if print the first 10 answers without stopping +option_value_def('initial-result-count',10). + + + + +fbugio(_,_):- is_compatio,!. +fbugio(TF,P):-!, ignore(( TF,!,fbug(P))). +fbugio(IO):-fbugio(true,IO). + +different_from(N,V):- \+ \+ option_value_def(N,V),!,fail. +different_from(N,V):- \+ \+ nb_current(N,V),!,fail. +different_from(_,_). + +set_option_value_interp(N,V):- symbol(N), symbolic_list_concat(List,',',N),List\=[_],!, + forall(member(E,List),set_option_value_interp(E,V)). +set_option_value_interp(N,V):- + %(different_from(N,V)->Note=true;Note=false), + Note = true, + fbugio(Note,set_option_value(N,V)),set_option_value(N,V), + ignore(forall(on_set_value(Note,N,V),true)). + +on_set_value(Note,N,'True'):- on_set_value(Note,N,true). +on_set_value(Note,N,'False'):- on_set_value(Note,N,false). +on_set_value(_Note,log,true):- switch_to_mettalog. +on_set_value(_Note,compatio,true):- switch_to_mettarust. +on_set_value(Note,N,V):- symbol(N), symbol_concat('trace-on-',F,N),fbugio(Note,set_debug(F,V)),set_debug(F,V). +on_set_value(Note,N,V):- symbol(N), is_debug_like(V,TF),fbugio(Note,set_debug(N,TF)),set_debug(N,TF). + +is_debug_like(trace, true). +is_debug_like(notrace, false). +is_debug_like(debug, true). +is_debug_like(nodebug, false). +is_debug_like(silent, false). +%is_debug_like(false, false). + +'is-symbol'(X):- symbol(X). +%:- (is_mettalog->switch_to_mettalog;switch_to_mettarust). + +set_is_unit_test(TF):- + forall(option_value_def(A,B),set_option_value_interp(A,B)), + set_option_value_interp('trace-on-pass',false), + set_option_value_interp('trace-on-fail',false), + set_option_value_interp('load',show), + set_option_value_interp('test',TF), + %set_option_value_interp('trace-on-load',TF), +/* if_t(TF,set_option_value_interp('exec',debug)), + if_t(TF,set_option_value_interp('eval',debug)), + set_option_value_interp('trace-on-exec',TF), + set_option_value_interp('trace-on-eval',TF),*/ + % if_t( \+ TF , set_prolog_flag(debug_on_interrupt,true)), + !. + +:- meta_predicate fake_notrace(0). +fake_notrace(G):- tracing,!,real_notrace(G). +fake_notrace(G):- !,once(G). +% `quietly/1` allows breaking in and inspection (real `no_trace/1` does not) +fake_notrace(G):- quietly(G),!. +:- meta_predicate real_notrace(0). +real_notrace(Goal) :- + setup_call_cleanup('$notrace'(Flags, SkipLevel), + once(Goal), + '$restore_trace'(Flags, SkipLevel)). + + +:- dynamic(is_answer_output_stream/2). +answer_output(Stream):- is_testing,original_user_output(Stream),!. +answer_output(Stream):- !,original_user_output(Stream),!. % yes, the cut is on purpose +answer_output(Stream):- is_answer_output_stream(_,Stream),!. +answer_output(Stream):- tmp_file('answers',File), + open(File,write,Stream,[encoding(utf8)]), + asserta(is_answer_output_stream(File,Stream)). + +write_answer_output:- + retract(is_answer_output_stream(File,Stream)),!, + ignore(catch_log(close(Stream))), + sformat(S,'cat ~w',[File]), + catch_log(ignore(shell(S))),nl. +write_answer_output. + + +null_io(G):- null_user_output(Out), !, with_output_to(Out,G). +user_io(G):- original_user_output(Out), !, with_output_to(Out,G). +user_err(G):- original_user_error(Out), !, with_output_to(Out,G). +with_output_to_s(Out,G):- current_output(COut), + redo_call_cleanup(set_prolog_IO(user_input, Out,user_error), G, + set_prolog_IO(user_input,COut,user_error)). + + in_answer_io(_):- nb_current(suspend_answers,true),!. + in_answer_io(G):- answer_output(Out), !, with_output_to(Out,G). + not_compatio(G):- if_t(once(is_mettalog;is_testing),user_err(G)). + +%if_compatio(G):- if_t(is_compatio,user_io(G)). +% if_compat_io(G):- if_compatio(G). +not_compat_io(G):- not_compatio(G). +non_compat_io(G):- not_compatio(G). + + +trace_on_fail:- option_value('trace-on-fail',true). +trace_on_overflow:- option_value('trace-on-overflow',true). +trace_on_pass:- option_value('trace-on-pass',true). +doing_repl:- option_value('doing_repl',true). +if_repl(Goal):- doing_repl->call(Goal);true. + +any_floats(S):- member(E,S),float(E),!. + +show_options_values:- + forall((nb_current(N,V), \+((symbol(N),symbol_concat('$',_,N)))),write_src_nl(['pragma!',N,V])). + +:- prolog_load_context(source,File), assert(interpreter_source_file(File)). + + +:- ensure_loaded(metta_utils). +%:- ensure_loaded(mettalog('metta_ontology.pfc.pl')). +:- ensure_loaded(metta_pfc_base). +:- ensure_loaded(metta_pfc_support). +:- ensure_loaded(metta_compiler). +:- ensure_loaded(metta_convert). +:- ensure_loaded(metta_types). +:- ensure_loaded(metta_space). +:- ensure_loaded(metta_eval). + +:- set_is_unit_test(false). + +extract_prolog_arity([Arrow|ParamTypes],PrologArity):- + Arrow == ('->'),!, + len_or_unbound(ParamTypes,PrologArity). + +add_prolog_code(_KB,AssertZIfNew):- + fbug(writeln(AssertZIfNew)), + assertz_if_new(AssertZIfNew). +gen_interp_stubs(KB,Symb,Def):- + ignore((is_list(Def), + must_det_ll(( + extract_prolog_arity(Def,PrologArity), + symbol(Symb), + symbol_concat('i_',Symb,Tramp), + length(PrologArgs,PrologArity), + append(MeTTaArgs,[RetVal],PrologArgs), + TrampH =.. [Tramp|PrologArgs], + add_prolog_code(KB, + (TrampH :- eval_H([Symb|MeTTaArgs], RetVal))))))). + +% 'int_fa_format-args'(FormatArgs, Result):- eval_H(['format-args'|FormatArgs], Result). +% 'ext_fa_format-args'([EFormat, EArgs], Result):- int_format-args'(EFormat, EArgs, Result) +/* + +'ext_format-args'(Shared,Format, Args, EResult):- + pred_in('format-args',Shared,3), + argn_in(1,Shared,Format,EFormat), + argn_in(2,Shared,Args,EArgs), + argn_in(3,Shared,EResult,Result), + int_format-args'(Shared,EFormat, EArgs, Result), + arg_out(1,Shared,EFormat,Format), + arg_out(2,Shared,EArgs,Args), + arg_out(3,Shared,Result,EResult). + + you are goign to create the clause based on the first 2 args + +?- gen_form_body('format-args',3, HrnClause). + +HrnClause = + ('ext_format-args'(Shared, Arg1, Arg2, EResult):- + pred_in('format-args',Shared,3), + argn_in(1,Shared,Arg1,EArg1), + argn_in(2,Shared,Arg2,EArg2), + argn_in(3,Shared,EResult,Result), + 'int_format-args'(Shared,EArg1, EArg2, Result), + arg_out(1,Shared,EArg1,Arg1), + arg_out(2,Shared,EArg2,Arg2), + arg_out(3,Shared,Result,EResult)). + +*/ + + + +% Helper to generate head of the clause +generate_head(Shared,Arity, FormName, Args, Head) :- + atom_concat('ext_', FormName, ExtFormName), + number_string(Arity, ArityStr), + atom_concat(ExtFormName, ArityStr, FinalFormName), % Append arity to form name for uniqueness + append([FinalFormName, Shared | Args], HeadArgs), + Head =.. HeadArgs. + +% Helper to generate body of the clause, swapping arguments +generate_body(Shared,Arity, FormName, Args, EArgs, Body) :- + atom_concat('int_', FormName, IntFormName), + number_string(Arity, ArityStr), + atom_concat(IntFormName, ArityStr, FinalIntFormName), % Append arity to internal form name for uniqueness + reverse(EArgs, ReversedEArgs), % Reverse the order of evaluated arguments for internal processing + % Generate predicates for input handling + findall(argn_in(Index, Shared, Arg, EArg), + (nth1(Index, Args, Arg), nth1(Index, EArgs, EArg)), ArgIns), + % Internal processing call with reversed arguments + append([Shared | ReversedEArgs], IntArgs), + InternalCall =.. [FinalIntFormName | IntArgs], + % Generate predicates for output handling + findall(arg_out(Index, Shared, EArg, Arg), + (nth1(Index, EArgs, EArg), nth1(Index, Args, Arg)), ArgOuts), + % Combine predicates + PredIn = pred_in(FormName, Shared, Arity), + append([PredIn | ArgIns], [InternalCall | ArgOuts], BodyParts), + list_to_conjunction(BodyParts, Body). + +% Main predicate to generate form body clause +gen_form_body(FormName, Arity, Clause) :- + length(Args,Arity), + length(EArgs,Arity), + generate_head(Shared,Arity, FormName, Args, Head), + generate_body(Shared,Arity, FormName, Args, EArgs, Body), + Clause = (Head :- Body). + + +% Helper to format atoms +format_atom(Format, N, Atom) :- format(atom(Atom), Format, [N]). + + +% 'int_format-args'(Shared,Format, Args, Result):- +% .... actual impl .... + + + +metta_argv(Args):- current_prolog_flag(metta_argv, Args),!. +metta_argv(Before):- current_prolog_flag(os_argv,OSArgv), append(_,['--args'|AArgs],OSArgv), + before_arfer_dash_dash(AArgs,Before,_),!,set_metta_argv(Before). +argv_metta(Nth,Value):- metta_argv(Args),nth1(Nth,Args,Value). + +set_metta_argv(Before):- maplist(read_argv,Before,Args),set_prolog_flag(metta_argv, Args),!. +read_argv(AArg,Arg):- \+ symbol(AArg),!,AArg=Arg. +read_argv(AArg,Arg):- atom_string(AArg,S),read_metta(S,Arg),!. + +metta_cmd_args(Rest):- current_prolog_flag(late_metta_opts,Rest),!. +metta_cmd_args(Rest):- current_prolog_flag(os_argv,P),append(_,['--'|Rest],P),!. +metta_cmd_args(Rest):- current_prolog_flag(argv,P),append(_,['--'|Rest],P),!. +metta_cmd_args(Rest):- current_prolog_flag(argv,Rest). + +:- dynamic(has_run_cmd_args/0). +:- volatile(has_run_cmd_args/0). +run_cmd_args_prescan:- has_run_cmd_args, !. +run_cmd_args_prescan:- assert(has_run_cmd_args), do_cmdline_load_metta(prescan). + +run_cmd_args:- + run_cmd_args_prescan, + set_prolog_flag(debug_on_interrupt,true), + do_cmdline_load_metta(execute). + + +metta_make_hook:- loonit_reset, option_value(not_a_reload,true),!. +metta_make_hook:- + metta_cmd_args(Rest), into_reload_options(Rest,Reload), do_cmdline_load_metta(reload,'&self',Reload). + +:- multifile(prolog:make_hook/2). +:- dynamic(prolog:make_hook/2). +prolog:make_hook(after, _Some):- nop( metta_make_hook). + +into_reload_options(Reload,Reload). + +is_cmd_option(Opt,M, TF):- symbol(M), + symbol_concat('-',Opt,Flag), + atom_contains(M,Flag),!, + get_flag_value(M,FV), + TF=FV. + +get_flag_value(M,V):- symbolic_list_concat([_,V],'=',M),!. +get_flag_value(M,false):- atom_contains(M,'-no'),!. +get_flag_value(_,true). + + +:- ignore((( + \+ prolog_load_context(reloading,true), + nop((forall(option_value_def(Opt,Default),set_option_value_interp(Opt,Default))))))). + +%process_option_value_def:- \+ option_value('python',false), skip(ensure_loaded(metta_python)). +process_option_value_def:- fail, \+ option_value('python',false), ensure_loaded(mettalog(metta_python)), + real_notrace((ensure_mettalog_py)). +process_option_value_def. + + +process_late_opts:- forall(process_option_value_def,true). +process_late_opts:- once(option_value('html',true)), set_is_unit_test(true). +%process_late_opts:- current_prolog_flag(os_argv,[_]),!,ignore(repl). +%process_late_opts:- halt(7). +process_late_opts. + + +do_cmdline_load_metta(Phase):- metta_cmd_args(Rest), !, do_cmdline_load_metta(Phase,'&self',Rest). + +%do_cmdline_load_metta(Phase,_Slf,Rest):- select('--prolog',Rest,RRest),!, +% set_option_value_interp('prolog',true), +% set_prolog_flag(late_metta_opts,RRest). +do_cmdline_load_metta(Phase,Self,Rest):- + set_prolog_flag(late_metta_opts,Rest), + forall(process_option_value_def,true), + cmdline_load_metta(Phase,Self,Rest),!, + forall(process_late_opts,true). + +:- if( \+ current_predicate(load_metta_file/2)). +load_metta_file(Self,Filemask):- symbol_concat(_,'.metta',Filemask),!, load_metta(Self,Filemask). +load_metta_file(_Slf,Filemask):- load_flybase(Filemask). +:- endif. + +catch_abort(From,Goal):- + catch_abort(From,Goal,Goal). +catch_abort(From,TermV,Goal):- + catch(Goal,'$aborted',fbug(aborted(From,TermV))). +% done + +before_arfer_dash_dash(Rest,Args,NewRest):- + append(Args,['--'|NewRest],Rest)->true;([]=NewRest,Args=Rest). + +cmdline_load_metta(_,_,Nil):- Nil==[],!. + +cmdline_load_metta(Phase,Self,['--'|Rest]):- !, + cmdline_load_metta(Phase,Self,Rest). + +cmdline_load_metta(Phase,Self,['--args'|Rest]):- !, + before_arfer_dash_dash(Rest,Before,NewRest),!, + set_metta_argv(Before), + cmdline_load_metta(Phase,Self,NewRest). + +cmdline_load_metta(Phase,Self,['--repl'|Rest]):- !, + if_phase(Phase,execute,repl), + cmdline_load_metta(Phase,Self,Rest). +cmdline_load_metta(Phase,Self,['--log'|Rest]):- !, + if_phase(Phase,execute,switch_to_mettalog), + cmdline_load_metta(Phase,Self,Rest). +cmdline_load_metta(Phase,Self,[Filemask|Rest]):- symbol(Filemask), \+ symbol_concat('-',_,Filemask), + if_phase(Phase,execute,cmdline_load_file(Self,Filemask)), + cmdline_load_metta(Phase,Self,Rest). + +cmdline_load_metta(Phase,Self,['-g',M|Rest]):- !, + if_phase(Phase,execute,catch_abort(['-g',M],((read_term_from_atom(M, Term, []),ignore(call(Term)))))), + cmdline_load_metta(Phase,Self,Rest). + +cmdline_load_metta(Phase,Self,['-G',Str|Rest]):- !, + current_self(Self), + if_phase(Phase,execute,catch_abort(['-G',Str],ignore(call_sexpr('!',Self,Str,_S,_Out)))), + cmdline_load_metta(Phase,Self,Rest). + +cmdline_load_metta(Phase,Self,[M|Rest]):- + m_opt(M,Opt), + is_cmd_option(Opt,M,TF), + fbug(is_cmd_option(Phase,Opt,M,TF)), + set_option_value_interp(Opt,TF), !, + %set_tty_color_term(true), + cmdline_load_metta(Phase,Self,Rest). + +cmdline_load_metta(Phase,Self,[M|Rest]):- + format('~N'), fbug(unused_cmdline_option(Phase,M)), !, + cmdline_load_metta(Phase,Self,Rest). + +install_ontology:- !. +%load_ontology:- option_value(compile,false),!. +load_ontology:- ensure_loaded(mettalog('metta_ontology.pfc.pl')). + +%cmdline_load_file(Self,Filemask):- is_converting,!, + +cmdline_load_file(Self,Filemask):- + Src=(user:load_metta_file(Self,Filemask)), + catch_abort(Src, + (must_det_ll(( + not_compatio((nl,write('; '),write_src(Src),nl)), + catch_red(Src),!,flush_output)))),!. + +if_phase(Current,Phase,Goal):- ignore((sub_var(Current,Phase),!, Goal)). + +set_tty_color_term(TF):- + current_output(X),set_stream(X,tty(TF)), + set_stream(current_output,tty(TF)), + set_prolog_flag(color_term ,TF). + +m_opt(M,Opt):- + m_opt0(M,Opt1), + m_opt1(Opt1,Opt). + +m_opt1(Opt1,Opt):- symbolic_list_concat([Opt|_],'=',Opt1). + +m_opt0(M,Opt):- symbol_concat('--no-',Opt,M),!. +m_opt0(M,Opt):- symbol_concat('--',Opt,M),!. +m_opt0(M,Opt):- symbol_concat('-',Opt,M),!. + +:- set_prolog_flag(occurs_check,true). + +start_html_of(_Filename):- \+ tee_file(_TEE_FILE),!. +start_html_of(_Filename):-!. +start_html_of(_Filename):- + must_det_ll(( + S = _, + %retractall(metta_eq_def(Eq,S,_,_)), + nop(retractall(metta_type(S,_,_))), + %retractall(get_metta_atom(Eq,S,_,_,_)), + loonit_reset, + tee_file(TEE_FILE), + sformat(S,'cat /dev/null > "~w"',[TEE_FILE]), + + writeln(doing(S)), + ignore(shell(S)))). + +save_html_of(_Filename):- \+ tee_file(_TEE_FILE),!. +save_html_of(_):- \+ has_loonit_results, \+ option_value('html',true). +save_html_of(_):- loonit_report, !, writeln('
Return to summaries
'). +save_html_of(_Filename):-!. +save_html_of(Filename):- + must_det_ll(( + file_name_extension(Base,_,Filename), + file_name_extension(Base,'metta.html',HtmlFilename), + loonit_reset, + tee_file(TEE_FILE), + writeln('
Return to summaries
'), + sformat(S,'ansi2html -u < "~w" > "~w" ',[TEE_FILE,HtmlFilename]), + writeln(doing(S)), + ignore(shell(S)))). + +tee_file(TEE_FILE):- getenv('TEE_FILE',TEE_FILE),!. +tee_file(TEE_FILE):- metta_dir(Dir),directory_file_path(Dir,'TEE.ansi',TEE_FILE),!. + + +clear_spaces:- clear_space(_). +clear_space(S):- + retractall(user:loaded_into_kb(S,_)), + %retractall(metta_eq_def(_,S,_,_)), + nop(retractall(metta_type(S,_,_))), + retractall(metta_atom_asserted(S,_)). + +dcall(G):- call(G). + +lsm:- lsm(_). +lsm(S):- + listing(metta_file(S,_,_)), + %listing(mdyn_type(S,_,_,_)), + forall(mdyn_type(S,_,_,Src),color_g_mesg('#22a5ff',write_f_src(Src))), + nl,nl,nl, + forall(mdyn_defn(S,_,_,Src),color_g_mesg('#00ffa5',write_f_src(Src))), + %listing(mdyn_defn(S,_,_,_)), + !. + +write_f_src(H,B):- H=@=B,!,write_f_src(H). +write_f_src(H,B):- write_f_src(['=',H,B]). + +hb_f(HB,ST):- sub_term(ST,HB),(symbol(ST),ST\==(=),ST\==(:)),!. +write_f_src(HB):- + hb_f(HB,ST), + option_else(current_def,CST,[]),!, + (CST == ST -> true ; (nl,nl,nl,set_option_value_interp(current_def,ST))), + write_src(HB). + + + +debug_only(G):- notrace(ignore(catch_warn(G))). +debug_only(_What,G):- ignore((fail,notrace(catch_warn(G)))). + + +'True':- true. +'False':- fail. + + +'mettalog::vspace-main':- repl. + +into_underscores(D,U):- symbol(D),!,symbolic_list_concat(L,'-',D),symbolic_list_concat(L,'_',U). +into_underscores(D,U):- descend_and_transform(into_underscores,D,U),!. + + +descend_and_transform(P2, Input, Transformed) :- + ( var(Input) + -> Transformed = Input % Keep variables as they are + ; compound(Input) + -> (compound_name_arguments(Input, Functor, Args), + maplist(descend_and_transform(P2), Args, TransformedArgs), + compound_name_arguments(Transformed, Functor, TransformedArgs)) + ; (symbol(Input),call(P2,Input,Transformed)) + -> true % Transform atoms using xform_atom/2 + ; Transformed = Input % Keep other non-compound terms as they are + ). + +/* +is_syspred(H,Len,Pred):- notrace(is_syspred0(H,Len,Pred)). +is_syspred0(H,_Ln,_Prd):- \+ symbol(H),!,fail. +is_syspred0(H,_Ln,_Prd):- upcase_atom(H,U),downcase_atom(H,U),!,fail. +is_syspred0(H,Len,Pred):- current_predicate(H/Len),!,Pred=H. +is_syspred0(H,Len,Pred):- symbol_concat(Mid,'!',H), H\==Mid, is_syspred0(Mid,Len,Pred),!. +is_syspred0(H,Len,Pred):- into_underscores(H,Mid), H\==Mid, is_syspred0(Mid,Len,Pred),!. + +fn_append(List,X,Call):- + fn_append1(List,X,ListX), + into_fp(ListX,Call). + + + + + +is_metta_data_functor(Eq,F):- + current_self(Self),is_metta_data_functor(Eq,Self,F). + +is_metta_data_functor(Eq,Other,H):- + metta_type(Other,H,_), + \+ get_metta_atom(Eq,Other,[H|_]), + \+ metta_eq_def(Eq,Other,[H|_],_). +*/ +is_function(F):- symbol(F). + +is_False(X):- X\=='True', (is_False1(X)-> true ; (eval_H(X,Y),is_False1(Y))). +is_False1(Y):- (Y==0;Y==[];Y=='False'). + +is_conz(Self):- compound(Self), Self=[_|_]. + +%dont_x(eval_H(Depth,Self,metta_if(A=1,symbol_concat(metta_,_,F). +needs_expanded(eval_H(Term,_),Expand):- !,sub_term(Expand,Term),compound(Expand),Expand\=@=Term, + compound(Expand), \+ is_conz(Expand), \+ is_ftVar(Expand), needs_expand(Expand). +needs_expanded([A|B],Expand):- sub_term(Expand,[A|B]), compound(Expand), \+ is_conz(Expand), \+ is_ftVar(Expand), needs_expand(Expand). + +fn_append1(eval_H(Term,X),X,eval_H(Term,X)):-!. +fn_append1(Term,X,eval_H(Term,X)). + + + + + +assert_preds(Self,Load,List):- is_list(List),!,maplist(assert_preds(Self,Load),List). +%assert_preds(_Self,_Load,_Preds):- \+ show_transpiler,!. +assert_preds(_Self,Load,Preds):- + expand_to_hb(Preds,H,_B),functor(H,F,A), + if_t((show_transpiler), + color_g_mesg_ok('#005288',( + ignore(( + % \+ predicate_property(H,defined), + %if_t(is_transpiling,catch_i(dynamic(F,A))), + if_t( \+ predicate_property(H,defined), + not_compatio(format(' :- ~q.~n',[dynamic(F/A)]))), + if_t(option_value('tabling','True'), + not_compatio(format(' :- ~q.~n',[table(F/A)]))))), + not_compatio(format('~N~n ~@',[portray_clause(Preds)]))))), + + + if_t(is_transpiling, + if_t( \+ predicate_property(H,static), + %add_assertion(Self,Preds) + true)), + nop(metta_anew1(Load,Preds)). + + +%load_hook(_Load,_Hooked):- !. +load_hook(Load,Hooked):- + ignore(( \+ ((forall(load_hook0(Load,Hooked),true))))),!. + + +%rtrace_on_error(G):- catch(G,_,fail). +rtrace_on_error(G):- + catch_err(G,E, + (%notrace, + write_src_uo(E=G), + %catch(rtrace(G),E,throw(E)), + catch(rtrace(G),E,throw(give_up(E=G))), + throw(E))). + +rtrace_on_failure(G):- tracing,!,call(G). +rtrace_on_failure(G):- + catch_err((G*->true;(write_src_uo(rtrace_on_failure(G)), + ignore(rtrace(G)), + write_src_uo(rtrace_on_failure(G)), + !,fail)),E, + (%notrace, + write_src_uo(E=G), + %catch(rtrace(G),E,throw(E)), + catch(rtrace(G),E,throw(give_up(E=G))), + throw(E))). + +rtrace_on_failure_and_break(G):- tracing,!,call(G). +rtrace_on_failure_and_break(G):- + catch_err((G*->true;(write_src(rtrace_on_failure(G)), + ignore(rtrace(G)), + write_src(rtrace_on_failure(G)), + !,break,fail)),E, + (%notrace, + write_src_uo(E=G), + %catch(rtrace(G),E,throw(E)), + catch(rtrace(G),E,throw(give_up(E=G))), + throw(E))). + +assertion_hb(metta_eq_def(Eq,Self,H,B),Self,Eq,H,B):-!. +assertion_hb(metta_defn(Self,H,B),Self,'=',H,B):-!. +assertion_hb(metta_atom_asserted(KB,HB),Self,Eq,H,B):- !, assertion_hb(metta_atom(KB,HB),Self,Eq,H,B). +assertion_hb(metta_atom(Self,[Eq,H,B]),Self,Eq,H,B):- assert_type_cl(Eq),!. +assertion_hb(metta_atom(Self,[Eq,H|B]),Self,Eq,H,B):- assert_type_cl(Eq),!. + +assert_type_cl(Eq):- \+ symbol(Eq),!,fail. +assert_type_cl('='). +assert_type_cl(':-'). + + +load_hook0(_,_):- \+ show_transpiler, \+ is_transpiling, !. +load_hook0(Load,Assertion):- fail, + assertion_hb(Assertion,Self,H,B), + functs_to_preds([=,H,B],Preds), + assert_preds(Self,Load,Preds). +load_hook0(Load,Assertion):- fail, + assertion_hb(Assertion,Self, Eq, H,B), + rtrace_on_error(compile_for_assert_eq(Eq, H, B, Preds)),!, + rtrace_on_error(assert_preds(Self,Load,Preds)). +load_hook0(_,_):- \+ current_prolog_flag(metta_interp,ready),!. +/* +load_hook0(Load,get_metta_atom(Eq,Self,H)):- B = 'True', + H\=[':'|_], functs_to_preds([=,H,B],Preds), + assert_preds(Self,Load,Preds). +*/ +is_transpiling:- use_metta_compiler. +use_metta_compiler:- notrace(option_value('compile','full')), !. +preview_compiler:- \+ option_value('compile',false), !. +%preview_compiler:- use_metta_compiler,!. +show_transpiler:- option_value('code',Something), Something\==silent,!. +show_transpiler:- preview_compiler. + +option_switch_pred(F):- + current_predicate(F/0),interpreter_source_file(File), + source_file(F, File), \+ \+ (member(Prefix,[is_,show_,trace_on_]), symbol_concat(Prefix,_,F)). + +do_show_option_switches :- + forall(option_switch_pred(F),(call(F)-> writeln(yes(F)); writeln(not(F)))). +do_show_options_values:- + forall((nb_current(N,V), \+((symbol(N),symbol_concat('$',_,N)))),write_src_nl(['pragma!',N,V])), + do_show_option_switches. + +:- dynamic(metta_atom_asserted/2). +:- multifile(metta_atom_asserted/2). +:- dynamic(metta_atom_asserted_deduced/2). +:- multifile(metta_atom_asserted_deduced/2). +metta_atom_asserted(X,Y):- + metta_atom_asserted_deduced(X,Y), + \+ clause(metta_atom_asserted(X,Y),true). + +%get_metta_atom(Eq,KB, [F|List]):- KB='&flybase',fb_pred(F, Len), length(List,Len),apply(F,List). + + +get_metta_atom_from(KB,Atom):- metta_atom(KB,Atom). + +get_metta_atom(Eq,Space, Atom):- metta_atom(Space, Atom), \+ (Atom =[EQ,_,_], EQ==Eq). + +metta_atom(Atom):- current_self(KB),metta_atom(KB,Atom). +%metta_atom([Superpose,ListOf], Atom):- Superpose == 'superpose',is_list(ListOf),!,member(KB,ListOf),get_metta_atom_from(KB,Atom). +metta_atom(Space, Atom):- typed_list(Space,_,L),!, member(Atom,L). +metta_atom(KB, [F, A| List]):- KB=='&flybase',fb_pred_nr(F, Len),current_predicate(F/Len), length([A|List],Len),apply(F,[A|List]). +%metta_atom(KB,Atom):- KB=='&corelib',!, metta_atom_corelib(Atom). +metta_atom(KB,Atom):- metta_atom_in_file( KB,Atom). +metta_atom(KB,Atom):- metta_atom_asserted( KB,Atom). +metta_atom(KB,Atom):- KB \== '&corelib', !, should_inherit_from_corelib(Atom), metta_atom('&corelib',Atom). +should_inherit_from_corelib([H|_]):- nonvar(H),should_inherit_op_from_corelib(H). +should_inherit_op_from_corelib('='). +should_inherit_op_from_corelib(':'). + +metta_atom_asserted('&self','&corelib'). +metta_atom_asserted('&self','&stdlib'). +metta_atom_asserted('&stdlib','&corelib'). +metta_atom_asserted('&flybase','&corelib'). +metta_atom_asserted('&catalog','&corelib'). +metta_atom_asserted('&catalog','&stdlib'). + +/* +'mod-space'(top,'&self'). +'mod-space'(catalog,'&catalog'). +'mod-space'(corelib,'&corelib'). +'mod-space'(stdlib,'&stdlib'). +'mod-space'(Top,'&self'):- Top == self. +*/ + +%metta_atom_asserted_fallback( KB,Atom):- metta_atom_stdlib(KB,Atom) + + +%metta_atom(KB,[F,A|List]):- metta_atom(KB,F,A,List), F \== '=',!. +is_metta_space(Space):- \+ \+ is_space_type(Space,_Test). + +metta_eq_def(Eq,KB,H,B):- ignore(Eq = '='),if_or_else(metta_atom(KB,[Eq,H,B]),metta_atom_corelib(KB,[Eq,H,B])). + +%metta_defn(KB,Head,Body):- metta_eq_def(_Eq,KB,Head,Body). +metta_defn(KB,H,B):- metta_eq_def('=',KB,H,B). +metta_type(KB,H,B):- metta_eq_def(':',KB,H,B). +%metta_type(S,H,B):- S == '&corelib', metta_atom_stdlib_types([':',H,B]). +%typed_list(Cmpd,Type,List):- compound(Cmpd), Cmpd\=[_|_], compound_name_arguments(Cmpd,Type,[List|_]),is_list(List). + +metta_atom_corelib(KB,Atom):- KB\='&corelib',!,metta_atom('&corelib',Atom). + +%maybe_xform(metta_atom(KB,[F,A|List]),metta_atom(KB,F,A,List)):- is_list(List),!. +maybe_xform(metta_eq_def(Eq,KB,Head,Body),metta_atom(KB,[Eq,Head,Body])). +maybe_xform(metta_defn(KB,Head,Body),metta_atom(KB,['=',Head,Body])). +maybe_xform(metta_type(KB,Head,Body),metta_atom(KB,[':',Head,Body])). +maybe_xform(metta_atom(KB,HeadBody),metta_atom_asserted(KB,HeadBody)). +maybe_xform(_OBO,_XForm):- !, fail. + +metta_anew1(Load,_OBO):- var(Load),trace,!. +metta_anew1(Ch,OBO):- metta_interp_mode(Ch,Mode), !, metta_anew1(Mode,OBO). +metta_anew1(Load,OBO):- maybe_xform(OBO,XForm),!,metta_anew1(Load,XForm). +metta_anew1(load,OBO):- OBO= metta_atom(Space,Atom),!,'add-atom'(Space, Atom). +metta_anew1(unload,OBO):- OBO= metta_atom(Space,Atom),!,'remove-atom'(Space, Atom). +metta_anew1(unload_all,OBO):- OBO= forall(metta_atom(Space,Atom),ignore('remove-atom'(Space, Atom))). + +metta_anew1(load,OBO):- !, + must_det_ll((load_hook(load,OBO), + subst_vars(OBO,Cl), + pfcAdd_Now(Cl))). %to_metta(Cl). +metta_anew1(load,OBO):- !, + must_det_ll((load_hook(load,OBO), + subst_vars(OBO,Cl), + show_failure(pfcAdd_Now(Cl)))). +metta_anew1(unload,OBO):- subst_vars(OBO,Cl),load_hook(unload,OBO), + expand_to_hb(Cl,Head,Body), + predicate_property(Head,number_of_clauses(_)), + ignore((clause(Head,Body,Ref),clause(Head2,Body2,Ref), + (Head+Body)=@=(Head2+Body2),erase(Ref),pp_m(unload(Cl)))). +metta_anew1(unload_all,OBO):- subst_vars(OBO,Cl),load_hook(unload_all,OBO), + expand_to_hb(Cl,Head,Body), + predicate_property(Head,number_of_clauses(_)), + forall( + (clause(Head,Body,Ref),clause(Head2,Body2,Ref)), + must_det_ll((((Head+Body)=@=(Head2+Body2)) + ->(erase(Ref),nop(pp_m(unload_all(Ref,Cl)))) + ;(pp_m(unload_all_diff(Cl,(Head+Body)\=@=(Head2+Body2))))))). + + +/* +metta_anew2(Load,_OBO):- var(Load),trace,!. +metta_anew2(Load,OBO):- maybe_xform(OBO,XForm),!,metta_anew2(Load,XForm). +metta_anew2(Ch,OBO):- metta_interp_mode(Ch,Mode), !, metta_anew2(Mode,OBO). +metta_anew2(load,OBO):- must_det_ll((load_hook(load,OBO),subst_vars_not_last(OBO,Cl),assertz_if_new(Cl))). %to_metta(Cl). +metta_anew2(unload,OBO):- subst_vars_not_last(OBO,Cl),load_hook(unload,OBO), + expand_to_hb(Cl,Head,Body), + predicate_property(Head,number_of_clauses(_)), + ignore((clause(Head,Body,Ref),clause(Head2,Body2,Ref),(Head+Body)=@=(Head2+Body2),erase(Ref),pp_m(Cl))). +metta_anew2(unload_all,OBO):- subst_vars_not_last(OBO,Cl),load_hook(unload_all,OBO), + expand_to_hb(Cl,Head,Body), + predicate_property(Head,number_of_clauses(_)), + forall((clause(Head,Body,Ref),clause(Head2,Body2,Ref),(Head+Body)=@=(Head2+Body2),erase(Ref),pp_m(Cl)),true). +*/ + +metta_anew(Load,Src,OBO):- maybe_xform(OBO,XForm),!,metta_anew(Load,Src,XForm). +metta_anew(Ch, Src, OBO):- metta_interp_mode(Ch,Mode), !, metta_anew(Mode,Src,OBO). +metta_anew(Load,_Src,OBO):- silent_loading,!,metta_anew1(Load,OBO). +metta_anew(Load,Src,OBO):- + not_compat_io(( + if_show(load,color_g_mesg('#ffa500', ((format('~N '), write_src(Src))))), + % format('~N'), + if_verbose(load,color_g_mesg('#0f0f0f',(write(' ; Action: '),writeq(Load=OBO),nl))))), + metta_anew1(Load,OBO),not_compat_io((format('~N'))). + +subst_vars_not_last(A,B):- + functor(A,_F,N),arg(N,A,E), + subst_vars(A,B), + nb_setarg(N,B,E),!. + +con_write(W):-check_silent_loading, not_compat_io((write(W))). +con_writeq(W):-check_silent_loading, not_compat_io((writeq(W))). +writeqln(Q):- check_silent_loading,not_compat_io((write(' '),con_writeq(Q),connl)). + + +into_space(Self,'&self',Self):-!. +into_space(_,Other,Other):-!. + + +into_space(Self,Myself,SelfO):- into_space(30,Self,Myself,SelfO). + +into_space(_Dpth,Self,Myself,Self):-Myself=='&self',!. +into_space(_Dpth,Self,None,Self):- 'None' == None,!. +into_space(Depth,Self,Other,Result):- eval_H(Depth,Self,Other,Result). +into_name(_,Other,Other). + +%eval_f_args(Depth,Self,F,ARGS,[F|EARGS]):- maplist(eval_H(Depth,Self),ARGS,EARGS). + + +combine_result(TF,R2,R2):- TF == [], !. +combine_result(TF,_,TF):-!. + + +do_metta1_e(_Self,_,exec(Exec)):- !,write_exec(Exec),!. +do_metta1_e(_Self,_,[=,A,B]):- !, with_concepts(false, + (con_write('(= '), with_indents(false,write_src(A)), + (is_list(B) -> connl ; true), + con_write(' '),with_indents(true,write_src(B)),con_write(')'))),connl. +do_metta1_e(_Self,_LoadExec,Term):- write_src(Term),connl. + +write_exec(Exec):- real_notrace(write_exec0(Exec)). +%write_exec0(Exec):- symbol(Exec),!,write_exec0([Exec]). + +write_exec0(Exec):- + wots(S,write_src(exec(Exec))), + nb_setval(exec_src,Exec), + format('~N'), + ignore((notrace((color_g_mesg('#0D6328',writeln(S)))))). + +%!(let* (( ($a $b) (collapse (get-atoms &self)))) ((bind! &stdlib $a) (bind! &corelib $b))) + +asserted_do_metta(Space,Ch,Src):- metta_interp_mode(Ch,Mode), !, asserted_do_metta(Space,Mode,Src). + +asserted_do_metta(Space,Load,Src):- Load==exec,!,do_metta_exec(python,Space,Src,_Out). +asserted_do_metta(Space,Load,Src):- asserted_do_metta2(Space,Load,Src,Src). + +asserted_do_metta2(Space,Ch,Info,Src):- nonvar(Ch), metta_interp_mode(Ch,Mode), !, asserted_do_metta2(Space,Mode,Info,Src). +/* +asserted_do_metta2(Self,Load,[TypeOp,Fn,Type], Src):- TypeOp == ':', \+ is_list(Type),!, + must_det_ll(( + color_g_mesg_ok('#ffa501',metta_anew(Load,Src,metta_atom(Self,[':',Fn,Type]))))),!. + +asserted_do_metta2(Self,Load,[TypeOp,Fn,TypeDecL], Src):- TypeOp == ':',!, + must_det_ll(( + decl_length(TypeDecL,Len),LenM1 is Len - 1, last_element(TypeDecL,LE), + color_g_mesg_ok('#ffa502',metta_anew(Load,Src,metta_atom(Self,[':',Fn,TypeDecL]))), + metta_anew1(Load,metta_arity(Self,Fn,LenM1)), + arg_types(TypeDecL,[],EachArg), + metta_anew1(Load,metta_params(Self,Fn,EachArg)),!, + metta_anew1(Load,metta_last(Self,Fn,LE)))). +*/ +/* +asserted_do_metta2(Self,Load,[TypeOp,Fn,TypeDecL,RetType], Src):- TypeOp == ':',!, + must_det_ll(( + decl_length(TypeDecL,Len), + append(TypeDecL,[RetType],TypeDecLRet), + color_g_mesg_ok('#ffa503',metta_anew(Load,Src,metta_atom(Self,[':',Fn,TypeDecLRet]))), + metta_anew1(Load,metta_arity(Self,Fn,Len)), + arg_types(TypeDecL,[RetType],EachArg), + metta_anew1(Load,metta_params(Self,Fn,EachArg)), + metta_anew1(Load,metta_return(Self,Fn,RetType)))),!. +*/ +/*do_metta(File,Self,Load,PredDecl, Src):-fail, + metta_anew(Load,Src,metta_atom(Self,PredDecl)), + ignore((PredDecl=['=',Head,Body], metta_anew(Load,Src,metta_eq_def(Eq,Self,Head,Body)))), + ignore((Body == 'True',!,do_metta(File,Self,Load,Head))), + nop((fn_append(Head,X,Head), fn_append(PredDecl,X,Body), + metta_anew((Head:- Body)))),!.*/ +/* +asserted_do_metta2(Self,Load,[EQ,Head,Result], Src):- EQ=='=', !, + color_g_mesg_ok('#ffa504',must_det_ll(( + discover_head(Self,Load,Head), + metta_anew(Load,Src,metta_eq_def(EQ,Self,Head,Result)), + discover_body(Self,Load,Result)))). +*/ +asserted_do_metta2(Self,Load,PredDecl, Src):- + %ignore(discover_head(Self,Load,PredDecl)), + color_g_mesg_ok('#ffa505',metta_anew(Load,Src,metta_atom(Self,PredDecl))). + +never_compile(X):- always_exec(X). + +always_exec(exec(W)):- !, is_list(W), always_exec(W). +always_exec(Comp):- compound(Comp),compound_name_arity(Comp,Name,N),symbol_concat('eval',_,Name),Nm1 is N-1, arg(Nm1,Comp,TA),!,always_exec(TA). +always_exec(List):- \+ is_list(List),!,fail. +always_exec([Var|_]):- \+ symbol(Var),!,fail. +always_exec(['extend-py!'|_]):- !, fail. +always_exec([H|_]):- symbol_concat(_,'!',H),!. %pragma!/print!/transfer!/include! etc +always_exec(['assertEqualToResult'|_]):-!,fail. +always_exec(['assertEqual'|_]):-!,fail. +always_exec(_):-!,fail. % everything else + +file_hides_results([W|_]):- W== 'pragma!'. + +if_t(A,B,C):- trace,if_t((A,B),C). + +check_answers_for(_,_):- nb_current(suspend_answers,true),!,fail. +check_answers_for(TermV,Ans):- (string(TermV);var(Ans);var(TermV)),!,fail. +check_answers_for(TermV,_):- sformat(S,'~q',[TermV]),atom_contains(S,"[assert"),!,fail. +check_answers_for(_,Ans):- contains_var('BadType',Ans),!,fail. +check_answers_for(TermV,_):- inside_assert(TermV,BaseEval), always_exec(BaseEval),!,fail. + +%check_answers_for([TermV],Ans):- !, check_answers_for(TermV,Ans). +%check_answers_for(TermV,[Ans]):- !, check_answers_for(TermV,Ans). +check_answers_for(_,_). + + /* +got_exec_result2(Val,Nth,Ans):- is_list(Ans), exclude(==(','),Ans,Ans2), Ans\==Ans2,!, + got_exec_result2(Val,Nth,Ans2). +got_exec_result2(Val,Nth,Ans):- + must_det_ll(( + Nth100 is Nth+100, + get_test_name(Nth100,TestName), + nb_current(exec_src,Exec), + if_t( ( \+ is_unit_test_exec(Exec)), + ((equal_enough(Val,Ans) + -> write_pass_fail_result_now(TestName,exec,Exec,'PASS',Ans,Val) + ; write_pass_fail_result_now(TestName,exec,Exec,'FAIL',Ans,Val)))))). + +write_pass_fail_result_now(TestName,exec,Exec,PASS_FAIL,Ans,Val):- + (PASS_FAIL=='PASS'->flag(loonit_success, X, X+1);flag(loonit_failure, X, X+1)), + (PASS_FAIL=='PASS'->Color=cyan;Color=red), + color_g_mesg(Color,write_pass_fail_result_c(TestName,exec,Exec,PASS_FAIL,Ans,Val)),!,nl, + nl,writeln('--------------------------------------------------------------------------'),!. + +write_pass_fail_result_c(TestName,exec,Exec,PASS_FAIL,Ans,Val):- + nl,write_mobj(exec,[(['assertEqualToResult',Exec,Ans])]), + nl,write_src('!'(['assertEqual',Val,Ans])), + write_pass_fail_result(TestName,exec,Exec,PASS_FAIL,Ans,Val). +*/ + +is_unit_test_exec(Exec):- sformat(S,'~w',[Exec]),sub_atom(S,_,_,_,'assert'). +is_unit_test_exec(Exec):- sformat(S,'~q',[Exec]),sub_atom(S,_,_,_,"!',"). + +make_empty(Empty):- 'Empty'=Empty. +make_empty(_,Empty):- make_empty(Empty). +make_empty(_RetType,_,Empty):- make_empty(Empty). + + +make_nop(Nop):- []=Nop. +make_nop(_,Nop):- make_nop(Nop). +make_nop(_RetType,_,Nop):- make_nop(Nop). + + +convert_tax(_How,Self,Tax,Expr,NewHow):- + metta_interp_mode(Ch,Mode), + string_concat(Ch,TaxM,Tax),!, + normalize_space(string(NewTax),TaxM), + convert_tax(Mode,Self,NewTax,Expr,NewHow). +convert_tax(How,_Self,Tax,Expr,How):- + %parse_sexpr_metta(Tax,Expr). + normalize_space(string(NewTax),Tax), + parse_sexpr_metta1(NewTax,Expr). + +%:- if( \+ current_predicate(notrace/1) ). +% notrace(G):- once(G). +%:- endif. + +metta_interp_mode('+',load). +metta_interp_mode('-',unload). +metta_interp_mode('--',unload_all). +metta_interp_mode('!',exec). +metta_interp_mode('?',call). +metta_interp_mode('^',load_like_file). + + +call_sexpr(How,Self,Tax,_S,Out):- + (symbol(Tax);string(Tax)), + normalize_space(string(TaxM),Tax), + convert_tax(How,Self,TaxM,Expr,NewHow),!, + show_call(do_metta(python,NewHow,Self,Expr,Out)). + +/* +do_metta(File,Load,Self,Cmt,Out):- + fail, + if_trace(do_metta, fbug(do_metta(File,Load,Self,Cmt,Out))),fail. +*/ + +do_metta(_File,_Load,_Self,In,Out):- var(In),!,In=Out. +do_metta(_From,_Mode,_Self,end_of_file,'Empty'):- !. %, halt(7), writeln('\n\n% To restart, use: ?- repl.'). +do_metta(_File,Load,_Self,Cmt,Out):- Load \==exec, Cmt==[],!, ignore(Out=[]). + +do_metta(From,Load,Self,'$COMMENT'(Expr,_,_),Out):- !, do_metta(From,comment(Load),Self,Expr,Out). +do_metta(From,Load,Self,'$STRING'(Expr),Out):- !, do_metta(From,comment(Load),Self,Expr,Out). +do_metta(From,comment(Load),Self,[Expr],Out):- !, do_metta(From,comment(Load),Self,Expr,Out). +do_metta(From,comment(Load),Self,Cmt,Out):- write_comment(Cmt), !, + ignore(( symbolic(Cmt),symbolic_list_concat([_,Src],'MeTTaLog only: ',Cmt),!,atom_string(Src,SrcCode),do_metta(mettalog_only(From),Load,Self,SrcCode,Out))), + ignore(( symbolic(Cmt),symbolic_list_concat([_,Src],'MeTTaLog: ',Cmt),!,atom_string(Src,SrcCode),do_metta(mettalog_only(From),Load,Self,SrcCode,Out))),!. + +do_metta(From,How,Self,Src,Out):- string(Src),!, + normalize_space(string(TaxM),Src), + convert_tax(How,Self,TaxM,Expr,NewHow),!, + do_metta(From,NewHow,Self,Expr,Out). + +do_metta(From,_,Self,exec(Expr),Out):- !, do_metta(From,exec,Self,Expr,Out). +do_metta(From,_,Self, call(Expr),Out):- !, do_metta(From,call,Self,Expr,Out). +do_metta(From,_,Self, ':-'(Expr),Out):- !, do_metta(From,call,Self,Expr,Out). +do_metta(From,call,Self,TermV,FOut):- !, + if_t(into_simple_op(call,TermV,OP),pfcAdd_Now('next-operation'(OP))), + call_for_term_variables(TermV,Term,NamedVarsList,X), must_be(nonvar,Term), + copy_term(NamedVarsList,Was), + Output = NamedVarsList, + user:interactively_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut). + +do_metta(_File,Load,Self,Src,Out):- Load\==exec, !, + if_t(into_simple_op(Load,Src,OP),pfcAdd_Now('next-operation'(OP))), + dont_give_up(as_tf(asserted_do_metta(Self,Load,Src),Out)). + +do_metta(file(Filename),exec,Self,TermV,Out):- + must_det_ll((inc_exec_num(Filename), + get_exec_num(Filename,Nth), + Nth>0)), + (( + is_synthing_unit_tests, + file_answers(Filename, Nth, Ans), + check_answers_for(TermV,Ans))),!, + if_t(into_simple_op(exec,TermV,OP),pfcAdd_Now('next-operation'(OP))), + must_det_ll(( + ensure_increments((color_g_mesg_ok('#ffa509', + (writeln(';; In file as: '), + color_g_mesg([bold,fg('#FFEE58')], write_src(exec(TermV))), + write(';; To unit test case:'))),!, + call(do_metta_exec(file(Filename),Self,['assertEqualToResult',TermV,Ans],Out)))))). + +do_metta(From,exec,Self,TermV,Out):- !, + if_t(into_simple_op(exec,TermV,OP),pfcAdd_Now('next-operation'(OP))), + dont_give_up(do_metta_exec(From,Self,TermV,Out)). + +do_metta_exec(From,Self,TermV,FOut):- + Output = X, + ignore(catch(((not_compatio(write_exec(TermV)), + notrace(into_metta_callable(Self,TermV,Term,X,NamedVarsList,Was)),!, + user:interactively_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut))), + give_up(Why),pp_m(red,gave_up(Why)))),!. + + +o_s(['assertEqual'|O],S):- o_s(O,S). +o_s(['assertEqualToResult'|O],S):- o_s(O,S). +o_s([O|_],S):- !, o_s(O,S). +o_s(S,S). +into_simple_op(Load,[Op|O],op(Load,Op,S)):- o_s(O,S),!. + +call_for_term_variables(TermV,catch_red(show_failure(Term)),NamedVarsList,X):- + term_variables(TermV, AllVars), call_for_term_variables4v(TermV,AllVars,Term,NamedVarsList,X),!, + must_be(callable,Term). +call_for_term_variables(TermV,catch_red(show_failure(Term)),NamedVarsList,X):- + get_term_variables(TermV, DCAllVars, Singletons, NonSingletons), + call_for_term_variables5(TermV, DCAllVars, Singletons, NonSingletons, Term,NamedVarsList,X),!, + must_be(callable,Term). + +into_metta_callable(_Self,TermV,Term,X,NamedVarsList,Was):- \+ never_compile(TermV), + is_transpiling, !, + must_det_ll(((( + + % ignore(Res = '$VAR'('ExecRes')), + RealRes = Res, + compile_for_exec(Res,TermV,ExecGoal),!, + subst_vars(Res+ExecGoal,Res+Term,NamedVarsList), + copy_term_g(NamedVarsList,Was), + term_variables(Term,Vars), + %notrace((color_g_mesg('#114411',print_pl_source(answer(Res):-ExecGoal)))), + %nl,writeq(Term),nl, + ((\+ \+ + ((numbervars(v(TermV,Term,NamedVarsList,Vars),999,_,[attvar(bind)]), + %nb_current(variable_names,NamedVarsList), + %nl,print(subst_vars(Term,NamedVarsList,Vars)), + nop(nl))))), + nop(maplist(verbose_unify,Vars)), + %NamedVarsList=[_=RealRealRes|_], + var(RealRes), X = RealRes)))),!. + + +into_metta_callable(Self,TermV,CALL,X,NamedVarsList,Was):-!, + option_else('stack-max',StackMax,100), + CALL = eval_H(StackMax,Self,Term,X), + notrace(( must_det_ll(( + if_t(show_transpiler,write_compiled_exec(TermV,_Goal)), + subst_vars(TermV,Term,NamedVarsList), + copy_term_g(NamedVarsList,Was) + %term_variables(Term,Vars), + %nl,writeq(Term),nl, + %skip((\+ \+ + %((numbervars(v(TermV,Term,NamedVarsList,Vars),999,_,[attvar(bind)]), %nb_current(variable_names,NamedVarsList), + %nl,print(subst_vars(TermV,Term,NamedVarsList,Vars)),nl)))), + %nop(maplist(verbose_unify,Vars)))))),!. + )))),!. + + + +eval_S(Self,Form):- nonvar(Form), + current_self(SelfS),SelfS==Self,!, + do_metta(true,exec,Self,Form,_Out). +eval_H(Term,X):- catch_metta_return(eval_args(Term,X),X). +eval_H(StackMax,Self,Term,X):- catch_metta_return(eval_args('=',_,StackMax,Self,Term,X),X). +/* +eval_H(StackMax,Self,Term,X). + +eval_H(StackMax,Self,Term,X):- + Time = 90.0, + ((always_exec(Term)) -> + if_or_else(t1('=',_,StackMax,Self,Term,X), + (t2('=',_,StackMax,Self,Term,X))); + call_max_time(t1('=',_,StackMax,Self,Term,X), Time, + (t2('=',_,StackMax,Self,Term,X)))). + +eval_H(Term,X):- + current_self(Self), StackMax = 100, + if_or_else((t1('=',_,StackMax,Self,Term,X),X\==Term),(t2('=',_,StackMax,Self,Term,X),nop(X\==Term))). + + +t1('=',_,StackMax,Self,Term,X):- eval_args('=',_,StackMax,Self,Term,X). +t2('=',_,StackMax,Self,Term,X):- fail, subst_args('=',_,StackMax,Self,Term,X). +*/ + +%eval_H(Term,X):- if_or_else((subst_args(Term,X),X\==Term),(eval_args(Term,Y),Y\==Term)). + +print_goals(TermV):- write_src(TermV). + + +if_or_else(Goal,Else):- call(Goal)*->true;call(Else). + +interacting:- tracing,!. +interacting:- current_prolog_flag(debug,true),!. +interacting:- option_value(interactive,true),!. +interacting:- option_value(prolog,true),!. + +% call_max_time(+Goal, +MaxTime, +Else) +call_max_time(Goal,_MaxTime, Else) :- interacting,!, if_or_else(Goal,Else). +call_max_time(Goal,_MaxTime, Else) :- !, if_or_else(Goal,Else). +call_max_time(Goal, MaxTime, Else) :- + catch(if_or_else(call_with_time_limit(MaxTime, Goal),Else), time_limit_exceeded, Else). + + +catch_err(G,E,C):- catch(G,E,(always_rethrow(E)->(throw(E));C)). +dont_give_up(G):- catch(G,give_up(E),write_src_uo(dont_give_up(E))). + +not_in_eq(List, Element) :- + member(V, List), V == Element. + +:- ensure_loaded(metta_repl). + + +:- nodebug(metta(eval)). +:- nodebug(metta(exec)). +:- nodebug(metta(load)). +:- nodebug(metta(prolog)). +% Measures the execution time of a Prolog goal and displays the duration in seconds, +% milliseconds, or microseconds, depending on the execution time. +% +% Args: +% - Goal: The Prolog goal to be executed and timed. +% +% The predicate uses the `statistics/2` predicate to measure the CPU time before +% and after executing the provided goal. It calculates the elapsed time in seconds +% and converts it to milliseconds and microseconds. The output is formatted to +% provide clear timing information: +% +% - If the execution takes more than 2 seconds, it displays the time in seconds. +% - If the execution takes between 1 millisecond and 2 seconds, it displays the time +% in milliseconds. +% - If the execution takes less than 1 millisecond, it displays the time in microseconds. +% +% Example usage: +% ?- time_eval(my_goal(X)). +% +% ?- time_eval(sleep(0.95)). +% +% Output examples: +% ; Evaluation took 2.34 seconds. +% ; Evaluation took 123.45 ms. +% ; Evaluation took 0.012 ms. (12.33 microseconds) +% +time_eval(Goal):- + time_eval('Evaluation',Goal). +time_eval(What,Goal) :- + timed_call(Goal,Seconds), + give_time(What,Seconds). + +give_time(_What,_Seconds):- is_compatio,!. +give_time(What,Seconds):- + Milliseconds is Seconds * 1_000, + (Seconds > 2 + -> format('~N; ~w took ~2f seconds.~n~n', [What, Seconds]) + ; (Milliseconds >= 1 + -> format('~N; ~w took ~3f secs. (~2f milliseconds) ~n~n', [What, Seconds, Milliseconds]) + ;( Micro is Milliseconds * 1_000, + format('~N; ~w took ~6f secs. (~2f microseconds) ~n~n', [What, Seconds, Micro])))). + +timed_call(Goal,Seconds):- + statistics(cputime, Start), + ( \+ rtrace_this(Goal)->rtrace_on_error(Goal);rtrace(Goal)), + statistics(cputime, End), + Seconds is End - Start. + +rtrace_this(eval_H(_, _, P , _)):- compound(P), !, rtrace_this(P). +rtrace_this([P|_]):- P == 'pragma!',!,fail. +rtrace_this([P|_]):- P == 'import!',!,fail. +rtrace_this([P|_]):- P == 'rtrace!',!. +rtrace_this(_Call):- option_value(rtrace,true),!. +rtrace_this(_Call):- is_debugging(rtrace),!. + +%:- nb_setval(cmt_override,lse('; ',' !(" ',' ") ')). + +:- abolish(fbug/1). +fbug(_):- is_compatio,!. +fbug(Info):- real_notrace(in_cmt(color_g_mesg('#2f2f2f',write_src(Info)))). +example0(_):- fail. +example1(a). example1(_):- fail. +example2(a). example2(b). example2(_):- fail. +example3(a). example3(b). example3(c). example3(_):- fail. +%eval_H(100,'&self',['change-state!','&var',[+,1,['get-state','&var']]],OUT) +%dcall(X):- (call(X),deterministic(YN)),trace,((YN==true)->!;true). +chkdet_call(XX):- !, call(XX). +chkdet_call0(XX):- !, call(XX). + +dcall0000000000(XX):- + USol = sol(dead), + copy_term_g(XX,X), + call_nth(USol,X,Nth,Det,Prev), + %fbug(call_nth(USol,X,Nth,Det,Prev)), + XX=Prev, + (Det==yes -> (!, (XX=Prev;XX=X)) ; + (((var(Nth) -> ( ! , Prev\==dead) ; + true), + (Nth==1 -> ! ; true)))). + +call_nth(USol,XX,Nth,Det,Prev):- + repeat, + ((call_nth(XX,Nth),deterministic(Det),arg(1,USol,Prev))*-> + ( nb_setarg(1,USol,XX)) + ; (!, arg(1,USol,Prev))). + +catch_red(Term):- catch_err(Term,E,pp_m(red,in(Term,E))). +%catch_red(Term):- call(Term). + +s2p(I,O):- sexpr_s2p(I,O),!. + +discover_head(Self,Load,Head):- + ignore(([Fn|PredDecl]=Head, + nop(( arg_types(PredDecl,[],EachArg), + metta_anew1(Load,metta_head(Self,Fn,EachArg)))))). + +discover_body(Self,Load,Body):- + nop(( [Fn|PredDecl] = Body, arg_types(PredDecl,[],EachArg), + metta_anew1(Load,metta_body(Self,Fn,EachArg)))). + +decl_length(TypeDecL,Len):- is_list(TypeDecL),!,length(TypeDecL,Len). +decl_length(_TypeDecL,1). + +arg_types([Ar|L],R,LR):- Ar == '->', !, arg_types(L,R,LR). +arg_types([[Ar|L]],R,LR):- Ar == '->', !, arg_types(L,R,LR). +arg_types(L,R,LR):- append(L,R,LR). + +%:- ensure_loaded('../../examples/factorial'). +%:- ensure_loaded('../../examples/fibonacci'). + +%print_preds_to_functs:-preds_to_functs_src(factorial_tail_basic) +ggtrace(G):- call(G). +ggtrace0(G):- ggtrace, + leash(-all), + visible(-all), + % debug, + %visible(+redo), + visible(+call), + visible(+exception), + maybe_leash(+exception), + setup_call_cleanup(trace,G,notrace). +:- dynamic(began_loon/1). +loon:- loon(typein). + + +catch_red_ignore(G):- if_or_else(catch_red(G),true). + +:- export(loon/1). +:- public(loon/1). + + +%loon(Why):- began_loon(Why),!,fbugio(begun_loon(Why)). +loon(Why):- is_compiling,!,fbug(compiling_loon(Why)),!. +%loon( _Y):- current_prolog_flag(os_argv,ArgV),member('-s',ArgV),!. +% Why\==toplevel,Why\==default, Why\==program,! +loon(Why):- is_compiled, Why\==toplevel,!,fbugio(compiled_loon(Why)),!. +loon(Why):- began_loon(_),!,fbugio(skip_loon(Why)). +loon(Why):- fbugio(began_loon(Why)), assert(began_loon(Why)), + do_loon. + +do_loon:- + ignore(( + \+ prolog_load_context(reloading,true), + maplist(catch_red_ignore,[ + + %if_t(is_compiled,ensure_mettalog_py), + install_readline_editline, + %nts1, + %install_ontology, + metta_final, + % ensure_corelib_types, + set_output_stream, + if_t(is_compiled,update_changed_files), + run_cmd_args, + write_answer_output, + maybe_halt(7)]))),!. + + +need_interaction:- \+ option_value('had_interaction',true), + \+ is_converting, \+ is_compiling, \+ is_pyswip,!, + option_value('prolog',false), option_value('repl',false), \+ metta_file(_Self,_Filename,_Directory). + +pre_halt1:- is_compiling,!,fail. +pre_halt1:- loonit_report,fail. +pre_halt2:- is_compiling,!,fail. +pre_halt2:- option_value('prolog',true),!,set_option_value('prolog',started),call_cleanup(prolog,pre_halt2). +pre_halt2:- option_value('repl',true),!,set_option_value('repl',started),call_cleanup(repl,pre_halt2). +pre_halt2:- need_interaction, set_option_value('had_interaction',true),call_cleanup(repl,pre_halt2). + +%loon:- time(loon_metta('./examples/compat/test_scripts/*.metta')),fail. +%loon:- repl, (option_value('halt',false)->true;halt(7)). +%maybe_halt(Seven):- option_value('prolog',true),!,call_cleanup(prolog,(set_option_value_interp('prolog',false),maybe_halt(Seven))). +%maybe_halt(Seven):- option_value('repl',true),!,call_cleanup(repl,(set_option_value_interp('repl',false),maybe_halt(Seven))). +%maybe_halt(Seven):- option_value('repl',true),!,halt(Seven). + +maybe_halt(_):- once(pre_halt1), fail. +maybe_halt(Seven):- option_value('repl',false),!,halt(Seven). +maybe_halt(Seven):- option_value('halt',true),!,halt(Seven). +maybe_halt(_):- once(pre_halt2), fail. +maybe_halt(Seven):- fbugio(maybe_halt(Seven)), fail. +%maybe_halt(_):- !. +maybe_halt(H):- halt(H). + + +:- initialization(nb_setval(cmt_override,lse('; ',' !(" ',' ") ')),restore). + + +%needs_repl:- \+ is_converting, \+ is_pyswip, \+ is_compiling, \+ has_file_arg. +% libswipl: ['./','-q',--home=/usr/local/lib/swipl] + +:- initialization(show_os_argv). + +:- initialization(loon(program),program). +:- initialization(loon(default)). + +ensure_mettalog_system_compilable:- + %ensure_loaded(library(metta_python)), + ensure_mettalog_system. +ensure_mettalog_system:- + abolish(began_loon/1), + dynamic(began_loon/1), + system:use_module(library(quasi_quotations)), + system:use_module(library(hashtable)), + system:use_module(library(gensym)), + system:use_module(library(sort)), + system:use_module(library(writef)), + system:use_module(library(rbtrees)), + system:use_module(library(dicts)), + system:use_module(library(shell)), + system:use_module(library(edinburgh)), + % system:use_module(library(lists)), + system:use_module(library(statistics)), + system:use_module(library(nb_set)), + system:use_module(library(assoc)), + system:use_module(library(pairs)), + if_t(exists_source(library(swi_ide)),user:use_module(library(swi_ide))), + user:use_module(library(prolog_profile)), + %metta_python, + %ensure_loaded('./src/main/flybase_convert'), + %ensure_loaded('./src/main/flybase_main'), + %ensure_loaded(library(flybase_convert)), + %ensure_loaded(library(flybase_main)), + autoload_all, + make, + autoload_all, + %pack_install(predicate_streams, [upgrade(true),global(true)]), + %pack_install(logicmoo_utils, [upgrade(true),global(true)]), + %pack_install(dictoo, [upgrade(true),global(true)]), + !. + +file_save_name(E,_):- \+ symbol(E),!,fail. +file_save_name(E,Name):- file_base_name(E,BN),BN\==E,!,file_save_name(BN,Name). +file_save_name(E,E):- symbol_concat('Sav.',_,E),!. +file_save_name(E,E):- symbol_concat('Bin.',_,E),!. +before_underscore(E,N):-symbolic_list_concat([N|_],'_',E),!. +save_name(Name):- current_prolog_flag(os_argv,ArgV),member(E,ArgV),file_save_name(E,Name),!. +next_save_name(Name):- save_name(E), + before_underscore(E,N), + symbol_concat(N,'_',Stem), + gensym(Stem,Name), + \+ exists_file(Name), + Name\==E,!. +next_save_name(SavMeTTaLog):- option_value(exeout,SavMeTTaLog), + symbolic(SavMeTTaLog),atom_length(SavMeTTaLog,Len),Len>1,!. +next_save_name('Sav.MeTTaLog'). +qcompile_mettalog:- + ensure_mettalog_system, + option_value(exeout,Named), + catch_err(qsave_program(Named, + [class(development),autoload(true),goal(loon(goal)), + toplevel(loon(toplevel)), stand_alone(true)]),E,writeln(E)), + halt(0). +qsave_program:- ensure_mettalog_system, next_save_name(Name), + catch_err(qsave_program(Name, + [class(development),autoload(true),goal(loon(goal)), toplevel(loon(toplevel)), stand_alone(false)]),E,writeln(E)), + !. + + +:- ensure_loaded(library(flybase_main)). +:- ensure_loaded(metta_server). +:- initialization(update_changed_files,restore). + +nts1:- !. % disable redefinition +nts1:- redefine_system_predicate(system:notrace/1), + %listing(system:notrace/1), + abolish(system:notrace/1), + dynamic(system:notrace/1), + meta_predicate(system:notrace(0)), + asserta((system:notrace(G):- (!,once(G)))). +nts1:- !. + +:- nts1. + +nts0:- redefine_system_predicate(system:notrace/0), + abolish(system:notrace/0), + asserta((system:notrace:- wdmsg(notrace))). +%:- nts0. + +override_portray:- + forall( + clause(user:portray(List), Where:Body, Cl), + (assert(user:portray_prev(List):- Where:Body), + erase(Cl))), + asserta((user:portray(List) :- metta_portray(List))). + +metta_message_hook(A, B, C) :- + user: + ( B==error, + fbug(metta_message_hook(A, B, C)), + fail + ). + +override_message_hook:- + forall( + clause(user:message_hook(A,B,C), Where:Body, Cl), + (assert(user:message_hook(A,B,C):- Where:Body), erase(Cl))), + asserta((user:message_hook(A,B,C) :- metta_message_hook(A,B,C))). + +fix_message_hook:- + clause(message_hook(A, B, C), + user: + ( B==error, + fbug(user:message_hook(A, B, C)), + fail + ), Cl),erase(Cl). + +:- unnullify_output. + +%:- ensure_loaded(metta_python). + +%:- ensure_loaded('../../library/genome/flybase_loader'). + +:- ensure_loaded(metta_python). +:- initialization(use_corelib_file). + +:- ignore((( + use_corelib_file, + (is_testing -> UNIT_TEST=true; UNIT_TEST=false), + set_is_unit_test(UNIT_TEST), + \+ prolog_load_context(reloading,true), + initialization(loon(restore),restore), + % nts1, + metta_final + ))). + +:- set_prolog_flag(metta_interp,ready). + +:- use_module(library(clpr)). % Import the CLP(R) library +%:- ensure_loaded('metta_ontology.pfc.pl'). + +% Define a predicate to relate the likelihoods of three events +complex_relationship3_ex(Likelihood1, Likelihood2, Likelihood3) :- + { Likelihood1 = 0.3 * Likelihood2 }, + { Likelihood2 = 0.5 * Likelihood3 }, + { Likelihood3 < 1.0 }, + { Likelihood3 > 0.0 }. + +% Example query to find the likelihoods that satisfy the constraints +%?- complex_relationship(L1, L2, L3). diff --git a/.Attic/canary_docme/metta_loader.pl b/.Attic/canary_docme/metta_loader.pl new file mode 100644 index 00000000000..5f2a0b50767 --- /dev/null +++ b/.Attic/canary_docme/metta_loader.pl @@ -0,0 +1,1172 @@ +/* + * 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. + */ + + + +when_tracing(Goal):- tracing,!,notrace(Goal),!. +when_tracing(_). + +:- multifile(user:asserted_metta_pred/2). +:- dynamic(user:asserted_metta_pred/2). + +exists_virtually(corelib). +exists_virtually(stdlib). + +path_chars(A,C):- symbol_chars(A,C). + +with_wild_path(Fnicate, Dir):- + working_directory(PWD,PWD), + wwp(Fnicate, Dir). + +inner_compound(Inner,'.',Inner):- \+ compound(Inner),!. +inner_compound(Cmpd,Outter,Inner):- + compound_name_arguments(Cmpd,F,[X|Args]), + compound_name_arguments(Outter,F,[Midder|Args]), + inner_compound(X,Midder,Inner). + +afn(A,B):- quietly(absolute_file_name(A,B)). +afn(A,B,C):- quietly(absolute_file_name(A,B,C)). + +% Process a file or directory path with a given predicate. +wwp(Fnicate, Dir) :- extreme_debug(fbug(wwp(Fnicate, Dir))),fail. +wwp(_Fnicate, []) :- !. +wwp(_Fnicate, Virtual) :- exists_virtually(Virtual),!. +wwp(Fnicate, Virtual) :- var(Virtual),!,throw(var_wwp(Fnicate, Virtual)). +wwp(Fnicate, Dir) :- is_scryer, symbol(Dir), !, must_det_ll((path_chars(Dir,Chars), wwp(Fnicate, Chars))). + + +wwp(Fnicate, File) :- is_list(File), !, + must_det_ll((maplist(wwp(Fnicate), File))). + +wwp(Fnicate, Cmpd):- compound(Cmpd), + inner_compound(Cmpd,Outter,Inner),!, + afn(Outter, Dir,[solutions(all), access(read), file_errors(fail)]), + with_cwd(Dir,wwp(Fnicate, Inner)),!. + +wwp(Fnicate, Chars) :- \+ is_scryer, \+ symbol(Chars), !, must_det_ll((name(Atom,Chars), wwp(Fnicate, Atom))). + +wwp(Fnicate, File) :- exists_file(File), !, must_det_ll(( call(Fnicate, File))). + +wwp(Fnicate, ColonS) :- fail, symbolic(ColonS), symbol_contains(ColonS, ':'),!, + symbolic_list_concat([Top|Rest],':',ColonS), + symbolic_list_concat(Rest,':',FileNext), + when_tracing(listing(is_metta_module_path)), + find_top_dirs(Top,Dir), + ((fail,symbol_length(FileNext,0)) + -> wwp(Fnicate, Dir) + ; (exists_directory(Dir) + -> with_cwd(Dir,wwp(Fnicate, FileNext)) + ; fail)),!. + +wwp(Fnicate, ColonS) :- symbolic(ColonS), symbol_contains(ColonS, ':'),!, + symbolic_list_concat([Top|Rest],':',ColonS), + symbolic_list_concat(Rest,':',FileNext),!, + when_tracing(listing(is_metta_module_path)), + must_det_ll((call(( + quietly(find_top_dirs(Top,Dir)), + exists_directory(Dir), + with_cwd(Dir,wwp(Fnicate, FileNext)))))),!. + +wwp(Fnicate, File) :- + symbol_contains(File, '*'), + expand_file_name(File, List), + maplist(wwp(Fnicate), List),!. + +wwp(Fnicate, Dir) :- exists_directory(Dir), + quietly(afn_from('__init__.py', PyFile, [access(read), file_errors(fail), relative_to(Dir)])), + wwp(Fnicate, PyFile). + + +wwp(Fnicate, File) :- + \+ exists_directory(File), \+ exists_file(File), %\+ symbol_contains(File,'.'), + extension_search_order(Ext), + symbolic_list_concat([File|Ext],MeTTafile), + exists_file(MeTTafile), + call(Fnicate, MeTTafile). + +wwp(Fnicate, File) :- + \+ exists_directory(File), \+ exists_file(File), symbol_contains(File,'..'), + extension_search_order(Ext), + symbolic_list_concat([File|Ext],MeTTafile0), + afn_from(MeTTafile0, MeTTafile, [access(read), file_errors(fail)]), + exists_file(MeTTafile), + call(Fnicate, MeTTafile). + +wwp(Fnicate, File) :- + exists_directory(File), + directory_file_path(File, '*.*sv', Wildcard), + expand_file_name(Wildcard, List), !, + maplist(Fnicate, List). + +wwp(Fnicate, Dir) :- exists_directory(Dir), !, + must_det_ll((directory_files(Dir, Files), + maplist(directory_file_path(Dir,Files),Paths), + maplist(path_chars,Paths,CharPaths), + maplist(wwp(Fnicate), CharPaths))), !. + +wwp(Fnicate, File) :- must_det_ll((call(Fnicate, File))). + +extension_search_order(['.metta']). +extension_search_order(['.py']). +extension_search_order(['']). + +:- if( \+ current_predicate(load_metta_file/2)). +load_metta_file(Self,Filemask):- symbol_concat(_,'.metta',Filemask),!, load_metta(Self,Filemask). +load_metta_file(_Slf,Filemask):- load_flybase(Filemask). +:- endif. + +afn_from(RelFilename,Filename):- + afn_from(RelFilename,Filename,[]). + +afn_from(RelFilename,Filename,Opts):- + select(relative_to(RelFrom),Opts,NewOpts), + afn_from(RelFrom,RelFromNew,NewOpts), + quietly(afn(RelFilename,Filename,[relative_to(RelFromNew)|NewOpts])). +afn_from(RelFilename,Filename,Opts):- + is_metta_module_path(ModPath), + quietly(afn(RelFilename,Filename,[relative_to(ModPath)|Opts])). + +register_module(Dir):- current_self(Space), register_module(Space,Dir). + +register_module(Space,Path):- + register_module(Space,'%top%',Path), + file_directory_name(Path,Dir), + file_base_name(Path, ModuleName), + register_module(Space,ModuleName,Dir). + +register_module(Space,ModuleName,Dir):- + space_name(Space,SpaceName), + absolute_dir(Dir,AbsDir), + asserta(is_metta_module_path(SpaceName,ModuleName,AbsDir)). + + +find_top_dirs(Top,Dir):- current_self(Self),space_name(Self,SpaceName), find_top_dirs(SpaceName,Top,Dir). + +find_top_dirs(SpaceName,Top,Abs):- is_metta_module_path(SpaceName,Top,Abs). +find_top_dirs(SpaceName,Top,Dir):- is_metta_module_path(SpaceName,'%top%',Root),absolute_dir(Top,Root,Dir). +find_top_dirs(SpaceName,Top,Dir):- working_directory(PWD,PWD), + parent_dir_of(PWD,Top,Dir), assert(is_metta_module_path(SpaceName,Top,Dir)). + +parent_dir_of(PWD,Top,Dir):- directory_file_path(Parent,TTop,PWD), + (TTop==Top->Dir=PWD;parent_dir_of(Parent,Top,Dir)). + + +space_name(Space,SpaceName):- symbol(Space),!,SpaceName = Space,!. +space_name(Space,SpaceName):- is_space_name(SpaceName), same_space(SpaceName,Space),!. +space_name(Space,SpaceName):- 'get-atoms'(Space,['space-symbol',SpaceName]),!. + +same_space(Space1,Space2):- Space1=Space2. +same_space(SpaceName1,Space2):- symbol(SpaceName1),eval(SpaceName1,Space1),!,same_space(Space2,Space1). + +absolute_dir(Dir,AbsDir):- afn(Dir, AbsDir, [access(read), file_errors(fail), file_type(directory)]). +absolute_dir(Dir,From,AbsDir):- afn(Dir, AbsDir, [relative_to(From),access(read), file_errors(fail), file_type(directory)]),!. + + + + +:- dynamic(is_metta_module_path/3). +:- dynamic(is_metta_module_path/1). +is_metta_module_path('.'). + +load_metta(Filename):- + %clear_spaces, + load_metta('&self',Filename). + +load_metta(_Self,Filename):- Filename=='--repl',!,repl. +load_metta(Self,Filename):- + (\+ symbol(Filename); \+ exists_file(Filename)),!, + with_wild_path(load_metta(Self),Filename),!,loonit_report. +load_metta(Self,RelFilename):- + atom(RelFilename), + exists_file(RelFilename),!, + afn_from(RelFilename,Filename), + track_load_into_file(Filename, + include_metta(Self,RelFilename)). + +import_metta(Self,Module):- current_predicate(py_is_module/1),py_is_module(Module),!, + must_det_ll(self_extend_py(Self,Module)),!. +import_metta(Self,Filename):- + (\+ symbol(Filename); \+ exists_file(Filename)),!, + must_det_ll(with_wild_path(import_metta(Self),Filename)),!. +import_metta(Self,RelFilename):- + must_det_ll(( + symbol(RelFilename), + exists_file(RelFilename), + absolute_file_name(RelFilename,Filename), + directory_file_path(Directory, _, Filename), + pfcAdd_Now(metta_file(Self,Filename,Directory)), + locally(nb_setval(suspend_answers,true), + include_metta_directory_file(Self,Directory, Filename)))). + +include_metta(Self,Filename):- + (\+ symbol(Filename); \+ exists_file(Filename)),!, + must_det_ll(with_wild_path(include_metta(Self),Filename)),!. +include_metta(Self,RelFilename):- + must_det_ll(( + symbol(RelFilename), + exists_file(RelFilename),!, + afn_from(RelFilename,Filename), + directory_file_path(Directory, _, Filename), + pfcAdd_Now(metta_file(Self,Filename,Directory)), + pfcAdd_Now(user:loaded_into_kb(Self,Filename)), + include_metta_directory_file(Self,Directory, Filename))), + pfcAdd_Now(user:loaded_into_kb(Self,Filename)), + nop(listing(user:loaded_into_kb/2)). + + + +% count_lines_up_to(TwoK,Filename, Count). +count_lines_up_to(TwoK,Filename, Count) :- + open(Filename, read, Stream,[encoding(utf8)]), + count_lines_in_stream(TwoK,Stream, 0, Count), + close(Stream). + +% count_lines_in_stream(Stream, CurrentCount, FinalCount). +count_lines_in_stream(TwoK,Stream, CurrentCount, FinalCount) :- + ( CurrentCount >= TwoK + -> FinalCount = TwoK + ; read_line_to_codes(Stream, Codes), + ( Codes == end_of_file + -> FinalCount = CurrentCount + ; NewCount is CurrentCount + 1, + count_lines_in_stream(TwoK, Stream, NewCount, FinalCount) + ) + ). + + +include_metta_directory_file_prebuilt(Self, _Directory, Filename):- + symbol_concat(_, '.metta', Filename), + symbol_concat(Filename, '.qlf', QlfFile), + exists_file(QlfFile), + time_file(Filename, MettaTime), + time_file(QlfFile, QLFTime), + QLFTime > MettaTime,!, % Ensure QLF file is newer than the METTA file + pfcAdd_Now(user:loaded_into_kb(Self,Filename)), + ensure_loaded(QlfFile),!. + + +include_metta_directory_file_prebuilt(Self,_Directory, Filename):- just_load_datalog, + symbol_concat(_,'.metta',Filename), + symbol_concat(Filename,'.datalog',DatalogFile), + exists_file(DatalogFile), + time_file(Filename, MettaTime), + time_file(DatalogFile, DatalogTime), + DatalogTime > MettaTime, !, % Ensure Datalog file is newer than the METTA file + size_file(Filename, MettaSize), + size_file(DatalogFile, DatalogSize), + % Ensure the size of the Datalog file is at least 25% of the METTA file + DatalogSize >= 0.25 * MettaSize, + !, % Cut to prevent backtracking + pfcAdd_Now(user:loaded_into_kb(Self,Filename)), + ensure_loaded(DatalogFile),!. + +include_metta_directory_file_prebuilt(Self,_Directory, Filename):- + symbol_concat(_,'.metta',Filename), + symbol_concat(Filename,'.datalog',DatalogFile), + exists_file(DatalogFile),!, + size_file(Filename, MettaSize), + size_file(DatalogFile, DatalogSize), + % Ensure the size of the Datalog file is at least 25% of the METTA file + DatalogSize >= 0.25 * MettaSize, + !, % Cut to prevent backtracking + convert_datalog_to_loadable(DatalogFile,QlfFile),!, + exists_file(QlfFile),!, + pfcAdd_Now(user:loaded_into_kb(Self,Filename)), + ensure_loaded(QlfFile),!. + + + +include_metta_directory_file(Self,Directory, Filename):- + include_metta_directory_file_prebuilt(Self,Directory, Filename),!. +include_metta_directory_file(Self,_Directory, Filename):- + count_lines_up_to(2000,Filename, Count), Count > 1980, + once(convert_metta_to_loadable(Filename,QlfFile)), + exists_file(QlfFile),!, + pfcAdd_Now(user:loaded_into_kb(Self,Filename)), + ensure_loaded(QlfFile). + +include_metta_directory_file(Self,Directory,Filename):- + with_cwd(Directory,must_det_ll(setup_call_cleanup(open(Filename,read,In, [encoding(utf8)]), + must_det_ll( load_metta_file_stream(Filename,Self,In)), + close(In)))). + +convert_metta_to_datalog(Filename,DatalogFile):- + % Generate the Datalog file name + ignore(symbol_concat(Filename,'.datalog',DatalogFile)), + % Open the METTA file for reading + setup_call_cleanup( + open(Filename, read, Input, [encoding(utf8)]), + % Open the Datalog file for writing + setup_call_cleanup( + open(DatalogFile, write, Output, [encoding(utf8)]), + % Perform the conversion + translate_metta_file_to_datalog_io(Filename,Input,Output), + % Cleanup: Close the Datalog file + close(Output) + ), + % Cleanup: Close the METTA file + close(Input) + ), + % Ensure the generated Datalog file is at least 50% the size of the METTA file + size_file(Filename, MettaSize), + size_file(DatalogFile, DatalogSize), + ( + DatalogSize >= 0.5 * MettaSize + -> true % If the size condition is met, succeed + ; delete_file(DatalogFile), fail % If not, delete the Datalog file and fail + ), + !. % Prevent backtracking + +% atom_subst(+Source, +Replacements, -Result) +% Replacements is a list of Search-Replace pairs. +atom_subst(Source, Replacements, Result) :- + foldl(replace_in_symbol, Replacements, Source, Result). + +% replace_in_symbol(+Search-Replace, +CurrentSource, -NewSource) +% Helper predicate to apply a single search-replace operation. +replace_in_symbol(Search-Replace, CurrentSource, NewSource) :- + symbolic_list_concat(Split, Search, CurrentSource), + symbolic_list_concat(Split, Replace, NewSource). + + +% filename_to_mangled_pred(+Filename, -MangleP) +filename_to_mangled_pred(Filename, MangleP) :- + get_time(Time), + symbolic_list_concat(['data', Filename, Time], '_', GS), + Replacements = [ '.metta_'- '_', + '_1710'-'_', + '/'- '_', + '/'- '_', '.'- '_', '-'- '_', '__'- '_'], + atom_subst(GS, Replacements, IntermediateResult), + trim_to_last_nchars(24, IntermediateResult, MangleP). + + +% trim_to_last_32(+Atom, -TrimmedAtom) +% Trims the given Atom to its last 32 characters, producing TrimmedAtom. +trim_to_last_nchars(Len, Atom, TrimmedAtom) :- + atom_length(Atom, Length), + ( Length =< Len + -> TrimmedAtom = Atom % Atom is shorter than or exactly 32 characters, no trimming needed + ; Before is Length - 32, + sub_atom(Atom, Before, 32, _, TrimmedAtom) + ). + + +translate_metta_file_to_datalog_io(Filename,Input,Output):- + must_det_ll(( + %write header + write(Output,'/* '),write(Output,Filename),writeln(Output,' */'), + % write the translation time and date + get_time(Time),stamp_date_time(Time,Date,'UTC'), + format_time(string(DateStr),'%FT%T%z',Date), + write(Output,'/* '),write(Output,DateStr),writeln(Output,' */'), + % make the predicate dynamic/multifile + filename_to_mangled_pred(Filename,MangleP2), + mangle_iz(MangleP2,MangleIZ), + + format(Output,':- style_check(-discontiguous). ~n',[]), + format(Output,':- dynamic((~q)/2). ~n',[MangleP2]), + format(Output,':- dynamic((~q)/3). ~n',[MangleP2]), + format(Output,':- dynamic((~q)/4). ~n',[MangleP2]), + format(Output,':- dynamic((~q)/5). ~n',[MangleP2]), + format(Output,':- dynamic((~q)/6). ~n',[MangleP2]), + format(Output,':- dynamic((~q)/7). ~n',[MangleP2]), + + format(Output,':- dynamic((~q)/4). ~n',[MangleIZ]), + format(Output,':- dynamic((~q)/5). ~n',[MangleIZ]), + format(Output,':- dynamic((~q)/6). ~n',[MangleIZ]), + format(Output,':- dynamic((~q)/7). ~n',[MangleIZ]), + format(Output,':- dynamic((~q)/8). ~n',[MangleIZ]), + writeln(Output,':- dynamic(user:asserted_metta_pred/2).'), + writeln(Output,':- multifile(user:asserted_metta_pred/2).'), + format(Output,'user:asserted_metta_pred(~q,~q). ~n',[MangleP2,Filename]), + with_output_to(Output,produce_iz(MangleP2)), + %format(Output,':- user:register_asserted_metta_pred(~q,~q). ~n',[MangleP2,Filename]), + flag(translated_forms,_,0), + LastTime = t(Time), + % translate the file + once(call(( + repeat, + (at_end_of_stream(Input)->!; + ( must_det_ll(( + line_count(Input,Lineno), + read_sform(Input,Term))), + (Term==end_of_file->!; + (once((( + % if_t((0 is (Lineno mod 10000)),writeln(Term:Lineno)), + /*non_compat_io*/( + if_t(( + get_time(NTime),arg(1,LastTime,Last), + Elapsed is (NTime-Last), Elapsed > 4), + (nb_setarg(1,LastTime,NTime), + move_cursor_to_first_column, + format(user_error,'; ~@ ; line: ~w ',[write_src_woi(Term),Lineno]), + write(user_error,'\033[K'), + move_cursor_to_first_column))), + flag(translated_forms,X,X+1), + write_metta_datalog_term(Output,Term,MangleP2,Lineno))))),fail)))))), + flush_output(Output), + % teell the user we are done + flag(translated_forms,TF,TF), + format(user_error,'~N; Done translating ~w forms: ~q.', + [TF,asserted_metta_pred(MangleP2,Filename)]))). + +write_src_woi(Term):- with_indents(false,write_src(Term)). + +% write comments +write_metta_datalog_term(Output,'$COMMENT'(Term,_,_),_MangleP2,_Lineno):- + format(Output,"/* ~w */~n",[Term]). +% write executed terms +write_metta_datalog_term(Output,exec(Term),MangleP2,Lineno):- + format(Output,":-eval_Line(~q,~q,~q).~n",[Term,MangleP2,Lineno]). +% write asserted terms +write_metta_datalog_term(Output,STerm,MangleP2,Lineno):- + s2t_iz(MangleP2,P,STerm,Term), + relistify(Term,TermL), + Data =..[P,Lineno|TermL], + format(Output,"~q.~n",[Data]). + +relistify(Term,TermL):- is_list(Term),!,TermL=Term. +relistify([H|T],TermL):- flatten([H|T],TermL),!. +relistify(Term,[Term]). + +eval_Line(A,B,C):- format('~N'), + write_src(eval_Line(A,B,C)),nl. + +translate_metta_datalog(Input,Output):- translate_metta_datalog('',Input,Output),!. + +translate_metta_datalog(_,Input,_):- at_end_of_stream(Input),!. +translate_metta_datalog(Ch,Input,Output):- peek_char(Input,Char), + translate_metta_datalog(Ch,Input,Output,Char). + +translate_metta_datalog(_,Input,Output,')'):- !, get_char(Input,_), + writeq(Output,']'),translate_metta_datalog(',',Input,Output). +translate_metta_datalog(Ch,Input,Output,'('):- !,get_char(Input,_), + write(Output,Ch),writeq(Output,'['),translate_metta_datalog('',Input,Output). +translate_metta_datalog(Ch,Input,Output,Space):-char_type(Space,space),!, + get_char(Input,Char), write(Output,Char),translate_metta_datalog(Ch,Input,Output). +translate_metta_datalog(Ch,Input,Output,';'):-!,read_line_to_string(Input, Comment), + format(Output, '/* ~w */',[Comment]),translate_metta_datalog(Ch,Input,Output). +translate_metta_datalog(Ch,Input,Output,'"'):-!,read_term(Input,Term,[]), + write(Output,Ch),writeq(Output,Term),translate_metta_datalog(',',Input,Output). +translate_metta_datalog(Ch,Input,Output,'`'):-!,read_term(Input,Term,[]), + write(Output,Ch),writeq(Output,Term),translate_metta_datalog(',',Input,Output). +translate_metta_datalog(Ch,Input,Output,'\''):-!,read_term(Input,Term,[]), + write(Output,Ch),writeq(Output,Term),translate_metta_datalog(',',Input,Output). +translate_metta_datalog(Ch,Input,Output,'$'):-!, + read_chars_until([type(space),')'],Input,Codes),name(Term,Codes), + write(Output,Ch),writeq(Output,Term),translate_metta_datalog(',',Input,Output). +translate_metta_datalog(Ch,Input,Output,Peek):-!, + read_chars_until([type(space),')'],Peek,Input,Codes),name(Term,Codes), + write(Output,Ch),writeq(Output,Term),translate_metta_datalog(',',Input,Output). + +read_chars_until(_StopsBefore,Input,[]):- at_end_of_stream(Input),!. +read_chars_until(StopsBefore,Input,Codes):- peek_char(Input,Char), + read_chars_until(StopsBefore, Char, Input, Codes). + +stops_before([type(Type)|StopsBefore],Char):- char_type(Char,Type); stops_before(StopsBefore,Char). +stops_before([Ch|StopsBefore],Char):- Ch==Char; stops_before(StopsBefore,Char). + +read_chars_until(StopsBefore,Char,_, []):- stops_before(StopsBefore,Char),!. +read_chars_until(StopsBefore, '\\', Input, [Code|Codes]):- get_char(Input,Code), + read_chars_until(StopsBefore, Input, Codes). +read_chars_until(StopsBefore, Char, Input, [Char|Codes]):- get_char(Input,_), + read_chars_until(StopsBefore, Input, Codes). + + just_load_datalog:-!, fail. +convert_datalog_to_loadable(DatalogFile,DatalogFile):-just_load_datalog,!. +convert_datalog_to_loadable(DatalogFile,QlfFile):- + sformat(S,'swipl -g "qcompile(~q)" -t halt',[DatalogFile]), + shell(S,_), + file_name_extension(Base, _, DatalogFile), + file_name_extension(Base,'qlf',QlfFile). + +convert_metta_to_loadable(Filename,QlfFile):- + must_det_ll(( + convert_metta_to_datalog(Filename,DatalogFile), + convert_datalog_to_loadable(DatalogFile,QlfFile))),!. + +convert_metta_to_loadable(Filename,_):- + metta_dir(Dir), + sformat(S,'~w/cheap_convert.sh --verbose=1 ~w',[Dir,Filename]), + shell(S,Ret),!,Ret==0. + +accept_line(_Self,end_of_file):-!. +accept_line(Self,I):- normalize_space(string(Str),I),!,accept_line2(Self,Str),!. + +accept_line2(_Self,S):- string_concat(";",_,S),!,writeln(S). +accept_line2(Self,S):- string_concat('(',RS,S),string_concat(M,')',RS),!, + symbolic_list_concat([F|LL],' ',M),PL =..[F,Self|LL],pfcAdd_Now(PL),!,flag(next_assert,X,X+1), + if_t((0 is X mod 10_000_000),(writeln(X=PL),statistics)). +accept_line2(Self,S):- fbug(accept_line2(Self,S)),!. + + +load_metta_file_stream(Filename,Self,In):- + if_t((atomic(Filename),exists_file(Filename)), size_file(Filename, Size)), + if_t(var(Size),is_file_stream_and_size(In, Size)), + %once((is_file_stream_and_size(In, Size),Size>102400) -> P2 = read_sform2 ; + P2 = read_metta2, %) + with_option(loading_file,Filename, + %current_exec_file(Filename), + must_det_ll((must_det_ll(( + set_exec_num(Filename,1), + load_answer_file(Filename), + set_exec_num(Filename,0))), + load_metta_file_stream_fast(Size,P2,Filename,Self,In)))). + +% use_fast_buffer makes tmp .buffer files that get around long load times +use_fast_buffer:- nb_current(may_use_fast_buffer,t). + +:- dynamic(metta_file_buffer/5). +:- multifile(metta_file_buffer/5). + + +load_metta_file_stream_fast(_Size,_P2,Filename,Self,S):- fail, + symbolic_list_concat([_,_,_|_],'.',Filename), + \+ option_value(html,true), + atomic(S),is_stream(S),stream_property(S,input),!, + repeat, + read_line_to_string(S,I), + accept_line(Self,I), + I==end_of_file,!. + +load_metta_file_stream_fast(_Size, _P2, Filename, Self, _In) :- + use_fast_buffer, + symbol_concat(Filename, '.buffer~', BufferFile), + exists_file(BufferFile), + time_file(Filename, FileTime), + time_file(BufferFile, BufferFileTime), + ( (BufferFileTime > FileTime) + -> (fbugio(using(BufferFile)),ensure_loaded(BufferFile), !, load_metta_buffer(Self, Filename)) + ; (fbugio(deleting(BufferFile)),delete_file(BufferFile), fail) + ). + +load_metta_file_stream_fast(_Size,P2,Filename,Self,In):- + if_t(use_fast_buffer, + ((symbol_concat(Filename, '.buffer~', BufferFile), + fbugio(creating(BufferFile)), + write_bf(BufferFile, ( :- dynamic(metta_file_buffer/5))), + write_bf(BufferFile, ( :- multifile(metta_file_buffer/5)))))), + repeat, + my_line_count(In, LineCount), + current_read_mode(file,Mode), + must_det_ll(call(P2, In,Expr)), %write_src(read_metta=Expr),nl, + subst_vars(Expr, Term, [], NamedVarsList), + BufferTerm = metta_file_buffer(Mode,Term,NamedVarsList,Filename,LineCount), + assertz(BufferTerm), + if_t(use_fast_buffer,write_bf(BufferFile,BufferTerm)), + + flush_output, + at_end_of_stream(In),!, + %listing(metta_file_buffer/5), + load_metta_buffer(Self,Filename). + +write_bf(BufferFile,BufferTerm):- + setup_call_cleanup(open(BufferFile,append,Out), + format(Out,'~q.~n',[BufferTerm]), + close(Out)). + + +my_line_count(In, seek($,0,current,CC)):- + stream_property(In,reposition(true)), + seek(In,0,current,CC),fail. +my_line_count(In,position(Pos)):- + stream_property(In,position(Pos)). + + +load_metta_buffer(Self,Filename):- + set_exec_num(Filename,1), + load_answer_file(Filename), + set_exec_num(Filename,0), + pfcAdd_Now(user:loaded_into_kb(Self,Filename)), + forall(metta_file_buffer(Mode,Expr,NamedVarsList,Filename,_LineCount), + (maplist(maybe_assign,NamedVarsList), + must_det_ll((((do_metta(file(Filename),Mode,Self,Expr,_O))) + ->true + ; (trace,pp_m(unknown_do_metta(file(Filename),Mode,Self,Expr))))))). + + + +%read_metta(In,Expr):- current_input(CI), \+ is_same_streams(CI,In), !, read_sform(In,Expr). +read_metta(_,O):- clause(t_l:s_reader_info(O),_,Ref),erase(Ref). +read_metta(I,O):- string(I),normalize_space(string(M),I),!,parse_sexpr_metta1(M,O),!. +read_metta(In,Expr):- current_input(In0),In==In0,!, repl_read(Expr). +read_metta(In,Expr):- read_metta1(In,Expr). + +read_metta1(In,Expr):- is_file_stream_and_size(In, Size) , Size>10240,!,read_sform1([],In,Expr). +read_metta1(In,Expr):- read_metta2(In,Expr). + +read_metta2(_,O):- clause(t_l:s_reader_info(O),_,Ref),erase(Ref). +read_metta2(In,Expr):- peek_char(In,Char), read_metta2(In,Char,Expr). +read_metta2(In,Char,Expr):- char_type(Char,space),get_char(In,Char),not_compatio(put(Char)),!,read_metta2(In,Expr). +%read_metta2(In,'"',Expr):- read_sform2(In,Expr),!. +%read_metta2(In,'\'',Expr):- read_sform2(In,Expr),!. +read_metta2(In,'!',Expr):- get_char(In,_), !, read_metta2(In,Read1),!,Expr=exec(Read1). +read_metta2(In,';',Expr):- get_char(In,_), !, (maybe_read_pl(In,Expr)-> true ; + (read_line_to_string(In,Str),Expr='$COMMENT'(Str,0,0))). +% write_comment(Str),!,read_metta2(In,Expr))),!. +% read_metta2(In,_,Expr):- maybe_read_pl(In,Expr),!. +read_metta2(In,_,Read1):- parse_sexpr_metta(In,Expr),!,must_det_ll(Expr=Read1). + + +% Predicate to check if a stream is a file stream and get its size. +is_file_stream_and_size(Stream, Size) :- + % Check if the stream is associated with a file. + stream_property(Stream, file_name(FileName)), + % Check if the file is accessible and get its size. + exists_file(FileName), + size_file(FileName, Size). + + +maybe_read_pl(In,Expr):- + peek_line(In,Line1), Line1\=='', atom_contains(Line1, '.'),atom_contains(Line1, ':-'), + notrace(((catch_err((read_term_from_atom(Line1, Term, []), Term\==end_of_file, Expr=call(Term)),_, fail),!, + read_term(In, Term, [])))). + + +% Define the peek_line predicate. +% It uses a temporary string buffer to peek at the current line. +peek_line(Line) :- + current_input(Stream), + peek_line(Stream, Line). + +% Helper predicate to peek the line from a specific stream. +peek_line(Stream, Line) :- + % Remember the current stream position. + stream_property(Stream, position(Pos)), + % Read the next line. + read_line_to_string(Stream, Line), + % Set the stream back to the remembered position. + set_stream_position(Stream, Pos). + + + +maybe_read_sform_line(Stream, P2, Form) :- fail, + % Check if the stream is repositionable + % Get the current position in the stream + stream_property(Stream, position(Pos)), + % Read a line from the stream + read_line_to_string(Stream, Line), + maybe_read_sform_line_pos(Stream, Line, Pos, P2, Form). + + +maybe_read_sform_line_pos(Stream, Line, _Pos, P2, Form):- normalize_space(string(M),Line),M="",!, + maybe_read_sform_line(Stream, P2, Form). + +maybe_read_sform_line_pos(Stream, Line, Pos, P2, Form):- + % Call P2 with the line. If P2 fails, reset the stream position + ( call(P2,Line,Form) + -> true % If P2 succeeds, do nothing more + ; set_stream_position(Stream, Pos), fail % If P2 fails, reset position and fail + ). + + + +%read_line_to_sexpr(Stream,UnTyped), +read_sform(Str,F):- string(Str),open_string(Str,S),!,read_sform(S,F). +read_sform(S,F):- + read_sform1([],S,F1), + ( F1\=='!' -> F=F1 ; + (read_sform1([],S,F2), F = exec(F2))). + + +%read_sform2(S,F1):- !, read_metta2(S,F1). +read_sform2(S,F1):- read_sform1([],S,F1). + +read_sform1(_,_,O):- clause(t_l:s_reader_info(O),_,Ref),erase(Ref). +read_sform1( AltEnd,Str,F):- string(Str),open_string(Str,S),!,read_sform1( AltEnd,S,F). +read_sform1(_AltEnd,S,F):- at_end_of_stream(S),!,F=end_of_file. +read_sform1( AltEnd,S,M):- get_char(S,C),read_sform3(s, AltEnd,C,S,F), + untyped_to_metta(F,M). +%read_sform1( AltEnd,S,F):- profile(parse_sexpr_metta(S,F)). + +read_sform3(_AoS,_AltEnd,C,_,F):- C == end_of_file,!,F=end_of_file. +read_sform3( s, AltEnd,C,S,F):- char_type(C,space),!,read_sform1( AltEnd,S,F). +%read_sform3(AoS,_AltEnd,';',S,'$COMMENT'(F,0,0)):- !, read_line_to_string(S,F). +read_sform3( s, AltEnd,';',S,F):- read_line_to_string(S,_),!,read_sform1( AltEnd,S,F). +read_sform3( s, AltEnd,'!',S,exec(F)):- !,read_sform1( AltEnd,S,F). + +read_sform3(s,_AltEnd,_,S,F1):- maybe_read_sform_line(S, parse_sexpr_metta1, F1),!. + +read_sform3(_AoS,_AltEnd,'"',S,Text):- !,must_det_ll(atom_until(S,[],'"',Text)). +read_sform3(_AoS,_AltEnd,'`',S,Text):- !,atom_until(S,[],'`',Text). +read_sform3(_AoS,_AltEnd,'\'',S,Text):- fail, !,atom_until(S,[],'\'',Text). +read_sform3(_AoS,_AltEnd,',',_,','):- fail, !. +read_sform3( s , AltEnd,C,S,F):- read_sform4( AltEnd,C,S,F),!. +read_sform3(_AoS, AltEnd,P,S,Sym):- peek_char(S,Peek),!,read_symbol_or_number( AltEnd,Peek,S,[P],Expr),into_symbol_or_number(Expr,Sym). + +into_symbol_or_number(Expr,Sym):- atom_number(Expr,Sym),!. +into_symbol_or_number(Sym,Sym). + +read_sform4(_AltEnd,B,S,Out):- read_sform5(s,B,S,List,E), c_list(E,List,Out). +c_list(')',List,List). c_list('}',List,['{...}',List]). c_list(']',List,['[...]',List]). + + +read_sform5(AoS,'(',S,List,')'):- !,collect_list_until(AoS,S,')',List),!. +read_sform5(AoS,'{',S,List,'}'):- !,collect_list_until(AoS,S,'}',List),!. +read_sform5(AoS,'[',S,List,']'):- !,collect_list_until(AoS,S,']',List),!. + + +read_symbol_or_number( AltEnd,Peek,S,SoFar,Expr):- SoFar\==[], Peek=='\\', !, + get_char(S,_),get_char(S,C),append(SoFar,[C],NSoFar), + peek_char(S,NPeek), read_symbol_or_number(AltEnd,NPeek,S,NSoFar,Expr). + +read_symbol_or_number(_AltEnd,Peek,_S,SoFar,Expr):- Peek==end_of_file,!, + must_det_ll(( symbolic_list_concat(SoFar,Expr))). + + + + +read_symbol_or_number(_AltEnd,Peek,_S,SoFar,Expr):- char_type(Peek,space),!, + must_det_ll(( symbolic_list_concat(SoFar,Expr))). + +read_symbol_or_number( AltEnd,Peek,_S,SoFar,Expr):- member(Peek,AltEnd),!, + must_det_ll(( do_symbolic_list_concat(Peek,SoFar,Expr))). +read_symbol_or_number(AltEnd,B,S,SoFar,Expr):- fail,read_sform5(AltEnd,B,S,List,E), + flatten([List,E],F), append(SoFar,F,NSoFar),!, + peek_char(S,NPeek), read_symbol_or_number(AltEnd,NPeek,S,NSoFar,Expr). +read_symbol_or_number( AltEnd,_Peek,S,SoFar,Expr):- get_char(S,C),append(SoFar,[C],NSoFar), + peek_char(S,NPeek), read_symbol_or_number(AltEnd,NPeek,S,NSoFar,Expr). + +atom_until(S,SoFar,End,Text):- get_char(S,C),atom_until(S,SoFar,C,End,Text). +atom_until(_,SoFar,C,End,Expr):- C ==End,!,must_det_ll((do_symbolic_list_concat(End,SoFar,Expr))). +atom_until(S,SoFar,'\\',End,Expr):-get_char(S,C),!,atom_until2(S,SoFar,C,End,Expr). +atom_until(S,SoFar,C,End,Expr):- atom_until2(S,SoFar,C,End,Expr). +atom_until2(S,SoFar,C,End,Expr):- append(SoFar,[C],NSoFar),get_char(S,NC), + atom_until(S,NSoFar,NC,End,Expr). + +do_symbolic_list_concat('"',SoFar,Expr):- \+ string_to_syms,!, atomics_to_string(SoFar,Expr),!. +do_symbolic_list_concat(_End,SoFar,Expr):- symbolic_list_concat(SoFar,Expr). + +collect_list_until(AoS,S,End,List):- get_char(S,C), cont_list(AoS,C,End,S,List). + +cont_list(_AoS,End,_End1,_,[]):- End==end_of_file, !. +cont_list(_AoS,End,End1,_,[]):- End==End1, !. +cont_list( AoS,C,End,S,[F|List]):- read_sform3(AoS,[End],C,S,F),!,collect_list_until(AoS,S,End,List). + + + +in2_stream(N1,S1):- integer(N1),!,stream_property(S1,file_no(N1)),!. +in2_stream(N1,S1):- atom(N1),stream_property(S1,alias(N1)),!. +in2_stream(N1,S1):- is_stream(N1),S1=N1,!. +in2_stream(N1,S1):- atom(N1),stream_property(S1,file_name(N1)),!. +is_same_streams(N1,N2):- in2_stream(N1,S1),in2_stream(N2,S2),!,S1==S2. + + + +parse_sexpr_metta(I,O):- (\+ atomic(I) ; \+ is_stream(I)),!,text_to_string(I,S),!,parse_sexpr_metta1(S,O),!. +parse_sexpr_metta(S,F1):- fail, %line_count(S, LineNumber), + maybe_read_sform_line(S, parse_sexpr_metta1, F1),!. +parse_sexpr_metta(S,F1):- parse_sexpr_metta_IO(S,F1),!. + +parse_sexpr_metta_IO(S,F1):- at_end_of_stream(S),!,F1=end_of_file. +parse_sexpr_metta_IO(S,F1):- peek_char(S,Char),char_type(Char,space),!, + get_char(S,Char), parse_sexpr_metta_IO(S,F1). +parse_sexpr_metta_IO(S,F1):- + %line_count(S, LineNumber), + % Get the character position within the current line + %line_position(S, LinePos), + nop((character_count(S, Offset),move_cursor_to_first_column, + write(user_error,'File Offset: '),write(user_error,Offset))), + parse_sexpr_untyped(S, M),!, + nop((write(user_error,'.'),!,move_cursor_to_first_column)), + trly(untyped_to_metta,M,F1), + nop(writeqln(user_error,F1)),!. + +move_cursor_to_first_column:- write(user_error,'\033[1G'). +move_cursor_to_first_column_out:- write(user_output,'\033[1G'). + +parse_sexpr_metta1(I,O):- normalize_space(string(M),I),!,parse_sexpr_metta2(M,U),!, + trly(untyped_to_metta,U,O). +parse_sexpr_metta2(M,exec(O)):- string_concat('!',I,M),!,parse_sexpr_metta2(I,O). +parse_sexpr_metta2(M,(O)):- string_concat('+',I,M),!,parse_sexpr_metta2(I,O). +parse_sexpr_metta2(I,U):- parse_sexpr_untyped(I,U),!,writeqln(user_error,U). + +test_parse_sexpr_metta1:- + ignore((parse_sexpr_metta1( +"(: synonyms-gene-ENSG00000085491 (synonyms (gene ENSG00000085491) (ATP-Mg/P\\(i\\)_co-transporter_1 calcium-binding_mitochondrial_carrier_protein_SCaMC-1 HGNC:20662 mitochondrial_ATP-Mg/Pi_carrier_protein_1 small_calcium-binding_mitochondrial_carrier_protein_1 mitochondrial_Ca\\(2+\\)-dependent_solute_carrier_protein_1 mitochondrial_adenyl_nucleotide_antiporter_SLC25A24 solute_carrier_family_25_member_24 calcium-binding_transporter APC1 short_calcium-binding_mitochondrial_carrier_1 solute_carrier_family_25_\\(mitochondrial_carrier;_phosphate_carrier\\),_member_24 SCAMC1 SLC25A24 short_calcium-binding_mitochondrial_carrier_protein_1 SCAMC-1)))",O), + writeq(parse_sexpr_metta1(O)))),break. + +writeqln(W,Q):- nop(format(W,'; ~q~n',[Q])). + +write_comment(_):- is_compatio,!. +write_comment(_):- silent_loading,!. +write_comment(Cmt):- connlf,format(';;~w~n',[Cmt]). +do_metta_cmt(_,'$COMMENT'(Cmt,_,_)):- write_comment(Cmt),!. +do_metta_cmt(_,'$STRING'(Cmt)):- write_comment(Cmt),!. +do_metta_cmt(Self,[Cmt]):- !, do_metta_cmt(Self, Cmt),!. + +metta_atom_in_file(Self,Term):- metta_atom_in_file(Self,Term,_,_). +metta_atom_in_file(Self,STerm,Filename,Lineno):- + user:loaded_into_kb(Self,Filename), + once(user:asserted_metta_pred(Mangle,Filename)), + %s2t_iz(Mangle,P,CTerm,Term), + %CTerm=Term,Mangle=P, + current_predicate(Mangle/Arity), + notrace((length(STerm,Arity), + term_variables(STerm,SVs), + copy_term(STerm+SVs,CTerm+CVs), + Data =..[Mangle,Lineno|CTerm])), + %write_src_woi(Data), + call(Data), + maplist(mapvar,CVs,SVs). + +%mapvar(CV,SV):- var(CV),!,SV=CV. +mapvar(CV,SV):- t2s(CV,CCV),!,SV=CCV. + +%constrain_sterm(STerm):- var(STerm),!,between(1,5,Len),length(STerm,Len). +%constrain_sterm(STerm):- is_list(STerm),!. +constrain_sterm(NV):- nonvar(NV),!. +constrain_sterm([_,_,_]). +constrain_sterm([_,_,_,_]). +constrain_sterm([_,_,_,_,_]). +constrain_sterm([_,_]). + +s2t_iz(Mangle,Iz,[Colon,Name,Info],[Name|InfoL]):- Colon == ':', + is_list(Info), mangle_iz(Mangle,Iz), + maplist(s2t,Info,InfoL). +s2t_iz(Mangle,Mangle,Info,InfoL):- s2tl(Info,InfoL). + +mangle_iz(Mangle,Iz):- symbol_concat(Mangle,'_iz',Iz). + +produce_iz(Mangle):- + mangle_iz(Mangle,Iz), + forall(between(1,5,Len), + once((length(Args,Len), + produce_iz_hb([Mangle,Lineno,[:,Name,[Pred|Args]]],[Iz,Lineno,Name,Pred|Args])))). + +produce_iz_hb(HList,BList):- + H=..HList,B=..BList, HB=(H:-B), + numbervars(HB,0,_), + writeq(HB),writeln('.'). + +t2s(SList,List):- \+ compound(SList),!,SList=List. +t2s([H|SList],[HH|List]):- !, t2s(H,HH),!,t2s(SList,List). +t2s(X,XX):- compound(X),compound_name_arguments(X,t,Args),!, + maplist(t2s,Args,XX). +t2s(X,X):-!. + +s2tl(SList,List):- \+ compound(SList),!,SList=List. +s2tl([H|SList],[HH|List]):- !, s2t(H,HH),!,s2tl(SList,List). +s2tl(List,List). +%s2tl(SList,List):- is_list(SList), maplist(s2t,SList,List),!. + +s2t(SList,List):- \+ compound(SList), !, SList=List. +s2t([A|SList],Term):- A == '->',!, s2tl(SList,List), Term =.. [A,List]. +s2t([A|SList],Term):- A == 'Cons',!,s2tl(SList,List), Term =.. [A|List]. +s2t([A|SList],Term):- A == '=',!, s2tl(SList,List), Term =.. [A|List]. +s2t(List,Term):- is_list(List),!,maplist(s2t,List,TermList), + compound_name_arguments(Term,t,TermList),!. +s2t(STerm,Term):- s2tl(STerm,Term),!. + +mlog_sym('@'). + +%untyped_to_metta(I,exec(O)):- compound(I),I=exec(M),!,untyped_to_metta(M,O). +untyped_to_metta(I,O):- + must_det_ll(( + trly(mfix_vars1,I,M), + trly(cons_to_c,M,OM), + trly(cons_to_l,OM,O))). + + +trly(P2,A,B):- once(call(P2,A,M)),A\=@=M,!,trly(P2,M,B). +trly(_,A,A). + +mfix_vars1(I,O):- var(I),!,I=O. +mfix_vars1('$_','$VAR'('_')). +mfix_vars1('$','$VAR'('__')). +mfix_vars1(I,'$VAR'(O)):- atom(I),symbol_concat('$',N,I),symbol_concat('_',N,O). +%mfix_vars1('$t','$VAR'('T')):-!. +%mfix_vars1('$T','$VAR'('T')):-!. +%mfix_vars1(I,O):- I=='T',!,O='True'. +%mfix_vars1(I,O):- I=='F',!,O='False'. +%mfix_vars1(I,O):- is_i_nil(I),!,O=[]. +mfix_vars1(I,O):- I=='true',!,O='True'. +mfix_vars1(I,O):- I=='false',!,O='False'. +mfix_vars1('$STRING'(I),O):- I=O,!. +mfix_vars1('$STRING'(I),O):- \+ string_to_syms, mfix_vars1(I,OO),text_to_string(OO,O),!. +%mfix_vars1('$STRING'(I),O):- \+ string_to_syms, text_to_string(I,O),!. +mfix_vars1('$STRING'(I),O):- !, mfix_vars1(I,M),atom_chars(O,M),!. +%mfix_vars1('$STRING'(I),O):- !, mfix_vars1(I,M),name(O,M),!. +mfix_vars1([H|T],O):- H=='[', is_list(T), last(T,L),L==']',append(List,[L],T), !, O = ['[...]',List]. +mfix_vars1([H|T],O):- H=='{', is_list(T), last(T,L),L=='}',append(List,[L],T), !, O = ['{...}',List]. +mfix_vars1([H|T],O):- is_list(T), last(T,L),L=='}',append(List,[L],T), + append(Left,['{'|R],List),append([H|Left],[['{}',R]],NewList),mfix_vars1(NewList,O). +mfix_vars1('$OBJ'(claz_bracket_vector,List),O):- is_list(List),!, O = ['[...]',List]. +mfix_vars1(I,O):- I = ['[', X, ']'], nonvar(X), !, O = ['[...]',X]. +mfix_vars1(I,O):- I = ['{', X, '}'], nonvar(X), !, O = ['{...}',X]. +mfix_vars1('$OBJ'(claz_bracket_vector,List),Res):- is_list(List),!, append(['['|List],[']'],Res),!. +mfix_vars1(I,O):- I==[Quote, S], Quote==quote,S==s,!, O=is. +mfix_vars1([K,H|T],Cmpd):- fail, + atom(K),mlog_sym(K),is_list(T), + mfix_vars1([H|T],[HH|TT]),atom(HH),is_list(TT),!, + compound_name_arguments(Cmpd,HH,TT). +%mfix_vars1([H|T],[HH|TT]):- !, mfix_vars1(H,HH),mfix_vars1(T,TT). +mfix_vars1(List,ListO):- is_list(List),!,maplist(mfix_vars1,List,ListO). +mfix_vars1(I,O):- string(I),string_to_syms,!,atom_string(O,I). + +mfix_vars1(I,O):- compound(I),!,compound_name_arguments(I,F,II),F\=='$VAR',maplist(mfix_vars1,II,OO),!,compound_name_arguments(O,F,OO). +mfix_vars1(I,O):- \+ symbol(I),!,I=O. +mfix_vars1(I,I). + +no_cons_reduce. +svar_fixvarname_dont_capitalize(O,O):-!. +svar_fixvarname_dont_capitalize(M,O):- svar_fixvarname(M,O),!. + + +%dvar_name(t,'T'):- !. +dvar_name(N,O):- symbol_concat('_',_,N),!,O=N. +dvar_name(N,O):- integer(N),symbol_concat('_',N,O). +dvar_name(N,O):- atom(N),atom_number(N,Num),dvar_name(Num,O),!. +dvar_name(N,O):- \+ symbol(N),!,format(atom(A),'~w',[N]),dvar_name(A,O). +dvar_name(N,O):- !, format(atom(A),'_~w',[N]),dvar_name(A,O). +%dvar_name( '',''):-!. % "$" +%dvar_name('_','__'):-!. % "$_" +dvar_name(N,O):- symbol_concat('_',_,N),!,symbol_concat('_',N,O). +dvar_name(N,O):- svar_fixvarname_dont_capitalize(N,O),!. +dvar_name(N,O):- must_det_ll((atom_chars(N,Lst),maplist(c2vn,Lst,NList),symbolic_list_concat(NList,S),svar_fixvarname_dont_capitalize(S,O))),!. +c2vn(A,A):- char_type(A,prolog_identifier_continue),!. +c2vn(A,A):- char_type(A,prolog_var_start),!. +c2vn(A,AA):- char_code(A,C),symbolic_list_concat(['_C',C,'_'],AA). + +cons_to_l(I,I):- no_cons_reduce,!. +cons_to_l(I,O):- var(I),!,O=I. +cons_to_l(I,O):- is_i_nil(I),!,O=[]. +cons_to_l(I,O):- I=='nil',!,O=[]. +cons_to_l(C,O):- \+ compound(C),!,O=C. +cons_to_l([Cons,H,T|List],[HH|TT]):- List==[], atom(Cons),is_cons_f(Cons), t_is_ttable(T), cons_to_l(H,HH),!,cons_to_l(T,TT). +cons_to_l(List,ListO):- is_list(List),!,maplist(cons_to_l,List,ListO). +cons_to_l(I,I). + +cons_to_c(I,I):- no_cons_reduce,!. +cons_to_c(I,O):- var(I),!,O=I. +cons_to_c(I,O):- is_i_nil(I),!,O=[]. +cons_to_c(I,O):- I=='nil',!,O=[]. +cons_to_c(C,O):- \+ compound(C),!,O=C. +cons_to_c([Cons,H,T|List],[HH|TT]):- List==[], atom(Cons),is_cons_f(Cons), t_is_ttable(T), cons_to_c(H,HH),!,cons_to_c(T,TT). +cons_to_c(I,O):- \+ is_list(I), compound_name_arguments(I,F,II),maplist(cons_to_c,II,OO),!,compound_name_arguments(O,F,OO). +cons_to_c(I,I). + + + +t_is_ttable(T):- var(T),!. +t_is_ttable(T):- is_i_nil(T),!. +t_is_ttable(T):- is_ftVar(T),!. +t_is_ttable([F|Args]):- F=='Cons',!,is_list(Args). +t_is_ttable([_|Args]):- !, \+ is_list(Args). +t_is_ttable(_). + +is_cons_f(Cons):- is_cf_nil(Cons,_). +is_cf_nil('Cons','NNNil'). +%is_cf_nil('::','nil'). + +is_i_nil(I):- + is_cf_nil('Cons',Nil), I == Nil. + +subst_vars(TermWDV, NewTerm):- + subst_vars(TermWDV, NewTerm, NamedVarsList), + maybe_set_var_names(NamedVarsList). + +subst_vars(TermWDV, NewTerm, NamedVarsList) :- + subst_vars(TermWDV, NewTerm, [], NamedVarsList). + +subst_vars(Term, Term, NamedVarsList, NamedVarsList) :- var(Term), !. +subst_vars([], [], NamedVarsList, NamedVarsList):- !. +subst_vars([TermWDV|RestWDV], [Term|Rest], Acc, NamedVarsList) :- !, + subst_vars(TermWDV, Term, Acc, IntermediateNamedVarsList), + subst_vars(RestWDV, Rest, IntermediateNamedVarsList, NamedVarsList). +subst_vars('$VAR'('_'), _, NamedVarsList, NamedVarsList) :- !. +subst_vars('$VAR'(VName), Var, Acc, NamedVarsList) :- nonvar(VName), svar_fixvarname_dont_capitalize(VName,Name), !, + (memberchk(Name=Var, Acc) -> NamedVarsList = Acc ; ( !, Var = _, NamedVarsList = [Name=Var|Acc])). +subst_vars(Term, Var, Acc, NamedVarsList) :- atom(Term),symbol_concat('$',DName,Term), + dvar_name(DName,Name),!,subst_vars('$VAR'(Name), Var, Acc, NamedVarsList). + +subst_vars(TermWDV, NewTerm, Acc, NamedVarsList) :- + compound(TermWDV), !, + compound_name_arguments(TermWDV, Functor, ArgsWDV), + subst_vars(ArgsWDV, Args, Acc, NamedVarsList), + compound_name_arguments(NewTerm, Functor, Args). +subst_vars(Term, Term, NamedVarsList, NamedVarsList). + + +connlf:- check_silent_loading, not_compat_io((format('~N'))). +connl:- check_silent_loading,not_compat_io((nl)). +% check_silent_loading:- silent_loading,!,trace,break. +check_silent_loading. +silent_loading:- option_value('load','silent'), !. +silent_loading:- is_converting,!. +silent_loading:- option_value('html','True'), !,fail. +silent_loading:- option_value('trace-on-load','False'), !. + + + + +uncompound(OBO,Src):- \+ compound(OBO),!, Src = OBO. +uncompound('$VAR'(OBO),'$VAR'(OBO)):-!. +uncompound(IsList,Src):- is_list(IsList),!,maplist(uncompound,IsList,Src). +uncompound([Is|NotList],[SrcH|SrcT]):-!, uncompound(Is,SrcH),uncompound(NotList,SrcT). +uncompound(Compound,Src):- compound_name_arguments(Compound,Name,Args),maplist(uncompound,[Name|Args],Src). + +assert_to_metta(_):- reached_file_max,!. +assert_to_metta(OBO):- + must_det_ll((OBO=..[Fn|DataLL], + maplist(better_arg,DataLL,DataL), + into_datum(Fn, DataL, Data), + functor(Data,Fn,A),decl_fb_pred(Fn,A), + real_assert(Data),!, + incr_file_count(_))). + +assert_to_metta(OBO):- + ignore(( A>=2,A<700, + OBO=..[Fn|Cols], + must_det_ll(( + make_assertion4(Fn,Cols,Data,OldData), + functor(Data,FF,AA), + decl_fb_pred(FF,AA), + ((fail,call(Data))->true;( + must_det_ll(( + real_assert(Data), + incr_file_count(_), + ignore((((should_show_data(X), + ignore((fail,OldData\==Data,write('; oldData '),write_src(OldData),format(' ; ~w ~n',[X]))), + write_src(Data),format(' ; ~w ~n',[X]))))), + ignore(( + fail, option_value(output_stream,OutputStream), + is_stream(OutputStream), + should_show_data(X1),X1<1000,must_det_ll((display(OutputStream,Data),writeln(OutputStream,'.'))))))))))))),!. + +assert_MeTTa(OBO):- !, assert_to_metta(OBO). +%assert_MeTTa(OBO):- !, assert_to_metta(OBO),!,heartbeat. +/* +assert_MeTTa(Data):- !, heartbeat, functor(Data,F,A), A>=2, + decl_fb_pred(F,A), + incr_file_count(_), + ignore((((should_show_data(X), + write(newData(X)),write(=),write_src(Data))))), + assert(Data),!. +*/ + + +%:- dynamic((metta_type/3,metta_defn/3,get_metta_atom/2)). + + +:- dynamic(progress_bar_position/1). + +% Initialize the progress bar and remember its starting position +init_progress_bar(Width) :- + current_output(Stream), + stream_property(Stream, position(Pos)), + asserta(progress_bar_position(Pos)), + write('['), + forall(between(1, Width, _), write(' ')), + write(']'), + flush_output. + +% Check if the progress bar needs to be redrawn and update it accordingly +update_progress_bar(Current, Total, Width) :- + current_output(Stream), + % Get the current position + stream_property(Stream, position(CurrentPos)), + % Get the remembered position + progress_bar_position(SavedPos), + % Compare positions; if they differ, redraw the entire progress bar + ( SavedPos \= CurrentPos + -> redraw_progress_bar(Width) + ; true + ), + % Update the progress bar + Percentage is Current / Total, + Filled is round(Percentage * Width), + write('\r['), + forall(between(1, Filled, _), write('#')), + Remaining is Width - Filled, + forall(between(1, Remaining, _), write(' ')), + write(']'), + flush_output. + +% Redraw the progress bar if the position has changed +redraw_progress_bar(Width) :- + nl, + init_progress_bar(Width). + +% Adjusted example predicate for 1 million steps +progress_bar_example :- + TotalSteps = 1000000, % Adjust the total steps to 1 million + ProgressBarWidth = 30, + init_progress_bar(ProgressBarWidth), + between(1, TotalSteps, Step), + update_progress_bar(Step, TotalSteps, ProgressBarWidth), + % Simulate work + sleep(0.00001), % Adjust sleep time as needed for demonstration + fail. % Continue looping until between/3 fails +progress_bar_example. + +:- dynamic(using_corelib_file/0). + + +use_corelib_file:- using_corelib_file,!. +use_corelib_file:- asserta(using_corelib_file), fail. +use_corelib_file:- load_corelib_file, generate_interpreter_stubs. + +generate_interpreter_stubs:- + forall(metta_type('&corelib',Symb,Def), + gen_interp_stubs('&corelib',Symb,Def)). + +load_corelib_file:- is_metta_src_dir(Dir), really_use_corelib_file(Dir,'corelib.metta'),!. +load_corelib_file:- is_metta_src_dir(Dir), really_use_corelib_file(Dir,'stdlib_mettalog.metta'),!. +% !(import! &corelib "src/canary/stdlib_mettalog.metta") +really_use_corelib_file(Dir,File):- absolute_file_name(File,Filename,[relative_to(Dir)]), + locally(nb_setval(may_use_fast_buffer,t), + locally(nb_setval(suspend_answers,true), + with_output_to(string(_),include_metta_directory_file('&corelib',Dir,Filename)))). + diff --git a/.Attic/canary_docme/metta_mizer.pl b/.Attic/canary_docme/metta_mizer.pl new file mode 100644 index 00000000000..e08380327e3 --- /dev/null +++ b/.Attic/canary_docme/metta_mizer.pl @@ -0,0 +1,695 @@ +% Disables the optimizer +% Always evaluates to false, effectively a no-op. +disable_optimizer:- false. +% Base clause for disabling optimizer; never succeeds. +disable_optimizer. + +% Operator definitions for pattern matching +% Defines custom operator '=~' with precedence level 700. +:- op(700,xfx,'=~'). +% Defines custom operator '=~' with precedence level 690. +:- op(690,xfx, =~ ). + +%% assumed_true(+HB, +B2) is semidet. +% Verifies that certain conditions hold true, taking into account dynamic disabling of the optimizer. +% Arguments: +% - HB: Context or helper structure used in the optimization process. +% - B2: The condition to be verified. +% If the optimizer is disabled, or if B2 does not meet specific criteria, the predicate fails. +% Otherwise, it verifies the condition based on the structure of B2. +% +/* previous: % disables*/ +assumed_true(_,_):- disable_optimizer, !, fail. +% Fails if the second argument is unbound. +assumed_true(_ ,B2):- var(B2),!,fail. +% Recursively checks truth of embedded evaluations. +assumed_true(HB,eval_true(B2)):-!,assumed_true(HB,B2). +% Checks if B2 is explicitly the term 'is_True('True')'. +assumed_true(_ ,B2):- B2==is_True('True'). +% Checks if B2 is the string 'True'. +%assumed_true(_ ,A=B):- A==B,!. +assumed_true(_ ,B2):- B2=='True'. +% Checks if B2 is the boolean true. +assumed_true(_ ,B2):- B2== true,!. +% Evaluates to true if both A and B are equal and Atom is 'Atom'. +assumed_true(_ ,eval_for(b_5,Atom,A,B)):- 'Atom' == Atom, A=B. +% Evaluates to true if both A and B are equal and Atom is 'Any'. +assumed_true(_ ,eval_for(b_5,Atom,A,B)):- 'Any' == Atom, A=B. +%assumed_true(_ ,eval_for(b_1,Atom,A,B)):- 'Atom' == Atom, A=B. +% Fails if B2 is a user assignment with 'True'. +assumed_true(_ ,B2):- B2==u_assign('True', '$VAR'('_')),!. +% Recursively checks equality by evaluating X=Y. +assumed_true(HB,X==Y):- !, assumed_true(HB,X=Y). +%assumed_true( _,X=Y):- X==Y,!. +% Evaluates equality between X and Y if both are namespace variables and counts are appropriate. +assumed_true(HB,X=Y):- is_nsVar(X),is_nsVar(Y), + ( \+ (X\=Y)), + % Ensure X and Y are not explicitly different + (count_var_gte(HB,Y,2);count_var_gte(HB,X,2)), + % Ensure variable occurs enough times + X=Y,!. + +% Optimizes variable assignment with respect to unary functions. +% Fails immediately if optimizer is disabled. + optimize_u_assign_1(_,_):- disable_optimizer,!, fail. +% Fails if Var is a namespace variable. +optimize_u_assign_1(_,Var,_,_):- is_nsVar(Var),!,fail. +% Checks symbol arity and generates code if matching. +optimize_u_assign_1(_HB,[H|T],R,Code):- symbol(H),length([H|T],Arity), + predicate_arity(F,A),Arity==A, \+ (predicate_arity(F,A2),A2\=A), + append([H|T],[R],ArgsR),Code=..ArgsR,!. +% Optimizes non-compound terms. +optimize_u_assign_1(HB,Compound,R,Code):- \+ compound(Compound),!, optimize_u_assign(HB,Compound,R,Code). +% Continues optimization for lists. +optimize_u_assign_1(HB,[H|T],R,Code):- !, optimize_u_assign(HB,[H|T],R,Code). +% Handles the case of unbound compound and list in R. +optimize_u_assign_1(_ ,Compound,R,Code):- + is_list(R),var(Compound), + into_u_assign(R,Compound,Code),!. + +%optimize_u_assign_1(_,Compound,R,Code):- f2p(Compound,R,Code),!. +optimize_u_assign_1(_,Compound,R,Code):- + compound(Compound), + as_functor_args(Compound,F,N0), N is N0 +1, + (predicate_arity(F,N); functional_predicate_arg(F, N, N)), + append_term_or_call(Compound,R,Code). +% Translates MeTTa to optimized code. +optimize_u_assign_1(HB,Compound,R,Code):- p2s(Compound,MeTTa), optimize_u_assign(HB,MeTTa,R,Code). +%optimize_u_assign_1(_,[Pred| ArgsL], R, u_assign([Pred| ArgsL],R)). + + + +% disables +%append_term_or_call(F,R,call(F,R)):- disable_optimizer, !. +% Appends terms or calls to generate code. +% Appends terms for lists with symbol F. +append_term_or_call([F|Compound],R,Code):- symbol(F), + is_list(Compound),append(Compound,[R],CodeL), Code=..[F|CodeL],!. +% Handles symbols directly. +append_term_or_call(F,R,Code):- symbol(F),!, Code=..[F,R]. +% General append for term and result. +append_term_or_call(F,R,Code):- append_term(F,R,Code),!. +% Default case calls function with R. +append_term_or_call(F,R,call(F,R)). + + +%% optimize_unit1(+Input, +Output) is semidet. +% Performs optimization on the given `Input` and produces an optimized `Output`. +% This predicate applies various optimization strategies depending on the structure of `Input`. +% Arguments: +% - Input: The term or structure to be optimized. +% - Output: The result after applying optimization techniques. +% This predicate fails if the optimizer is disabled or if specific conditions are not met. +% + +% Optimization unit for specific true evaluations. +% Fails by default, preventing unintended evaluations. +optimize_unit11(_,_):- !, fail. +% Matches true directly for optimization. +optimize_unit11(True,true):-True==true,!. +/* +optimize_unit11(B1,true):- B1 = eval_for(b_1,NonEval, A, B), A=B, is_non_eval_kind(NonEval),!. +optimize_unit11(B1,true):- B1 = eval_for(b_5,NonEval, A, B), A=B, is_non_eval_kind(NonEval),!. + +optimize_unit11(B1,true):- B1 = eval_for(b_6,NonEval, A, B), A=B, is_non_eval_kind(NonEval),!. +*/ + + +% Handles specific structured evaluations. +optimize_unit11(eval_true([GM, Val, Eval]), call(GM, Val, Eval)):- + symbol(GM), \+ iz_conz(Val), \+ iz_conz(Eval), + GM = '==',!. + +optimize_unit11(eval_true([GM0, [GM, Eval], Val]), call(GM,Eval,Val)):- + GM0 = '==', + symbol(GM), predicate_arity(GM,2), \+ predicate_arity(GM,1), + nonvar(Val),var(Eval),!. +% Handles undefined evaluations that resolve to true. +optimize_unit11(I,true):- I=eval_for(_,'%Undefined%', A, C), \+ iz_conz(A),\+ iz_conz(C), A=C. + + +% disables +optimize_unit1(_,_):- disable_optimizer, !, fail. % Disable the optimizer, failing immediately. +optimize_unit1(Var,_):- var(Var),!,fail. % Fail if the first argument is unbound. +optimize_unit1(true,true):-!. % Succeed immediately if the first argument is `true`. + +optimize_unit1(I,O):- fail, \+ is_list(I), I\=(_,_), compound(I), + predicate_property(I,number_of_rule(1)),predicate_property(I,number_of_causes(1)), + clause(I,O), O\==true, O\=(_,_). + +% Optimize the case where `eval_for/4` checks for equality of `A` and `B`. +optimize_unit1(eval_for(b_6,'Atom', A,B), A=B):- \+ iz_conz(A),\+ iz_conz(B), \+ \+ (A=B). +% Optimize when `NonEval` is 'Bool' and `B` is 'True'. +optimize_unit1(B1,eval_true(A)):- B1 = eval_for(_,NonEval, A, B),NonEval=='Bool', B=='True',!. + +%% optimize_unit1(+Input, +Output) is semidet. +% Continues optimization based on specific patterns in the `Input`. +% Optimizations include equality checks, freezing variables, and pattern matching. +% This version preserves existing predicate definitions for specialized cases. +% +optimize_unit1(_,_):- disable_optimizer, !, fail. % Ensure the optimizer can be disabled. +optimize_unit1(eval_for(b_6,Atom,A,B),eval(A,B)):- 'Atom' == Atom,!. % Specific case optimization for `Atom`. +% Optimize `eval_for/4` by freezing variables and checking equality. +optimize_unit1(eval_for(_,Atom,A,B),print(A=B)):- 'Atom' == Atom, freeze(A, A=B),freeze(B, A=B), \+ \+ (A=B). +% Handle boolean comparisons where both `B` and `True` are 'True'. +optimize_unit1(B=True, B=True):- B='True','True'==True. +% General optimization for evaluations known to be true. +optimize_unit1(ISTRUE,true):- assumed_true(_ ,ISTRUE),!. +% Flatten nested conjunctions. +optimize_unit1(((A,B),C),(A,B,C)). +% Optimize equality of constants and variables. +optimize_unit1(=(Const,Var),true):- is_nsVar(Var),symbol(Const),=(Const,Var). +% Attempt to further optimize equality, though this path fails by default. +optimize_unit1(=(Const,Var),=(Var,Const)):- fail, is_nsVar(Var),symbol(Const),!. + +% Optimize calls to `get-metatype/2` with specific patterns. +optimize_unit1( + ==(['get-metatype', A], Sym, _B), + call('get-metatype',A,Sym)). + +% Handle specific cases where `eval_true/1` is checking a metatype. +optimize_unit1( + eval_true([==, ['get-metatype', A], 'Expression']), + call('get-metatype',A,'Expression')). + +% General optimization for binary operations, particularly `==/2`. +optimize_unit1( eval_true([GM, Val, Eval]), call(GM, Val, Eval)):- + symbol(GM), \+ iz_conz(Val), \+ iz_conz(Eval), + GM = '==',!. + +% Optimize unary operations that match specific criteria. +optimize_unit1( eval_true([GM, Eval]), call(GM,Eval)):- + symbol(GM), predicate_arity(GM,1), \+ predicate_arity(GM,2), + var(Eval),!. + +% Optimize match operations involving equality and argument unification. +optimize_unit1( ==([GM,Eval],Val,C), call(GM,Eval,Val)):- C==Eval, + symbol(GM), predicate_arity(GM,2), \+ predicate_arity(GM,1), + symbol(Val),var(Eval),!. + +%% optimize_u_assign(+Head, +Args, +Result, -Code) is semidet. +% Optimizes variable assignments and function calls in a MeTTa program. +% Arguments: +% - Head: The head of the clause, typically a compound term. +% - Args: The list of arguments to be optimized. +% - Result: The result of the optimization, typically a variable. +% - Code: The generated code after optimization. +% This predicate includes specific patterns for arithmetic, logical operations, and function calls. +% + +optimize_u_assign(_,_,_,_):- disable_optimizer, !, fail. +% Disable optimizer if necessary. + + + +% Fail if the first argument in the list is a namespace variable. +optimize_u_assign(_,[Var|_],_,_):- is_nsVar(Var),!,fail. +% Optimize empty lists to a fail predicate. +optimize_u_assign(_,[Empty], _, (!,fail)):- Empty == empty,!. +% Optimize binary equality checks in specific contexts. +optimize_u_assign(_,[EqEq,[GM,Eval],Val],C, call(GM,Eval,Val)):- + EqEq == '==',C==Eval, + symbol(GM), predicate_arity(GM,2), \+ predicate_arity(GM,1), + symbol(Val),var(Eval),!. + +% Optimize arithmetic operations with basic operations like addition and subtraction. +optimize_u_assign(_,[+, A, B], C, plus(A , B, C)):- number_wang(A,B,C), !. +optimize_u_assign(_,[-, A, B], C, plus(B , C, A)):- number_wang(A,B,C), !. +optimize_u_assign(_,[+, A, B], C, +(A , B, C)):- !. +optimize_u_assign(_,[-, A, B], C, +(B , C, A)):- !. +optimize_u_assign(_,[*, A, B], C, *(A , B, C)):- number_wang(A,B,C), !. +optimize_u_assign(_,['/', A, B], C, *(B , C, A)):- number_wang(A,B,C), !. +optimize_u_assign(_,[*, A, B], C, *(A , B, C)):- !. +optimize_u_assign(_,['/', A, B], C, *(B , C, A)):- !. +% Optimize Fibonacci calculations. +optimize_u_assign(_,[fib, B], C, fib(B, C)):- !. +optimize_u_assign(_,[fib1, A,B,C,D], R, fib1(A, B, C, D, R)):- !. +% Optimize pragma settings in MeTTa. +optimize_u_assign(_,['pragma!',N,V],Empty,set_option_value_interp(N,V)):- + nonvar(N),ignore((fail,Empty='Empty')), !. +% Optimize filter operations, matching against specific patterns in the head. +optimize_u_assign((H:-_),Filter,A,filter_head_arg(A,Filter)):- fail, compound(H), arg(_,H,HV), + HV==A, is_list(Filter),!. +% Optimize arithmetic operations using CLP(FD) constraints. +optimize_u_assign(_,[+, A, B], C, '#='(C , A + B)):- number_wang(A,B,C), !. +optimize_u_assign(_,[-, A, B], C, '#='(C , A - B)):- number_wang(A,B,C), !. +% Optimize match operations involving queries and templates. +optimize_u_assign(_,[match,KB,Query,Template], R, Code):- match(KB,Query,Template,R) = Code. + +% Further optimize MeTTa code after translation into an intermediate form. +optimize_u_assign(HB,MeTTaEvalP, R, Code):- \+ is_nsVar(MeTTaEvalP), + compound_non_cons(MeTTaEvalP), p2s(MeTTaEvalP,MeTTa), + MeTTa\=@=MeTTaEvalP,!, optimize_body(HB, u_assign(MeTTa, R), Code). + +/*% optimize_u_assign(_,_,_,_):- !,fail.*/ + +% Default case for function application optimization. +optimize_u_assign((H:-_),[Pred| ArgsL], R, Code):- var(R), symbol(Pred), ok_to_append(Pred), + append([Pred| ArgsL],[R], PrednArgs),Code=..PrednArgs, + (H=..[Pred|_] -> nop(set_option_value('tabling',true)) ; current_predicate(_,Code)),!. + +%% optimize_conj(+Head, +B1, +B2, -Optimized) is semidet. +% Optimizes conjunctions within a clause body. +% This involves combining or transforming predicates to improve efficiency. +% Arguments: +% - Head: The head of the clause. +% - B1, B2: The conjunctions within the body. +% - Optimized: The resulting optimized conjunction. +% This predicate also handles special cases for true evaluations. +% + +optimize_conj(_, _, _, _):- disable_optimizer, !, fail. % Disable optimization if needed. + +% Optimize evaluation of true statements. +optimize_conj(_Head, B1,B2,eval_true(E)):- + B2 = is_True(True_Eval), + B1 = eval(E,True_Eval1), + True_Eval1 == True_Eval,!. + +% Optimize conjunctions involving variable assignments. +optimize_conj(HB, RR, C=A, RR):- compound(RR),is_nsVar(C),is_nsVar(A), + as_functor_args(RR,_,_,Args),is_list(Args), member(CC,Args),var(CC), CC==C, + count_var(HB,C,N),N=2,C=A,!. + +% Optimize u_assign for true evaluations. +optimize_conj(_, u_assign(Term, C), u_assign(True,CC), eval_true(Term)):- + 'True'==True, CC==C. +optimize_conj(_, u_assign(Term, C), is_True(CC), eval_true(Term)):- CC==C, !. +optimize_conj(HB, u_assign(Term, C), C=A, u_assign(Term,A)):- is_ftVar(C),is_ftVar(A),count_var(HB,C,N),N=2,!. +optimize_conj(_, u_assign(Term, C), is_True(CC), eval_true(Term)):- CC==C, !. +% Optimize by verifying assumptions. +optimize_conj(HB, B1,BT,B1):- assumed_true(HB,BT),!. +optimize_conj(HB, BT,B1,B1):- assumed_true(HB,BT),!. +%optimize_conj(Head, u_assign(Term, C), u_assign(True,CC), Term):- 'True'==True, +% optimize_conj(Head, u_assign(Term, C), is_True(CC), CTerm). +%optimize_conj(Head,B1,BT,BN1):- assumed_true(HB,BT),!, optimize_body(Head,B1,BN1). +%optimize_conj(Head,BT,B1,BN1):- assumed_true(HB,BT),!, optimize_body(Head,B1,BN1). +% Optimize conjunctions within the body of a clause. +optimize_conj(Head,B1,B2,(BN1,BN2)):- + optimize_body(Head,B1,BN1), optimize_body(Head,B2,BN2). + +% Preserve the following commented-out code for future reference or extended use cases. + +%% optimize_head_and_body(+Head, +Body, -HeadNew, -BodyNew) is det. +% Optimizes both the head and body of a clause. +% This includes labeling, merging, and recursively optimizing the body. +% Arguments: +% - Head: The original head of the clause. +% - Body: The original body of the clause. +% - HeadNew: The optimized head. +% - BodyNew: The optimized body. +% +optimize_head_and_body(Head,Body,HeadNewest,BodyNewest):- + label_body_singles(Head,Body), + % Label single occurrences in the body. + (merge_and_optimize_head_and_body(Head,Body,HeadNew,BodyNew), + (((Head,Body)=@=(HeadNew,BodyNew)) + -> (HeadNew=HeadNewest,BodyNew=BodyNewest) + ; + + (color_g_mesg('#404064',print_pl_source(( HeadNew :- BodyNew))), + optimize_head_and_body(HeadNew,BodyNew,HeadNewest,BodyNewest)))),!. + +%% continue_opimize(+HeadBody, -OptimizedClause) is det. +% Continues the optimization process on a given head-body clause. +% Arguments: +% - HeadBody: The original head-body pair. +% - OptimizedClause: The resulting optimized clause. +% +continue_opimize(HB,(H:-BB)):- expand_to_hb(HB,H,B), must_optimize_body(HB,B,BB),!. +/*%continue_opimize(Converted,Converted).*/ + + +% Further optimization continues below, including merging heads and optimizing bodies. + +%% merge_and_optimize_head_and_body(+AHead, +Body, -Head, -BodyNew) is det. +% Merges and optimizes the head and body of a clause. +% This includes handling special cases for head structures and optimizing the body. +% Arguments: +% - AHead: The head of the clause before optimization. +% - Body: The body of the clause. +% - Head: The optimized head. +% - BodyNew: The optimized body. +% +merge_and_optimize_head_and_body(Head,Converted,HeadO,Body):- nonvar(Head), + Head = (PreHead,True),!, + merge_and_optimize_head_and_body(PreHead,(True,Converted),HeadO,Body),!. +merge_and_optimize_head_and_body(AHead,Body,Head,BodyNew):- + assertable_head(AHead,Head), + % Convert the head to an assertable form if needed. + must_optimize_body(Head,Body,BodyNew),!. + +%% assertable_head(+FListR, -Head) is det. +% Converts specific patterns in the head to a more assertable form. +% This is used to transform functional heads into a predicate form. +% Arguments: +% - FListR: The original function list and result. +% - Head: The transformed, assertable head. +% +assertable_head(u_assign(FList,R),Head):- FList =~ [F|List], + append(List,[R],NewArgs), symbol(F), Head=..[F|NewArgs],!. +assertable_head(Head,Head). +% Default case, the head is already assertable. + +%% label_body_singles(+Head, +Body) is det. +% Labels single occurrences of variables in the body for optimization purposes. +% This is necessary for certain optimizations that rely on variable occurrences. +% Arguments: +% - Head: The head of the clause. +% - Body: The body of the clause. +% +label_body_singles(Head,Body):- + term_singletons(Body+Head,BodyS), + % Find singletons in the body relative to the head. + maplist(label_body_singles_2(Head),BodyS). + +% Helper predicate to label single variables if not already in the head. +label_body_singles_2(Head,Var):- sub_var(Var,Head),!. +label_body_singles_2(_,Var):- ignore(Var='$VAR'('_')). + +%! metta_predicate(+Signature) is det. +% Declares various MeTTa predicates used in optimizations. +%ThesedeclarationsassistinpatternmatchingandoptimizationsinMeTTa. +%Arguments: +%-Signature:ThesignatureoftheMeTTapredicate. +% +metta_predicate(u_assign(evaluable,eachvar)). +metta_predicate(eval_true(matchable)). +metta_predicate(with_space(space,matchable)). +metta_predicate(limit(number,matchable)). +metta_predicate(findall(template,matchable,listvar)). +metta_predicate(match(space,matchable,template,eachvar)). + +%% must_optimize_body(+Head, +Body, -OptimizedBody) is det. +% Recursively optimizes the body of a clause. +% It applies optimizations iteratively until no further optimizations can be made. +% Arguments: +% - Head: The head of the clause. +% - Body: The body of the clause. +% - OptimizedBody: The final optimized version of the body. +% +must_optimize_body(A,B,CC):- once(optimize_body(A,B,C)), C \=@= B,!, must_optimize_body(A,C,CC). +must_optimize_body(_,B,C):- B =C. +% If no further optimization is possible, return the body as is. +%! optimize_body(+HB, +Body, -BodyNew) is det. +% +% Core optimization logic for a clause body. +% This predicate optimizes various constructs within the body of a clause, including function calls, conditional statements, and more. +% +% @arg HB The head-body context or clause being optimized. +% @arg Body The original body of the clause. +% @arg BodyNew The resulting optimized body. +% +optimize_body(_HB, Body, BodyNew) :- + % If the body is a namespace variable, return it as is. + is_nsVar(Body), !, Body = BodyNew. + +/* previously: +% optimize_body( HB, u_assign(VT,R), u_assign(VT,R)) :- +% This optimization was commented out, possibly because it was redundant or unnecessary. +% must_optimize_body(HB, VT, VTT). +*/ + +optimize_body(HB, with_space(V, T), with_space(V, TT)) :- + % Optimize the body within the with_space construct. + !, must_optimize_body(HB, T, TT). + +optimize_body(HB, call(T), call(TT)) :- + % Optimize the body within a call construct. + !, must_optimize_body(HB, T, TT). + +optimize_body(HB, rtrace_on_error(T), rtrace_on_error(TT)) :- + % Optimize the body within rtrace_on_error for error tracing. + !, must_optimize_body(HB, T, TT). + +optimize_body(HB, limit(V, T), limit(V, TT)) :- + % Optimize the body within a limit construct. + !, must_optimize_body(HB, T, TT). + +optimize_body(HB, findall_ne(V, T, R), findall_ne(V, TT, R)) :- + % Optimize within a findall_ne construct, expanding the head-body if necessary. + !, expand_to_hb(HB, H, _), must_optimize_body((H :- findall_ne(V, T, R)), T, TT). + +optimize_body(HB, findall(V, T, R), findall(V, TT, R)) :- + % Optimize within a findall construct, expanding the head-body if necessary. + !, expand_to_hb(HB, H, _), must_optimize_body((H :- findall(V, T, R)), T, TT). + +optimize_body(HB, loonit_assert_source_tf(V, T, R3, R4), loonit_assert_source_tf(V, TT, R3, R4)) :- + % Optimize within a loonit_assert_source_tf construct. + !, must_optimize_body(HB, T, TT). + +optimize_body(HB, loonit_assert_source_empty(V, X, Y, T, R3, R4), loonit_assert_source_empty(V, X, Y, TT, R3, R4)) :- + % Optimize within a loonit_assert_source_empty construct. + !, must_optimize_body(HB, T, TT). + +optimize_body(HB, (B1 *-> B2 ; B3), (BN1 *-> BN2 ; BN3)) :- + % Optimize conditional constructs with potential non-determinism. + !, must_optimize_body(HB, B1, BN1), optimize_body(HB, B2, BN2), optimize_body(HB, B3, BN3). + +optimize_body(HB, (B1 -> B2 ; B3), (BN1 -> BN2 ; BN3)) :- + % Optimize conditional constructs with determinism. + !, must_optimize_body(HB, B1, BN1), must_optimize_body(HB, B2, BN2), must_optimize_body(HB, B3, BN3). + +optimize_body(HB, (B1 :- B2), (BN1 :- BN2)) :- + % Optimize body in the context of a clause definition. + !, optimize_body(HB, B1, BN1), optimize_body(HB, B2, BN2). + +optimize_body(HB, (B1 *-> B2), (BN1 *-> BN2)) :- + % Optimize a soft-cut conditional construct. + !, must_optimize_body(HB, B1, BN1), optimize_body(HB, B2, BN2). + +optimize_body(HB, (B1 -> B2), (BN1 -> BN2)) :- + % Optimize a hard-cut conditional construct. + !, must_optimize_body(HB, B1, BN1), optimize_body(HB, B2, BN2). + +optimize_body(HB, (B1 ; B2), (BN1 ; BN2)) :- + % Optimize disjunction constructs. + !, optimize_body(HB, B1, BN1), optimize_body(HB, B2, BN2). + +optimize_body(HB, (B1, B2), (BN1)) :- + % Optimize conjunctions, ensuring optimization of both parts. + optimize_conjuncts(HB, (B1, B2), BN1). + +/* previously: +% optimize_body(_HB, ==(Var, C), Var=C):- self_eval(C), !. +% This code was commented out, possibly because it relied on a specific evaluation context or was redundant. +*/ + +optimize_body(HB, u_assign(A, B), R) :- + % Optimize assignments, possibly using an optimized version of u_assign. + optimize_u_assign_1(HB, A, B, R), !. + +optimize_body(HB, eval(A, B), R) :- + % Optimize evaluation constructs. + optimize_u_assign_1(HB, A, B, R), !. + +/* previously: +% optimize_body(_HB, u_assign(A, B), u_assign(AA, B)) :- +% This code was commented out, possibly because the optimization logic was handled elsewhere. +% p2s(A, AA), !. +*/ + +optimize_body(_HB, Body, BodyNew) :- + % Fall back to unit-level optimization if no other rules apply. + optimize_body_unit(Body, BodyNew). + +%! optimize_body_unit(+I, -O) is det. +% +% Unit-level optimization of body elements. +% This predicate handles simple transformations and straightforward optimizations within the body. +% +% @arg I The original body element to be optimized. +% @arg O The optimized body element. +% +optimize_body_unit(I, O) :- + % If the body element is 'true', return it as is. + I == true, !, I = O. + +optimize_body_unit(I, O) :- + % If the body element is a trivial equality, simplify it to 'true'. + I == ('True' = 'True'), !, O = true. + +optimize_body_unit(I, O) :- + % This branch was intended for more complex optimizations but was commented out. + fail, copy_term(I, II), optimize_unit1(I, Opt), I =@= II, !, optimize_body_unit(Opt, O). + +optimize_body_unit(I, O) :- + % This branch was intended for another level of optimization but was commented out. + fail, optimize_unit11(I, Opt), optimize_body_unit(Opt, O). + +optimize_body_unit(O, O). + +%! ok_to_append(+Symbol) is semidet. +% +% Predicate to determine if appending is allowed for a given symbol. +% +% @arg Symbol The symbol to check. +% +ok_to_append('$VAR') :- + % '$VAR' cannot be appended. + !, fail. +ok_to_append(_). + +%! number_wang(+A, +B, +C) is det. +% +% Helper predicate to handle numeric operations in optimization. +% Ensures that the arguments are numeric or variables, and declares them as numeric if necessary. +% +% @arg A The first numeric value or variable. +% @arg B The second numeric value or variable. +% @arg C The third numeric value or variable. +% +number_wang(A, B, C) :- + % Ensure that the arguments are numeric or variables, and declare them as numeric if necessary. + (numeric(C) ; numeric(A) ; numeric(B)), !, + maplist(numeric_or_var, [A, B, C]), + maplist(decl_numeric, [A, B, C]), !. + +%! p2s(+P, -S) is det. +% +% Converts a Prolog term into a list of arguments for further processing. +% +% @arg P The Prolog term to be converted. +% @arg S The resulting list of arguments. +% +p2s(P, S) :- + % Convert the term P into a list of its arguments. + into_list_args(P, S). + +%! get_decl_type(+N, -DT) is semidet. +% +% Retrieves the declared type of a variable based on attributes. +% +% @arg N The variable whose declared type is being retrieved. +% @arg DT The declared type of the variable. +% +get_decl_type(N, DT) :- + % If N is an attributed variable, retrieve its declared type. + attvar(N), get_atts(N, AV), sub_term(DT, AV), symbol(DT). + +%! numeric(+N) is semidet. +% +% Checks if a term is numeric, either by being a number or having the 'Number' attribute. +% +% @arg N The term to check. +% +numeric(N) :- + % Check if N is a number. + number(N), !. +numeric(N) :- + % Check if N has the 'Number' attribute. + get_attr(N, 'Number', 'Number'). +numeric(N) :- + % Check if N's declared type is numeric. + get_decl_type(N, DT), (DT == 'Int', DT == 'Number'). + +%! decl_numeric(+N) is det. +% +% Declares a variable as numeric if it is not already numeric. +% +% @arg N The variable to be declared as numeric. +% +decl_numeric(N) :- + % Declare N as numeric if it is already numeric. + numeric(N), !. +decl_numeric(N) :- + % If N is a variable, assign it the 'Number' attribute. + ignore((var(N), put_attr(N, 'Number', 'Number'))). + +%! numeric_or_var(+N) is semidet. +% +% Checks if a term is either numeric or a variable. +% +% @arg N The term to check. +% +numeric_or_var(N) :- + % If N is a variable, it passes the check. + var(N), !. +numeric_or_var(N) :- + % If N is numeric, it passes the check. + numeric(N), !. +numeric_or_var(N) :- + % Fail if N is neither numeric nor a variable. + \+ compound(N), !, fail. +numeric_or_var('$VAR'(_)). + +%! non_compound(+S) is semidet. +% +% Helper to check if a term is non-compound. +% +% @arg S The term to check. +% +non_compound(S) :- + % Check if S is not a compound term. + \+ compound(S). + +%! did_optimize_conj(+Head, +B1, +B2, -B12) is semidet. +% +% Attempts to optimize conjunctions and evaluate results. +% +% @arg Head The head-body context. +% @arg B1 The first term in the conjunction. +% @arg B2 The second term in the conjunction. +% @arg B12 The optimized conjunction of B1 and B2. +% +did_optimize_conj(Head, B1, B2, B12) :- + % Attempt to optimize a conjunction and verify the result differs from the original. + once(optimize_conj(Head, B1, B2, B12)), B12 \=@= (B1, B2), !. + +%! optimize_conjuncts(+Head, +Conj, -BN) is det. +% +% Optimizes conjunctions of three terms, with special handling for compound terms. +% +% @arg Head The head-body context. +% @arg Conj The conjunction to be optimized. +% @arg BN The resulting optimized conjunction. +% +optimize_conjuncts(Head, (B1, B2, B3), BN) :- + % Optimize a conjunction of three terms, with special consideration for B3 being a simple term. + B3 \= (_, _), + did_optimize_conj(Head, B2, B3, B23), + must_optimize_body(Head, (B1, B23), BN), !. + +optimize_conjuncts(Head, (B1, B2, B3), BN) :- + % Optimize a conjunction of three terms, with special consideration for B1 being a simple term. + did_optimize_conj(Head, B1, B2, B12), + must_optimize_body(Head, (B12, B3), BN), !. + +/* previously: +% optimize_conjuncts(Head, (B1, B2), BN1) :- optimize_conj(Head, B1, B2, BN1). +% This was likely commented out due to redundancy with did_optimize_conj. +*/ + +optimize_conjuncts(Head, (B1, B2), BN1) :- + % Optimize a conjunction of two terms. + did_optimize_conj(Head, B1, B2, BN1), !. + +optimize_conjuncts(Head, (B1 *-> B2), (BN1 *-> BN2)) :- + % Optimize a soft-cut conditional conjunction. + !, optimize_conjuncts(Head, B1, BN1), optimize_conjuncts(Head, B2, BN2). + +optimize_conjuncts(Head, (B1 -> B2), (BN1 -> BN2)) :- + % Optimize a hard-cut conditional conjunction. + !, optimize_conjuncts(Head, B1, BN1), optimize_conjuncts(Head, B2, BN2). + +optimize_conjuncts(Head, (B1 ; B2), (BN1 ; BN2)) :- + % Optimize a disjunction of two terms. + !, optimize_conjuncts(Head, B1, BN1), optimize_conjuncts(Head, B2, BN2). + +optimize_conjuncts(Head, (B1, B2), (BN1, BN2)) :- + % Optimize a conjunction of two terms. + !, must_optimize_body(Head, B1, BN1), must_optimize_body(Head, B2, BN2). + +optimize_conjuncts(_, A, A). + +%! count_var_gte(+HB, +V, +Ct) is det. +% +% Counts the occurrences of a variable in a term, ensuring it meets or exceeds a threshold. +% +% @arg HB The head-body context. +% @arg V The variable to be counted. +% @arg Ct The minimum count threshold. +% +count_var_gte(HB, V, Ct) :- + % Count the occurrences of V in HB and compare with the threshold Ct. + count_var(HB, V, CtE), Ct >= CtE. diff --git a/.Attic/canary_docme/metta_ontology.pfc.pl b/.Attic/canary_docme/metta_ontology.pfc.pl new file mode 100644 index 00000000000..8fe2560b6dc --- /dev/null +++ b/.Attic/canary_docme/metta_ontology.pfc.pl @@ -0,0 +1,475 @@ +/* + * 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. + */ + + +%:- multifile(baseKB:agent_action_queue/3). +%:- dynamic(baseKB:agent_action_queue/3). + +:- set_prolog_flag(gc,true). + +:- thread_local(t_l:disable_px/0). +:- retractall(t_l:disable_px). + +:- must(\+ t_l:disable_px). + +:- op(500,fx,'~'). +:- op(1050,xfx,('=>')). +:- op(1050,xfx,'<==>'). +:- op(1050,xfx,('<-')). +:- op(1100,fx,('==>')). +:- op(1150,xfx,('::::')). +:- + current_prolog_flag(access_level,Was), + set_prolog_flag(access_level,system), + op(1190,xfx,('::::')), + op(1180,xfx,('==>')), + op(1170,xfx,'<==>'), + op(1160,xfx,('<-')), + op(1150,xfx,'=>'), + op(1140,xfx,'<='), + op(1130,xfx,'<=>'), + op(600,yfx,'&'), + op(600,yfx,'v'), + op(350,xfx,'xor'), + op(300,fx,'~'), + op(300,fx,'-'), + op(1199,fx,('==>')), + set_prolog_flag(access_level,Was). + +%:- style_check(-discontiguous). +%:- enable_mpred_expansion. +%:- expects_dialect(pfc). + +/* +:- dynamic lmcache:session_io/4, lmcache:session_agent/2, lmcache:agent_session/2, telnet_fmt_shown/3, agent_action_queue/3). +:- dynamic lmcache:session_io/4, lmcache:session_agent/2, lmcache:agent_session/2, telnet_fmt_shown/3, agent_action_queue/3). + +*/ +%:- nop('$set_source_module'( baseKB)). +:- set_prolog_flag(runtime_speed, 0). +:- set_prolog_flag(runtime_safety, 2). +:- set_prolog_flag(runtime_debug, 2). +:- set_prolog_flag(unsafe_speedups, false). +:- set_prolog_flag(expect_pfc_file,always). + + + +:- set_prolog_flag(pfc_term_expansion,false). + + +params_and_return_type([->|TypeList],Len,Params,Ret):- + append(Params,[Ret], TypeList), + length(Params,Len). + +merge_fp(_,_,N) :- N<1. +merge_fp(T1,T2,N) :- + N>0, + arg(N,T1,X), + arg(N,T2,X), + N1 is N-1, + merge_fp(T1,T2,N1). + +:- set_prolog_flag(pfc_term_expansion,true). + +'functional-predicate'(Name,Arity) ==> + {functor(P1,Name,Arity), + functor(P2,Name,Arity), + arg(Arity,P1,PV1), + arg(Arity,P2,PV2), + N is Arity-1, + merge_fp(P1,P2,N)}, + (P1,{P2,PV1\==PV2} ==> ~P2). + + +==> 'functional-predicate'('next-operation',1). +==> 'functional-predicate'('previous-operation',1). + +:- dynamic('op-complete'/1). + +'previous-operation'(none). + +('next-operation'(Current), + { + if_t( retract('previous-operation'(Previous)), + (if_t(Previous==Current, + nop(wdmsg(continue(Previous)))), + if_t(Previous\=@=Current, + if_t( \+ 'op-complete'(Previous), + (nop(wdmsg(begun(op_complete(Previous)))), + pfcAdd('op-complete'(Previous)), + nop(wdmsg(ended(op_complete(Previous))))))))), + nop(wdmsg(op_next(Current))), + assert('previous-operation'(Current))} + ==> + 'seen-operation'(Current)). + + +% ==> 'next-operation'(next). + + +((properties(KB,A,B),{member(E,B),nonvar(E)})==>property(KB,A,E)). +property(_,Op,E) ==> (form_op(Op),form_prop(E)). + +((property(KB,F,PA),p_arity(PA,A)) ==> (predicate_arity(KB,F,A))). +((property(KB,F,FA),f_arity(FA,A)) ==> (functional_arity(KB,F,A))). + + +% (metta_compiled_predicate(KB,F,A)==>predicate_arity(KB,F,A)). + + + +(metta_atom_asserted(KB,[C,H,T])/(C==':')) ==> metta_type(KB,H,T). +(metta_atom_asserted(KB,[C,H,T|Nil])/(Nil==[],C=='=',H=II)) ==> metta_defn(KB,II,T). +(metta_atom_asserted(KB,[C,H,A1,A2|AL])/(C=='=')) ==> metta_defn(KB,H,[A1,A2|AL]). +(metta_atom_asserted(KB,[C,H|AL])/(C==':-')) ==> metta_defn(KB,H,['wam-body'|AL]). + +metta_defn(KB,[F|Args],_)/length(Args,Len) + ==>src_code_for(KB,F,Len). + +'op-complete'(op(+,'=',F)), + metta_defn(KB,[F|Args],_)/length(Args,Len) + ==>src_code_for(KB,F,Len),{nop(dedupe_cl(/*'&self':*/F))}. + +(src_code_for(KB,F,Len)==>function_arity(KB,F,Len)). + +('op-complete'(op(+,':',F)) + ==> + (( metta_type(KB,F,TypeList)/is_list(TypeList), + {params_and_return_type(TypeList,Len,Params,Ret)}) ==> + metta_params_and_return_type(KB,F,Len,Params,Ret),{do_once(show_deds_w(F))})). + +metta_params_and_return_type(KB,F,Len,Params,Ret), + {is_absorbed_return_type(Params,Ret)} + ==>(function_arity(KB,F,Len),is_absorbed_return(KB,F,Len,Ret),predicate_arity(KB,F,Len)). + +metta_params_and_return_type(KB,F,Len,Params,Ret), + { is_non_absorbed_return_type(Params,Ret), Len1 is Len+1} + ==>(function_arity(KB,F,Len),is_non_absorbed_return(KB,F,Len,Ret),predicate_arity(KB,F,Len1)). + +(need_corelib_types,op_decl(F,Params,Ret),{nonvar(Ret),length(Params,Len)})==> + metta_params_and_return_type('&corelib',F,Len,Params,Ret). + + +ensure_corelib_types:- pfcAdd(please_do_corelib_types). +%(need_corelib_types, metta_atom_corelib(Term)) ==> metta_atom_asserted('&corelib', Term). +(need_corelib_types, metta_atom(KB,Atom)) ==> metta_atom_asserted(KB, Atom). +:- dynamic(need_corelib_types/0). +(please_do_corelib_types, { \+ need_corelib_types }) ==> need_corelib_types. +'ensure-compiler!':- ensure_corelib_types. +if(Cond,Then,Else,Result):- eval_true(Cond)*-> eval(Then,Result); eval(Else,Result). + + + +:- dynamic(can_compile/2). + +src_code_for(KB,F,Len) ==> ( \+ metta_compiled_predicate(KB,F,Len) ==> do_compile(KB,F,Len)). + +do_compile_space(KB) ==> (src_code_for(KB,F,Len) ==> do_compile(KB,F,Len)). + +%do_compile_space('&self'). + +do_compile(KB,F,Len),src_code_for(KB,F,Len) ==> really_compile(KB,F,Len). + + +metta_defn(KB,[F|Args],BodyFn),really_compile(KB,F,Len)/length(Args,Len)==> + really_compile_src(KB,F,Len,Args,BodyFn),{dedupe_ls(F)}. + +really_compile_src(KB,F,Len,Args,BodyFn), + {compile_metta_defn(KB,F,Len,Args,BodyFn,Clause)} + ==> (compiled_clauses(KB,F,Clause)). + + + +%:- ensure_loaded('metta_ontology_level_1.pfc'). + + + + +a==>b. +b==>bb. + +a. +:- b. +:- bb. + +%:- pfcWhy1(a). +%:- pfcWhy1(b). + +:- set_prolog_flag(expect_pfc_file,never). +:- set_prolog_flag(pfc_term_expansion,false). + + +test_fwc:- + pfcAdd_Now(c(X)==>d(X)), + pfcAdd_Now(c(1)), + c(_), + d(_), + pfcWhy1(c(_)), + pfcWhy1(d(_)), + pfcAdd(e(2)), + e(_), + pfcAdd(e(X)<==>f(X)), + f(_), + pfcWhy1(e(_)), + pfcWhy1(f(_)). + + +%:- forall(==>(X,Y),pfcFwd(==>(X,Y))). + +%:- break. + +%:- must_det_ll(property('length',list_operations)). + + + + +end_of_file. + + + +/* + really_compile(KB,F,Len)==> + ((metta_defn(KB,[F|Args],BodyFn)/compile_metta_defn(KB,F,Len,Args,BodyFn,Clause)) + ==> (compiled_clauses(KB,F,Clause))). +*/ + + + + +% Predicate and Function Arity Definitions: +% Specifies the number of arguments (arity) for predicates and functions, which is fundamental +% for understanding the complexity and capabilities of various logical constructs. Predicates are defined +% from Nullary (no arguments) up to Denary (ten arguments), reflecting a range of logical conditions or assertions. +% Functions are similarly defined but focus on operations that return a value, extending up to Nonary (nine arguments). +% Enforcing Equivalency Between Predicates and Functions: +% Establishes a logical framework to equate the conceptual roles of predicates and functions based on arity. +% This equivalence bridges the functional programming and logical (declarative) paradigms within Prolog, +% allowing a unified approach to defining operations and assertions. + +(equivalentTypes(PredType,FunctType) ==> + ( property(KB,FunctorObject,PredType) + <==> + property(KB,FunctorObject,FunctType))). +% Automatically generating equivalency rules based on the arity of predicates and functions. +% This facilitates a dynamic and flexible understanding of function and predicate equivalences, +% enhancing Prolog's expressive power and semantic richness. +(((p_arity(PredType,PA), {plus(KB,FA,1,PA), FA>=0}, f_arity(KB,FunctType,FA))) + ==> equivalentTypes(PredType,FunctType)). + +p_arity('NullaryPredicate', 0). % No arguments. +p_arity('UnaryPredicate', 1). % One argument. +p_arity('BinaryPredicate', 2). % Two arguments. +p_arity('TernaryPredicate', 3). % Three arguments, and so on. +p_arity('QuaternaryPredicate', 4). +p_arity('QuinaryPredicate', 5). +p_arity('SenaryPredicate', 6). +p_arity('SeptenaryPredicate', 7). +p_arity('OctaryPredicate', 8). +p_arity('NonaryPredicate', 9). +p_arity('DenaryPredicate', 10). + +f_arity('NullaryFunction', 0). % No return value, essentially a procedure. +f_arity('UnaryFunction', 1). % Returns a single value, and so on. +f_arity('BinaryFunction', 2). +f_arity('TernaryFunction', 3). +f_arity('QuaternaryFunction', 4). +f_arity('QuinaryFunction', 5). +f_arity('SenaryFunction', 6). +f_arity('SeptenaryFunction', 7). +f_arity('OctaryFunction', 8). +f_arity('NonaryFunction', 9). + + +% "Nondeterministic" - Can produce more than one result for the same inputs. +form_prop('Nondeterministic'). +% "Deterministic" - Always produces the same output for the same input. +form_prop('Deterministic'). +% "IdiomaticTranspilation" - Converts code to a more idiomatic form in another language. +form_prop('DirectTranspilation'). +% "FunCompiled" - Functions are compiled to machine code for performance. +form_prop('Compiled'). +% "FunInterpreted" - Functions are executed by an interpreter, without compilation. +form_prop('Interpreted'). + +% "Boolean" - Maps success/failure in Prolog to True/False. +form_prop('BooleanFunction'). + +% "EvalNoArgs" - dont evaluate or type check args +form_prop('EvalNoArgs'). +% "CoerceArgsToTypes" - Arguments are automatically coerced to specified types. +form_prop('CoerceArgsToTypes', 'List'). + % check EvalNoArgs/CoerceArgsToTypes then return the whole value unevaluated +form_prop('TypeConstructor'). +% this is the default for MeTTa in rust +form_prop('OnFailReturnSelf'). +% except for flow control instuctructions functions +form_prop('OnFailBacktrack'). + + +% "FixedArityFunction" - Functions or predicates with a fixed number of arguments. +form_prop('FixedArityFunction'). +% "ReturnNthArg" - Functions return the Nth argument passed to them. +form_prop('ReturnNthArg', 'Integer'). +% "FunctionArity" - The number of arguments a function takes (2 here). +form_prop('FunctionArity', 'Integer'). +% "PredicateArity" - The number of arguments a predicate has after being converted to a function +form_prop('PredicateArity', 'Integer'). +% "VariableArity" - Functions or predicates with a variable number of arguments. +form_prop('ArityMinMax', 'Integer', 'Integer'). % Min Max + + +%(: Z Nat) +%(: S (-> Nat Nat)) +%(: S TypeConstructor) + +% --- Control Flow and Conditional Execution --- +properties('&corelib','if', [flow_control, qhelp("Conditional execution."), conditional_execution]). +properties('&corelib','case', [flow_control, qhelp("Case selection."), conditional_execution]). +properties('&corelib','let', [variable_assignment, qhelp("Variable assignment.")]). +properties('&corelib','let*', [variable_assignment, qhelp("Sequential variable assignment."), sequential]). +properties('&corelib','function', [function_definition, qhelp("Function block.")]). +properties('&corelib','return', [function_definition, qhelp("Return value of a function block."), return_value]). +properties('&corelib','Error', [error_handling, qhelp("Defines or triggers an error.")]). + +% --- Error Handling and Advanced Control Flow --- +properties('&corelib','catch', [error_handling, qhelp("Catches exceptions."), exception_handling]). +properties('&corelib','throw', [error_handling, qhelp("Throws exceptions."), exception_handling]). + +% --- Data Structures and Manipulation --- +properties('&corelib','collapse', [data_structures, qhelp("Collapses a structure."), manipulation]). +properties('&corelib','sequential', [data_structures, qhelp("Sequentially applies operations."), sequential_operations]). +properties('&corelib','superpose', [data_structures, qhelp("Superposes data structures."), manipulation]). + +% --- Iteration and Loop Control --- +properties('&corelib','dedup!', [iteration_control, qhelp("Removes duplicate elements from iteration."), manipulation]). +properties('&corelib','nth!', [iteration_control, qhelp("Allows only the Nth iteration."), manipulation]). +properties('&corelib','limit!', [iteration_control, qhelp("Limits the number of iterations.")]). +properties('&corelib','time-limit!', [iteration_control, qhelp("Sets a time limit for operations."), time_management]). +properties('&corelib','offset!', [iteration_control, qhelp("Adjusts the starting point of iteration.")]). +properties('&corelib','number-of', [iteration_control, qhelp("Returns iteration count.")]). +properties('&corelib','nop', [iteration_control, qhelp("Suppresses iteration result."), suppression]). +properties('&corelib','do', [iteration_control, qhelp("Suppresses iteration result."), suppression]). + +% --- Compiler Directives and Optimization --- +properties('&corelib','pragma!', [compiler_directive, qhelp("Compiler directive for optimizations/settings."), optimization]). +properties('&corelib','include!', [code_inclusion, qhelp("Includes code from another file or context.")]). +properties('&corelib','load-ascii', [file_handling, qhelp("Loads ASCII file content.")]). +properties('&corelib','extend-py!', [integration, qhelp("Extends integration with Python."), python]). +properties('&corelib','registered-python-function', [integration, qhelp("Interacts with Python functions."), python]). +properties('&corelib','import!', [module_import, qhelp("Imports an external module or file.")]). + +% --- Evaluation and Dynamic Calls --- +properties('&corelib','eval', [evaluation, qhelp("Evaluates an expression.")]). +properties('&corelib','eval-for', [evaluation, qhelp("Evaluates assuming a return type."), type_assumption]). +properties('&corelib','call!', [dynamic_call, qhelp("Tries to dynamically guess if predicate or function.")]). +properties('&corelib','call-p!', [dynamic_call, qhelp("Dynamically calls a predicate."), predicate]). +properties('&corelib','predicate-arity', [function_definition, qhelp("Defines the arity of predicates/functions."), arity]). +properties('&corelib','call-fn!', [dynamic_call, qhelp("Calls a function dynamically."), function]). +properties('&corelib','pyr!', [integration, qhelp("Call python."), python]). +properties('&corelib','call-string!', [evaluation, qhelp("Evaluates a string of Prolog code."), prolog_code]). + +% --- Miscellaneous and Newly Included Properties --- +properties('&corelib','match', [pattern_matching, qhelp("Matches patterns within structures or data.")]). +properties('&corelib','get-atoms', [data_retrieval, qhelp("Retrieves atoms from a structure.")]). +properties('&corelib','new-space', [memory_allocation, qhelp("Allocates new space or memory region.")]). +properties('&corelib','remove-atom', [manipulation, qhelp("Removes an atom from a structure.")]). +properties('&corelib','add-atom', [manipulation, qhelp("Replaces an atom within a structure.")]). +properties('&corelib',',', [logical_operation, qhelp("Conjunction; and."), conjunction]). +properties('&corelib',';', [logical_operation, qhelp("Disjunction; or."), disjunction]). +properties('&corelib','replace-atom', [manipulation, qhelp("Replaces an atom within a structure.")]). +properties('&corelib','transfer!', [memory_management, qhelp("Transfers space content to another space.")]). + +% --- Symbolic Arithmetic and Type Conversion --- +properties('&corelib','S', [arithmetic, qhelp("Successor in Peano arithmetic."), peano_arithmetic]). +properties('&corelib','Z', [arithmetic, qhelp("Zero in Peano arithmetic."), peano_arithmetic]). +properties('&corelib','fromNumber', [type_conversion, qhelp("Converts from a numeric type to another type.")]). +properties('&corelib','coerce', [type_conversion, qhelp("Forces argument types for compatibility."), compatibility]). + +% --- Arithmetic Operations --- +properties('&corelib','+', [arithmetic, qhelp("Addition."), addition]). +properties('&corelib','-', [arithmetic, qhelp("Subtraction."), subtraction]). +properties('&corelib','*', [arithmetic, qhelp("Multiplication."), multiplication]). +properties('&corelib','mod', [arithmetic, qhelp("Modulus operation."), modulus]). +properties('&corelib','<', [comparison, qhelp("Less than."), less_than]). +properties('&corelib','>=', [comparison, qhelp("Greater than or equal to."), greater_than_or_equal]). +properties('&corelib','=>', [comparison, qhelp("Greater than or equal to."), greater_than_or_equal]). +properties('&corelib','<=', [comparison, qhelp("Less than or equal to."), less_than_or_equal]). +properties('&corelib','=<', [comparison, qhelp("Less than or equal to."), less_than_or_equal]). +properties('&corelib','>', [comparison, qhelp("Greater than."), greater_than]). + +% --- Logic Comparison and Evaluation Control --- +properties('&corelib','=', [logic, qhelp("Equality/unification operator."), equality]). +properties('&corelib','\\=', [logic, qhelp("Inequality test."), inequality]). +properties('&corelib','==', [logic, qhelp("Equality test."), equality_test]). +properties('&corelib','or', [logic, qhelp("Logical OR."), logical_or]). +properties('&corelib','xor', [logic, qhelp("Logical XOR."), logical_xor]) +properties('&corelib','and', [logic, qhelp("Logical AND."), logical_and]). +properties('&corelib','not', [logic, qhelp("Logical NOT."), logical_not]). +properties('&corelib','quote', [evaluation_control, qhelp("Prevents evaluation, treating input as literal.")]). +properties('&corelib','unquote', [evaluation_control, qhelp("Retrieves value of a quote."), retrieval]). + +% --- Debugging, Output, and Assertions --- +properties('&corelib','repl!', [debugging, qhelp("Interactive read-eval-print loop."), interactive]). +properties('&corelib','time!', [execution_timing, qhelp("Execution timing.")]). +properties('&corelib','trace!', [debugging, qhelp("Prints some debug information."), information_printing]). +properties('&corelib','no-rtrace!', [debugging, qhelp("Disables tracing for debugging."), trace_control]). +properties('&corelib','rtrace!', [debugging, qhelp("Enables tracing for debugging."), trace_control]). +properties('&corelib','println!', [output, qhelp("Prints text with newline to output."), text_printing]). +properties('&corelib','with-output-to!', [output, qhelp("Redirects output to a specified target."), redirection]). +properties('&corelib','print', [output, qhelp("Prints text to output."), text_printing]). +properties('&corelib','assertEqual', [testing, qhelp("Asserts a condition is true."), assertion]). +properties('&corelib','assertFalse', [testing, qhelp("Asserts a condition is false."), assertion]). +properties('&corelib','assertEqual', [testing, qhelp("Asserts two values are equal."), assertion]). +properties('&corelib','assertNotEqual', [testing, qhelp("Asserts two values are not equal."), assertion]). +properties('&corelib','assertEqualToResult', [testing, qhelp("Asserts equality to a result."), assertion]). + +% --- System Integration and State Management --- +properties('&corelib','change-state!', [state_management, qhelp("Changes the state of a system component."), system_integration]). +properties('&corelib','set-state', [state_management, qhelp("Sets the state of a component or system.")]). +properties('&corelib','get-state', [state_management, qhelp("Gets the state of a component or system."), data_retrieval]). + +% --- List Operations --- +properties('&corelib','car-atom', [list_operations, qhelp("Retrieves the head of a list."), head_retrieval]). +properties('&corelib','cdr-atom', [list_operations, qhelp("Retrieves the tail of a list."), tail_retrieval]). +properties('&corelib','range', [list_operations, qhelp("Generates a range of numbers."), range_generation]). +properties('&corelib','make_list', [list_operations, qhelp("Creates a list with specified elements."), creation]). +properties('&corelib','Cons', [list_operations, qhelp("Constructs a list."), construction]). +properties('&corelib','length', [list_operations, qhelp("Determines the length of a list."), length_determination]). +properties('&corelib','countElement', [list_operations, qhelp("Counts occurrences of an element."), element_counting]). +properties('&corelib','tuple-count', [data_structures, qhelp("Counts tuples within a structure."), counting]). +%properties('&corelib','TupleConcat', [data_structures, qhelp("Concatenates tuples."), concatenation]). +%properties('&corelib','collapseCardinality', [data_structures, qhelp("Collapses structures with cardinality consideration."), manipulation, cardinality]). + +% --- Nondet unique,union,intersection,subtraction Operations --- +properties('&corelib','unique', [nondet_sets, qhelp("Makes nondet results unique."), no_repeats_var]). +properties('&corelib','subtraction', [nondet_sets, qhelp("It subtracts elements generated by Call2 from those generated by Call1."), lazy_subtraction]). +properties('&corelib','intersection', [nondet_sets, qhelp("It gives the intersection duplicates are not removed ."), lazy_intersection]). + + +% --- String and Character manipulation --- +properties('&corelib','stringToChars', [string_operations, qhelp("Convert a string to a list of chars."), string_to_chars]). +properties('&corelib','charsToString', [string_operations, qhelp("Convert a list of chars to a string."), chars_to_string]). +properties('&corelib','format-args', [string_operations, qhelp("Generate a formatted string using a format specifier."), format_args]). +properties('&corelib','flip', [random, qhelp("Return a random boolean."), random_boolean]). + +properties('&corelib','repr', [string_operations, qhelp("Convert an atom to a string."), repr ]). +properties('&corelib','parse', [string_operations, qhelp("Convert a string to an atom."), parse ]). diff --git a/.Attic/canary_docme/metta_pfc_base.pl b/.Attic/canary_docme/metta_pfc_base.pl new file mode 100644 index 00000000000..aad619a51fe --- /dev/null +++ b/.Attic/canary_docme/metta_pfc_base.pl @@ -0,0 +1,1811 @@ +/* + * 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. + */ + +/* + LogicMOO Base FOL/PFC Setup +% Dec 13, 2035 +% Douglas Miles + +*/ +% :- if( \+ current_predicate(set_fileAssertMt/1)). + +:- set_prolog_flag(pfc_shared_module,user). +%:- set_prolog_flag(pfc_shared_module,baseKB). + +must_ex(X):- catch(X,E,rtrace(E))*->true;(dmsg(failed(must_ex(X))),rtrace(X)). +quietly_ex(X):-call(X). + +% @TODO undisable when we have defined into_type/3 to not fail +control_arg_types(A,B):- fail, once(control_arg_types1(20,[],A,B)),A\==B,!. + +%:- listing(control_arg_types/3). + +control_arg_types1( Max,_,A,B):- Max<1,!,A=B. +control_arg_types1(_Max,_,A,B):- \+ compound(A),!,A=B. +control_arg_types1(_Max,_,A,B):- iz_conz(A), \+ is_list(A),!, A = B. +control_arg_types1(_Max,_,A,B):- (current_predicate(check_args/2)->check_args(A,B)->A\=@=B),!. +%control_arg_types1(Max,Pre,A,B):- is_list(A), !, maplist(control_arg_types1(Max,Pre),A,B). +control_arg_types1( Max,Pre,A,B):- Max0 is Max-1, + compound_name_arguments(A,F,AA), + length(AA,N), + do_control_arg_types1(Max0,F/N,1,Pre,AA,BB), + compound_name_arguments(B,F,BB). + +do_control_arg_types1(_Max,_FofN,_ArgNp1,_Pre,[],[]):-!. +do_control_arg_types1( Max,FofN,ArgN,Pre,[A|AA],[B|BB]):- + do_control_1arg_type(Max,FofN,ArgN,Pre,A,B), + ArgNp1 is ArgN+1, + do_control_arg_types1(Max,FofN,ArgNp1,Pre,AA,BB). + +do_control_1arg_type(_Max,_FN,_N,_Pre,A,B):- var(A),!,B=A. +do_control_1arg_type(_Max,F/_, N,_Pre,A,B):- arg_n_isa(F,N,ISA),into_type(ISA,A,B),!. +do_control_1arg_type(Max,FofN,_,Pre,A,B):- + Max0 is Max-1, control_arg_types1(Max0,[FofN|Pre],A,B). + + +%arg_n_isa(_F,_N,_ISA):- fail. +arg_n_isa(F,N,ISA):- clause_b(argIsa(F,N,ISA)). + +save_pfc_state:- + %tell(pfcState), + forall((pfcStateTerm(F/A),current_predicate(F/A)),listing(F/A)), + %told. + !. + +pfcDoAll(Goal):- forall(call(Goal),true). + +pfcStateTerm(F/A):- pfcDatabaseTerm(F/A). +pfcStateTerm(F/A):- + member((F/A),[ + fcUndoMethod/2, + fcAction/2, + fcTmsMode/1, + pfcQueue/1, + pfcCurrentDb/1, + pfcHaltSignal/1, + pfcDebugging/0, + pfcSelect/1, + pfcSearch/1]). + + + +:- if(( current_prolog_flag(xref,true) ; + ('$current_source_module'(SM),'context_module'(M),'$current_typein_module'(CM), + current_prolog_flag(pfc_shared_module,BaseKB),asserta(BaseKB:'wusing_pfc'(M,CM,SM,pfc_rt))))). +:- endif. +:- if(current_prolog_flag(xref,true)). +%:- module(pfc_rt,[]). +:- endif. +:- if((prolog_load_context(source,File),prolog_load_context(file,File))). +%:- prolog_load_context(file,File),unload_file(File). +:- use_module(library(logicmoo_utils)). +:- endif. +%:- pfc_lib:use_module(pfc_lib). +:- if( \+ current_prolog_flag(xref,true)). +:- current_prolog_flag(pfc_shared_module,BaseKB), + must_ex(retract(BaseKB:'wusing_pfc'(M,CM,SM,pfc_rt))), + nop(fbugio(BaseKB:'chusing_pfc'(M,CM,SM,pfc_rt))), + (M==SM -> + (nop(maybe_ensure_abox(SM)),nop((M:ain(genlMt(SM,BaseKB))))); + nop(fbugio(BaseKB:'lusing_pfc'(M,CM,SM,pfc_rt)))), + assert(BaseKB:'$using_pfc'(M,CM,SM,pfc_rt)), + asserta(SM:'$does_use_pfc_mod'(M,CM,SM,pfc_rt)). + %backtrace(200). + +/* +:- multifile '$exported_op'/3. +:- dynamic '$exported_op'/3. +:- discontiguous '$exported_op'/3. +'$exported_op'(_,_,_):- fail. +*/ + +:- multifile '$pldoc'/4. +:- dynamic '$pldoc'/4. +:- discontiguous '$pldoc'/4. +'$pldoc'(_,_,_,_):- fail. + +:- multifile '$autoload'/3. +:- discontiguous '$autoload'/3. +:- dynamic '$autoload'/3. +'$autoload'(_,_,_):- fail. + +:- system:use_module(library(make)). +%:- set_prolog_flag(retry_undefined, kb_shared). +%:- set_prolog_flag(pfc_ready, true). +:- set_prolog_flag(expect_pfc_file,unknown). +:- endif. + +:- ifprolog:import(date:day_of_the_week/2). +:- ifprolog:import(date:day_of_the_year/2). + + +tilded_negation. + +bagof_or_nil(T,G,L):- bagof(T,G,L)*->true;L=[]. +setof_or_nil(T,G,L):- setof(T,G,L)*->true;L=[]. + +call_u(G):- pfcCallSystem(G). +clause_u(H,B):- clause(H,B). + +mpred_ain(P):- arc_assert(P). +arc_assert(P:-True):- True==true,!,arc_assert(P). +arc_assert(P):- % fbugio(arc_assert(P)), + must_ex(current_why_UU(UU)),nop(fbugio(pfcAdd(P, UU))),!, +(P, UU),asserta_if_new(P). + +pfc_retract(P):- fbugio(pfc_retract(P)),pfcRetract(P). +pfc_retractall(P):- fbugio(pfc_retractall(P)),pfcRetractAll(P). + +:- dynamic((~)/1). +~(_):- fail. + +add(X):- pfcAdd(X). + + +mpred_test(call_u(X)):- nonvar(X),!,pfcCallSystem(X),pfcWhy(X). +mpred_test(\+ call_u(X)):- nonvar(X),!, (call_u(X)-> (fbugio(warn(failed(mpred_test(\+ call_u(X))))),mpred_test_why(X)); mpred_test_why(~(X))). +mpred_test(X):- (mpred_test_why(X) *-> true ; mpred_test_why(~(X))). + +:- thread_local t_l:shown_child/1. +:- thread_local t_l:shown_dep/2. + +pfc_info(X):- mpred_info(X). +mpred_info(X):- + retractall(t_l:shown_child(_)), + retractall(t_l:shown_dep(_,_)), + ignore(( + forall(mpred_test_why(X),true), + forall(mpred_child_info(X),true))). + +mpred_child_info(P):- + retractall(t_l:shown_child(_)), + show_child_info(P),!, + printLine. + +show_child_info(P):- + pfcChildren(P,L), + show_child_info(P,L),!. + +show_child_info(P,_):- t_l:shown_child(Q),P=@=Q,!. +show_child_info(P,_):- asserta(t_l:shown_child(P)),fail. +show_child_info(_,[]):-!. +show_child_info(P,L):- list_to_set(L,S), + format("~N~nChildren for ",[]), + ansi_format([fg(green)],'~@',[pp(P)]), + format(" :~n",[]), + forall((member(D,S), \+ t_l:shown_dep(P,D)),(asserta(t_l:shown_dep(P,D)),ansi_format([fg(yellow)],'~N ~@. ~n',[pp(D)]))), + my_maplist(show_child_info,S). + +mpred_why(X):- mpred_test_why(X). + +mpred_test_why(X):- + pfcCallSystem(X)*->pfcTF1(X);(pfcTF1(X),!,fail). + +mpred_literal(X):- pfcLiteral(X). +mpred_positive_literal(X):- pfcPositiveLiteral(X). +pfcAtom(X):- pfcLiteral(X). +rem(X):- pfcWithdraw(X). +rem2(X):- pfcRemove(X). +remove(X):- pfcBlast(X). + +% :- mpred_ain_in_thread. +% :- current_thread_pool(ain_pool)->true;thread_pool_create(ain_pool,20,[]). +:- multifile thread_pool:create_pool/1. +:- dynamic thread_pool:create_pool/1. +thread_pool:create_pool(ain_pool) :- + thread_pool_create(ain_pool, 50, [detached(true)] ). + +:- use_module(library(http/thread_httpd)). +:- use_module(library(thread_pool)). + +is_ain_pool_empty:- thread_pool_property(ain_pool,running(N)),!,N==0. +is_ain_pool_empty. + +show_ain_pool:- forall(thread_pool_property(ain_pool,PP),fmt(show_ain_pool(PP))). + +await_ain_pool:- is_ain_pool_empty->true;(repeat, sleep(0.005), is_ain_pool_empty). + +ain_in_thread(MAIN):- strip_module(MAIN,M,AIN), call_in_thread(M:pfcAdd(AIN)). + +call_in_thread(MG):- strip_module(MG,M,G), notrace((copy_term(M:G,GG,_),numbervars(GG,0,_,[attvar(skip),singletons(true)]),term_to_atom(GG,TN))), + call_in_thread(TN,M,G), + dmsg_pretty(call_in_thread(TN,M,G)). + +call_in_thread(TN,M,G):- thread_property(_,alias(TN)),!,dmsg_pretty(already_queued(M,G)). +call_in_thread(TN,M,G):- must_ex(current_why(Why)), thread_create_in_pool(ain_pool,call_in_thread_code(M,G,Why,TN),_Id,[alias(TN)]). + +call_in_thread_code(M,G,Why,TN):- + with_only_current_why(Why, + catch(( M:G-> nop(dmsg_pretty(suceeded(exit,TN)));dmsg_pretty(failed(exit,TN))),E, dmsg_pretty(error(E-->TN)))). + +%:- call_in_thread(fbugio(call_in_thread)). +% why_dmsg(Why,Msg):- with_current_why(Why,dmsg_pretty(Msg)). + +% File : pfc +% Author : Tim Finin, finin@umbc.edu +% Updated: 10/11/87, ... +% Purpose: consult system file for ensure + +pfcVersion(3.0). + +/* +pfcFile('pfcsyntax'). % operator declarations. +pfcFile('pfccore'). % core of Pfc. +pfcFile('pfcsupport'). % support maintenance +pfcFile('pfcdb'). % predicates to manipulate database. +pfcFile('pfcdebug'). % debugging aids (e.g. tracing). +pfcFile('pfcjust'). % predicates to manipulate justifications. +pfcFile('pfcwhy'). % interactive exploration of justifications. + +pfcLoad :- pfcFile(F), ensure_loaded(F), fail. +pfcLoad. +*/ + +%pfcFcompile :- pfcFile(F), compile(F), fail. +%pfcFcompile. + +%:- pfcLoad. + +% File : pfccompile.pl +% Author : Tim Finin, finin@prc.unisys.com +% Updated: 10/11/87, ... +% Purpose: compile system file for Pfc +/* +:- compile(pfcsyntax). +:- compile(pfccore). +:- compile(pfcdb). +:- compile(pfcjust). +:- compile(pfcwhy). +:- compile(pfcdebug). +*/ + +% File : pfcsyntax.pl +% Author : Tim Finin, finin@prc.unisys.com +% Purpose: syntactic sugar for Pfc - operator definitions and term expansions. + +:- op(500,fx,'~'). +:- op(1050,xfx,('==>')). +:- op(1050,xfx,'<==>'). +:- op(1050,xfx,('<-')). +:- op(1100,fx,('==>')). +:- op(1150,xfx,('::::')). + + +:- dynamic(pfctmp:knows_will_table_as/2). + +will_table_as(Stuff,As):- pfctmp:knows_will_table_as(Stuff,As),!. +will_table_as(Stuff,As):- assert(pfctmp:knows_will_table_as(Stuff,As)), + must_ex(react_tabling(Stuff,As)),!,fail. + +react_tabling(Stuff,_):- dynamic(Stuff). + +:- dynamic(lmconf:is_treated_like_pfc_file/1). +:- dynamic(lmconf:is_pfc_module/1). +if_pfc_indicated :- source_location(F,_),(sub_string(F, _, _, _, '.pfc')->true;lmconf:is_treated_like_pfc_file(F)),!. +if_pfc_indicated :- prolog_load_context(module, M),lmconf:is_pfc_module(M),!. + +skip_pfc_term_expansion(Var):- var(Var),!. +skip_pfc_term_expansion(begin_of_file). +skip_pfc_term_expansion(end_of_file). + +:- export(pfc_term_expansion/2). +:- system:import(pfc_term_expansion/2). +pfc_term_expansion(I,O):- skip_pfc_term_expansion(I),!, I=O. +pfc_term_expansion((:- table Stuff as Type), [:- pfcAdd(tabled_as(Stuff,Type)),(:- table Stuff as Type)]):- nonvar(Stuff), !, if_pfc_indicated, \+ will_table_as(Stuff, Type). +pfc_term_expansion((:- table Stuff ), [:- pfcAdd(tabled_as(Stuff,incremental)),(:- table Stuff as incremental)]):- if_pfc_indicated, \+ will_table_as(Stuff,incremental). +pfc_term_expansion((:- _),_):- !, fail. +pfc_term_expansion((P==>Q),(:- pfcAdd((P==>Q)))). +%term_expansion((P==>Q),(:- pfcAdd(('<-'(Q,P))))). % speed-up attempt +pfc_term_expansion(('<-'(P,Q)),(:- pfcAdd(('<-'(P,Q))))). +pfc_term_expansion((P<==>Q),(:- pfcAdd((P<==>Q)))). +pfc_term_expansion((RuleName :::: Rule),(:- pfcAdd((RuleName :::: Rule)))). +pfc_term_expansion((==>P),(:- pfcAdd(P))). +pfc_term_expansion(I,I):- I == end_of_file,!. +pfc_term_expansion( P ,(:- pfcAdd(P))):- if_pfc_indicated. + +%use_pfc_term_expansion:- current_prolog_flag(pfc_term_expansion,false),!,fail. +% maybe switch to prolog_load_context(file,...)? +%use_pfc_term_expansion:- source_location(File,_), atom_concat(_,'.pfc.pl',File). + +term_subst(P,O):- term_subst(clause,P,O),!. + +term_subst(_, P,O):- \+ compound(P),!,O=P. + +term_subst(tilded_negation,P,O):- !, term_subst( + [(not)-(~), + (=>)-(==>), + (<=>)-(<==>), + (<=)-(<-)],P,O). + +term_subst(Subst,P,O):- + compound_name_arguments(P,F,Args), + my_maplist(term_subst(Subst),Args,ArgsL), + termf_subst(Subst,F,F2), + compound_name_arguments(O,F2,ArgsL). + +termf_subst(Subst,F,F2):-member(F-F2,Subst)->true;F=F2. + + +% File : pfccore.pl +% Author : Tim Finin, finin@prc.unisys.com +% Updated: 10/11/87, ... +% 4/2/91 by R. McEntire: added calls to valid_dbref as a +% workaround for the Quintus 3.1 +% bug in the recorded database. +% Purpose: core Pfc predicates. + +:- use_module(library(lists)). + + +%==>(_). + +% ==>(G):- arc_assert(G). + +%:- multifile ('<-')/2. +%:- dynamic ('<-')/2. +%:- discontiguous(('<-')/2). +%'<-'(_,_). + +%:- multifile ('==>')/2. +%:- dynamic ('==>')/2. +%:- discontiguous(('==>')/2). +%'==>'(_,_). + +%:- multifile ('==>')/2. +%:- dynamic ('::::')/2. +%:- dynamic '<==>'/2. +:- dynamic '$pt$'/2. +:- dynamic '$nt$'/3. +:- dynamic '$bt$'/2. +:- dynamic fcUndoMethod/2. +:- dynamic fcAction/2. +:- dynamic fcTmsMode/1. +:- dynamic pfcQueue/1. +:- dynamic pfcCurrentDb/1. +:- dynamic pfcHaltSignal/1. +:- dynamic pfcDebugging/0. +:- dynamic pfcSelect/1. +:- dynamic pfcSearch/1. + +:- thread_local(t_l:pfcSearchTL/1). + +:- dynamic '$spft$'/3. + +% % % initialization of global assertons + +pfcSetVal(Stuff):- + duplicate_term(Stuff,DStuff), + functor(DStuff,_,N), + setarg(N,DStuff,_), + retractall(DStuff), + assert(Stuff). + +% % pfcDefault/1 initialized a global assertion. +% % pfcDefault(P,Q) - if there is any fact unifying with P, then do +% % nothing, else assert Q. + +pfcDefault(GeneralTerm,Default) :- + clause(GeneralTerm,true) -> true ; assert(Default). + +% % fcTmsMode is one of {none,local,cycles} and controles the tms alg. +:- pfcDefault(fcTmsMode(_), fcTmsMode(cycles)). + +% Pfc Search strategy. pfcSearch(X) where X is one of {direct,depth,breadth} +:- pfcDefault(pfcSearch(_), pfcSearch(direct)). + + +% + +% % pfcAdd/2 and pfcPost/2 are the main ways to assert new clauses into the +% % database and have forward reasoning done. + +% % pfcAdd(P,S) asserts P into the dataBase with support from S. + +pfcAdd(P) :- must_ex(current_why_UU(UU)), + pfcAdd(P, UU). + +%pfcAdd(P) :- must_ex(current_why_UU(UU)),%with_current_why(pfcAdd(P), pfcAdd(P, UU)). + +pfcAdd((==>P),S) :- !, pfcAdd(P,S). + +pfcAdd(P,S) :- + pfcPost(P,S), + pfcRun,!. + +%pfcAdd(_,_). +pfcAdd(P,S) :- pfcWarn("pfcAdd(~p,~p) failed",[P,S]). + + +% pfcPost(+Ps,+S) tries to add a fact or set of fact to the database. For +% each fact (or the singelton) pfcPost1 is called. It always succeeds. + +pfcPost(List,S):- pfcPost_rev(S,List). + +pfcPost_rev(S,Term) :- + is_list(Term) + -> my_maplist(pfcPost_rev(S),Term) + ; pfcPost1(Term,S). + + +% pfcPost1(+P,+S) tries to add a fact to the database, and, if it succeeded, +% adds an entry to the pfc queue for subsequent forward chaining. +% It always succeeds. + +pfcPost1(Fact,S) :- control_arg_types(Fact,Fixed),!,pfcPost1(Fixed,S). + + +pfcPost1(P,S):- + locally(set_prolog_flag(occurs_check, true), + catch(pfcPost11(P,S),E,(notrace,wdmsg(P => E),trace))). + +pfcPost11(P,S) :- + % % db pfcAddDbToHead(P,P2), + % pfcRemoveOldVersion(P), + must_ex(pfcAddSupport(P,S)), + (pfcUnique(post, P)-> pfcPost2(P,S) ; nop(pfcWarn(not_pfcUnique(post, P)))). + +pfcPost2(P,S):- + must_ex(once(\+ \+ is_asserted_exact(P);assert(P))), + must_ex(pfcTraceAdd(P,S)), + !, + must_ex(pfcEnqueue(P,S)), + !. + +is_asserted_exact(MH,B):- + strip_module(MH,M,H), + is_asserted_exact(M,H,B). +is_asserted_exact(MHB):- + strip_module(MHB,M,HB), + expand_to_hb(HB,H,B), + is_asserted_exact(M,H,B). +is_asserted_exact(M,H,B):- + M=MM, + (MM:clause(M:H,B,Ref)*->true; M:clause(MM:H,B,Ref)), + %clause_ref_module(Ref), + clause_property(Ref,module(MM)), + %module_checks_out + is_asserted_exact(MM,H,B,Ref). +is_asserted_exact(_,H,B,Ref):- + clause(CH,CB,Ref),strip_m(CH,HH),HH=@=H,strip_m(CB,BB),cl(HH,BB)=@=cl(H,B). + + + +%pfcPost1(_,_). +%pfcPost1(P,S) :- + %pfcWarn("pfcPost1: ~p\n (support: ~p) failed",[P,S]). + +% % pfcAddDbToHead(+P,-NewP) is semidet. +% talkes a fact P or a conditioned fact +% (P:-C) and adds the Db context. +% + +pfcAddDbToHead(P,NewP) :- + pfcCallSystem(pfcCurrentDb(Db)), + (Db=true -> NewP = P; + P=(Head:-Body) -> NewP = (Head :- (Db,Body)); + true -> NewP = (P :- Db)). + +:- dynamic(pfcCurrentDb/1). +pfcCurrentDb(true). + +% % pfcUnique(X) is det. +% +% is true if there is no assertion X in the prolog db. +% + +pfcUnique(Type,(Head:-Tail)) :- !,pfcUnique(Type,Head,Tail). +pfcUnique(Type, P) :- pfcUnique(Type,P,true). + +%pfcUnique(post,Head,Tail):- !, \+ is_clause_asserted(Head,Tail). +pfcUnique(_,Head,Tail):- \+ is_asserted_exact(Head,Tail),!. +/* +pfcUnique(_,H,B):- \+ is_asserted(H,B),!. +pfcUnique(_,H,B):- \+ ( + clause(H, B, Ref), + clause(HH, BB, Ref), + strip_m(HH, HHH), + HHH=@=H, + strip_m(BB, BBB), + BBB=@=B). +*/ + + +% % pfcEnqueue(P,Q) is det. +% +% Enqueu according to settings +% +pfcSetSearch(Mode):- pfcSetVal(pfcSearch(Mode)). + +pfcGetSearch(Mode):- (t_l:pfcSearchTL(ModeT)->true;pfcSearch(ModeT))->Mode=ModeT. + +pfcEnqueue(P,S) :- pfcGetSearch(Mode),!, + pfcEnqueue(Mode,P,S). +pfcEnqueue(P,S) :- pfcWarn("No pfcSearch mode"), + pfcEnqueue(direct,P,S). + +pfcEnqueue(Mode,P,S):- + Mode=direct -> pfcFwd(P) ; + Mode=thread -> pfcThreadFwd(P,S) ; + Mode=depth -> pfcAsserta(pfcQueue(P),S) ; + Mode=breadth -> pfcAssert(pfcQueue(P),S) ; + true -> pfcWarn("Unrecognized pfcSearch mode: ~p", Mode),pfcEnqueue(direct,P,S). + + + +% % pfcRemoveOldVersion(+Rule) is det. +% +% if there is a rule of the form Identifier ::: Rule then delete it. + +pfcRemoveOldVersion((Identifier::::Body)) :- + % this should never happen. + (var(Identifier) + -> + pfcWarn("variable used as an rule name in ~p :::: ~p", + [Identifier,Body]); + pfcRemoveOldVersion0(Identifier::::Body)). + + +pfcRemoveOldVersion0((Identifier::::Body)) :- + nonvar(Identifier), + clause((Identifier::::OldBody),_), + \+(Body=OldBody), + pfcWithdraw((Identifier::::OldBody)), + !. +pfcRemoveOldVersion0(_). + + +% % with_fc_mode(+Mode,:Goal) is semidet. +% +% Temporariliy changes to forward chaining propagation mode while running the Goal +% +with_fc_mode(Mode,Goal):- locally(t_l:pfcSearchTL(Mode),Goal). + + +pfcThreadFwd(S,P):- + with_only_current_why(S, + % maybe keep `thread` mode? + call_in_thread(with_fc_mode(thread, (pfcFwd(P))))). + +% in_fc_call(Goal):- with_fc_mode( thread, Goal). +%in_fc_call(Goal):- with_fc_mode( direct, Goal). +% in_fc_call(Goal):- !, pfcCallSystem(Goal). + + + + +% + +% pfcRun compute the deductive closure of the current database. +% How this is done depends on the searching mode: +% direct - fc has already done the job. +% depth or breadth - use the pfcQueue mechanism. + +pfcRun :- + (\+ pfcGetSearch(direct)), + pfcStep, + pfcRun. +pfcRun. + + +% pfcStep removes one entry from the pfcQueue and reasons from it. + + +pfcStep :- + % if pfcHaltSignal(Msg) is true, reset it and fail, thereby stopping inferencing. + pfcRetract(pfcHaltSignal(Msg)), + pfcTraceMsg(removing(pfcHaltSignal(Msg))), + !, + fail. + +pfcStep :- + % draw immediate conclusions from the next fact to be considered. + % fails iff the queue is empty. + get_next_fact(P), + pfcdo(pfcFwd(P)), + !. + +get_next_fact(P) :- + %identifies the nect fact to fc from and removes it from the queue. + select_next_fact(P), + remove_selection(P). + +remove_selection(P) :- + pfcRetract(pfcQueue(P)), + pfcRemoveSupportsQuietly(pfcQueue(P)), + !. +remove_selection(P) :- + brake(pfcPrintf("pfc:get_next_fact - selected fact not on Queue: ~p", + [P])). + + +% select_next_fact(P) identifies the next fact to reason from. +% It tries the user defined predicate first and, failing that, +% the default mechanism. + +select_next_fact(P) :- + pfcSelect(P), + !. +select_next_fact(P) :- + defaultpfcSelect(P), + !. + +% the default selection predicate takes the item at the froint of the queue. +defaultpfcSelect(P) :- pfcCallSystem(pfcQueue(P)),!. + +% pfcHalt stops the forward chaining. +pfcHalt :- pfcHalt("unknown_reason",[]). + +pfcHalt(Format) :- pfcHalt(Format,[]). + +pfcHalt(Format,Args) :- + format(string(Msg),Format,Args), + (pfcHaltSignal(Msg) -> + pfcWarn("pfcHalt finds pfcHaltSignal(~w) already set",[Msg]) + ; assert(pfcHaltSignal(Msg))). + + +% % +% % +% % predicates for manipulating triggers +% % + +pfcAddTrigger('$pt$'(Trigger,Body),Support) :- + !, + pfcTraceMsg(' Adding positive trigger(+) ~p~n', + ['$pt$'(Trigger,Body)]), + pfcAssert('$pt$'(Trigger,Body),Support), + copy_term('$pt$'(Trigger,Body),Tcopy), + pfc_call(Trigger), + with_current_why(Trigger,fcEvalLHS(Body,(Trigger,Tcopy))), + fail. + + +pfcAddTrigger('$nt$'(Trigger,Test,Body),Support) :- + !, + pfcTraceMsg(' Adding negative trigger(-): ~p~n test: ~p~n body: ~p~n', + [Trigger,Test,Body]), + copy_term(Trigger,TriggerCopy), + pfcAssert('$nt$'(TriggerCopy,Test,Body),Support), + \+ pfc_call(Test), + with_current_why(\+ pfc_call(Test), fcEvalLHS(Body,((\+Trigger),'$nt$'(TriggerCopy,Test,Body)))). + +pfcAddTrigger('$bt$'(Trigger,Body),Support) :- + !, + pfcAssert('$bt$'(Trigger,Body),Support), + pfcBtPtCombine(Trigger,Body,Support). + +pfcAddTrigger(X,_Support) :- + pfcWarn("Unrecognized trigger(?) to pfcAddtrigger: ~p",[X]). + + +pfcBtPtCombine(Head,Body,Support) :- + % % a backward trigger(?) ('$bt$') was just added with head and Body and support Support + % % find any '$pt$'(s) with unifying heads and add the instantied '$bt$' body. + pfcGetTriggerQuick('$pt$'(Head,_PtBody)), + fcEvalLHS(Body,Support), + fail. +pfcBtPtCombine(_,_,_) :- !. + +pfcGetTriggerQuick(Trigger) :- clause(Trigger,true)*->true;pfc_call(Trigger). +pfcCallSystem(Trigger) :- pfc_call(Trigger). + +% % +% % +% % predicates for manipulating action traces. +% % + +pfcAddActionTrace(Action,Support) :- + % adds an action trace and it''s support. + pfcAddSupport(pfcAction(Action),Support). + +pfcRemActionTrace(pfcAction(A)) :- + fcUndoMethod(A,UndoMethod), + pfcCallSystem(UndoMethod), + !. + + +% % +% % predicates to remove pfc facts, triggers, action traces, and queue items +% % from the database. +% % + +pfcRetract(X) :- + % % retract an arbitrary thing. + pfcType(X,Type), + pfcRetractType(Type,X), + !. + +pfcRetractType(fact(_),X) :- + % % db + pfcAddDbToHead(X,X2)-> retract(X2) ; retract(X). + +pfcRetractType(rule(_),X) :- + % % db + pfcAddDbToHead(X,X2) -> retract(X2) ; retract(X). + +pfcRetractType(trigger(Pos),X) :- + retract(X) + -> unFc(X) + ; pfcWarn("Trigger(~p) not found to retract: ~p",[Pos,X]). + +pfcRetractType(action,X) :- pfcRemActionTrace(X). + + +% % pfcAddType1(X) adds item X to some database + +pfcAddType1(X) :- + % what type of X do we have? + pfcType(X,Type), + pfcAddDbToHead(X,X2), + % call the appropriate predicate. + pfcAddType(Type,X2). + +pfcAddType(fact(Type),X) :- + pfcUnique(fact(Type),X), + assert(X),!. +pfcAddType(rule(Type),X) :- + pfcUnique(rule(Type),X), + assert(X),!. +pfcAddType(trigger(Pos),X) :- + pfcUnique(trigger(Pos),X) -> assert(X) ; + (pfcWarn(not_pfcUnique(X)),assert(X)). + +pfcAddType(action,_Action) :- !. + + + + +% pfcWithdraw/1 withdraws any "direct" support for P. +% If a list, iterates down the list +pfcWithdraw(P) :- is_list(P),!,my_maplist(pfcWithdraw,P). +pfcWithdraw(P) :- matches_why_UU(UU), pfcWithdraw(P,UU). +% % pfcWithdraw(P,S) removes support S from P and checks to see if P is still supported. +% % If it is not, then the fact is retractred from the database and any support +% % relationships it participated in removed. +pfcWithdraw(P,S) :- + % pfcDebug(pfcPrintf("removing support ~p from ~p",[S,P])), + pfcGetSupport(P,S), + matterialize_support_term(S,Sup), + pfcTraceMsg(' Withdrawing direct support: ~p \n From: ~p~n',[Sup,P]), + (pfcRemOneSupportOrQuietlyFail(P,S) + -> pfcTraceMsg(' Success removing support: ~p \n From: ~p~n',[Sup,P]) + ; pfcWarn("pfcRemOneSupport/2 Could not find support ~p thus\n Did not pfcRemOneSupport: ~p", + [Sup,P])), + removeIfUnsupported(P). + +pfcWithdraw(P,S) :- + matterialize_support_term(S,Sup), + pfcTraceMsg(' No support matching: ~p \n For: ~p~n',[Sup,P]),!, + removeIfUnsupported(P). + +% pfcRetractAll/1 withdraws any "direct" and "indirect" support for P. +% If a list, iterates down the list +pfcRetractAll(P) :- is_list(P),!,my_maplist(pfcRetractAll,P). +pfcRetractAll(P) :- matches_why_UU(UU), pfcRetractAll(P,UU). + +% % pfcRetractAll(P,S) removes support S from P and checks to see if P is still supported. +% % If it is not, then the fact is retreactred from the database and any support +% % relationships it participated in removed. + +pfcRetractAll(Fact,S) :- control_arg_types(Fact,Fixed),!,pfcRetractAll(Fixed,S). +pfcRetractAll(P,S) :- + \+ \+ pfcWithdraw(P,S), + fail. +pfcRetractAll(P,S) :- + pfcGetSupport(P,(P2,_)), + pfcType(P2,fact(_)), + pfcSupportedBy(P2,S,_How), + pfcRetractAll(P2), + \+ fcSupported(P),!, + fcUndo(P). +pfcRetractAll(P,S) :- + pfcGetSupport( P,(_,T)), + pfcGetSupport(T,(P2,_)), + pfcSupportedBy(P2,S,_How), + pfcType(P2,fact(_)), + pfcRetractAll(P2), + \+ fcSupported(P),!, + fcUndo(P). +pfcRetractAll(P,S) :- + fcSupported(P), + pfcGetSupport(P,(P2,_)), + pfcSupportedBy(P2,S,_How), + pfcType(P2,rule(_)), + pfcRetractAll(P2), + \+ fcSupported(P), + fcUndo(P),!. +pfcRetractAll(P,_S0) :- + removeIfUnsupported(P), + fail. +pfcRetractAll(_,_). + + +pfcSupportedBy(P,S,How):- + pfcGetSupport(P,(F,T)), + (pfcSupportedBy(F,S,_)->How=F; + pfcSupportedBy(T,S,How)). + +pfcSupportedBy(P,S,How):-P=S,How=S. + +pfcRetractAll_v2(P,S0) :- + \+ \+ pfcWithdraw(P,S0), + pfcGetSupport(P,(S,RemoveIfTrigger)), + % pfcDebug(pfcPrintf("removing support ~p from ~p",[S,P])), + matterialize_support_term((S,RemoveIfTrigger),Sup), + pfcTraceMsg(' Removing support: ~p \n From: ~p~n',[Sup,P]), + (pfcRemOneSupportOrQuietlyFail(P,(S,RemoveIfTrigger)) + -> pfcTraceMsg(' Success removing support: ~p \n From: ~p~n',[Sup,P]) + ; (pfcWarn("pfcRemOneSupport/2 Could not find support ~p thus\n Did not yet pfcRetractAll_v2: ~p", + [Sup,P]))), + pfcRetractAll_v2(S, S0), + fail. + +pfcRetractAll_v2(P,_):- removeIfUnsupported(P). + +% pfcRemove/1 is the user''s interface - it withdraws user support for P. +% +% pfcRemove is like pfcRetractAll, but if P is still in the DB after removing the +% user's support, it is retracted by more forceful means (e.g. pfcBlast). +% +pfcRemove(Fact) :- control_arg_types(Fact,Fixed),!,pfcRemove(Fixed). +pfcRemove(P) :- + pfcRetractAll(P), + pfc_call(P) + -> pfcBlast(P) + ; true. + + +% % pfcBlast(+F) is det +% +% retracts fact F from the DB and removes any dependent facts +% + +pfcBlast(F) :- + pfcRemoveSupports(F), + fcUndo(F). + + +% removes any remaining supports for fact F, complaining as it goes. + +pfcRemoveSupports(F) :- + pfcRemOneSupport(F,S), + pfcWarn("~p was still supported by ~p (but no longer)",[F,S]), + fail. +pfcRemoveSupports(_). + +pfcRemoveSupportsQuietly(F) :- + pfcRemOneSupport(F,_), + fail. +pfcRemoveSupportsQuietly(_). + +% fcUndo(X) undoes X. + + +fcUndo(pfcAction(A)) :- + % undo an action by finding a method and successfully executing it. + !, + pfcRemActionTrace(pfcAction(A)). + +fcUndo('$pt$'(/*Key,*/Head,Body)) :- + % undo a positive trigger(+). + % + !, + (retract('$pt$'(/*Key,*/Head,Body)) + -> unFc('$pt$'(Head,Body)) + ; pfcWarn("Trigger not found to retract: ~p",['$pt$'(Head,Body)])). + +fcUndo('$nt$'(Head,Condition,Body)) :- + % undo a negative trigger(-). + !, + (retract('$nt$'(Head,Condition,Body)) + -> unFc('$nt$'(Head,Condition,Body)) + ; pfcWarn("Trigger not found to retract: ~p",['$nt$'(Head,Condition,Body)])). + +fcUndo(Fact) :- + % undo a random fact, printing out the trace, if relevant. + retract(Fact), + pfcTraceRem(Fact), + unFc(Fact). + + +% % unFc(P) is det. +% +% unFc(P) "un-forward-chains" from fact f. That is, fact F has just +% been removed from the database, so remove all dependant relations it +% participates in and check the things that they support to see if they +% should stayu in the database or should also be removed. + + +unFc(F) :- + pfcRetractDependantRelations(F), + unFc1(F). + +unFc1(F) :- + pfcUnFcCheckTriggers(F), + % is this really the right place for pfcRun pfcRemOneSupport(P,(_,Fact)) + ; pfcRemOneSupportOrQuietlyFail(P,(Fact,_))), + removeIfUnsupported(P), + fail. +pfcRetractDependantRelations(_). + + + +% % removeIfUnsupported(+P) checks to see if P is supported and removes +% % it from the DB if it is not. + +removeIfUnsupported(P) :- + fcSupported(P) -> pfcTraceMsg(fcSupported(P)) ; fcUndo(P). + + +% % fcSupported(+P) succeeds if P is "supported". What this means +% % depends on the TMS mode selected. + +fcSupported(P) :- + must_ex(fcTmsMode(Mode)), + supported(Mode,P). + +supported(local,P) :- !, pfcGetSupport(P,_). +supported(cycles,P) :- !, wellFounded(P). +supported(_,_P) :- true. + + +% % +% % a fact is well founded if it is supported by the user +% % or by a set of facts and a rules, all of which are well founded. +% % + +wellFounded(Fact) :- wf(Fact,[]). + +wf(F,_) :- + % supported by user (axiom) or an "absent" fact (assumption). + (axiom(F) ; assumption(F)), + !. + +wf(F,Descendants) :- + % first make sure we aren't in a loop. + (\+ memberchk(F,Descendants)), + % find a justification. + supports(F,Supporters), + % all of whose members are well founded. + wflist(Supporters,[F|Descendants]), + !. + +% % wflist(L) simply maps wf over the list. + +wflist([],_). +wflist([X|Rest],L) :- + wf(X,L), + wflist(Rest,L). + + + +% supports(+F,-ListofSupporters) where ListOfSupports is a list of the +% supports for one justification for fact F -- i.e. a list of facts which, +% together allow one to deduce F. One of the facts will typically be a rule. +% The supports for a user-defined fact are: [user]. + +supports(F,[Fact|MoreFacts]) :- + pfcGetSupport(F,(Fact,Trigger)), + triggerSupports(Trigger,MoreFacts). + +triggerSupports(U,[]) :- axiomatic_supporter(U),!. + +triggerSupports(Trigger,AllSupport):- + triggerSupports1(Trigger,AllSupport)*->true;triggerSupports2(Trigger,AllSupport). + +triggerSupports1(Trigger,AllSupport) :- + pfcGetSupport(Trigger,(Fact,AnotherTrigger)), + (triggerSupports(AnotherTrigger,MoreFacts)*->true;MoreFacts=[AnotherTrigger]), + [Fact|MoreFacts] = AllSupport. + +triggerSupports2(Trigger,AllSupport) :- fail, + pfcGetSupport(Trigger,(Fact,AnotherTrigger)), + (triggerSupports(AnotherTrigger,MoreFacts)*->true;MoreFacts=[AnotherTrigger]), + [Fact|MoreFacts] = AllSupport. + +axiomatic_supporter(Var):-is_ftVar(Var),!,fail. +axiomatic_supporter(is_ftVar(_)). +axiomatic_supporter(clause_u(_)). +axiomatic_supporter(user(_)). +axiomatic_supporter(U):- is_file_ref(U),!. +axiomatic_supporter(ax):-!. + +is_file_ref(A):-compound(A),A=mfl4(_VarNameZ,_,_,_). + +triggerSupports(_,Var,[is_ftVar(Var)]):-is_ftVar(Var),!. +triggerSupports(_,U,[]):- axiomatic_supporter(U),!. +triggerSupports(FactIn,Trigger,OUT):- + pfcGetSupport(Trigger,(Fact,AnotherTrigger))*-> + (triggerSupports(Fact,AnotherTrigger,MoreFacts),OUT=[Fact|MoreFacts]); + triggerSupports1(FactIn,Trigger,OUT). + +triggerSupports1(_,X,[X]):- may_cheat. +may_cheat:- true_flag. + + + +% % +% % +% % pfcFwd(X) forward chains from a fact or a list of facts X. +% % +pfcFwd(Fact) :- control_arg_types(Fact,Fixed),!,pfcFwd(Fixed). +pfcFwd(Fact):- locally(set_prolog_flag(occurs_check,true), pfcFwd0(Fact)). +pfcFwd0(Fact) :- is_list(List)->my_maplist(pfcFwd0,List);pfcFwd1(Fact). + +% fc1(+P) forward chains for a single fact. + + +pfcFwd1(Fact) :- + (fc_rule_check(Fact)*->true;true), + copy_term(Fact,F), + % check positive triggers + ignore(fcpt(Fact,F)), + % check negative triggers + ignore(fcnt(Fact,F)). + + +% % +% % fc_rule_check(P) does some special, built in forward chaining if P is +% % a rule. +% % + +fc_rule_check((Name::::P==>Q)) :- + !, + processRule(P,Q,(Name::::P==>Q)). +fc_rule_check((Name::::P<==>Q)) :- + !, + processRule(P,Q,((Name::::P<==>Q))), + processRule(Q,P,((Name::::P<==>Q))). + + + +fc_rule_check((P==>Q)) :- + !, + processRule(P,Q,(P==>Q)). +fc_rule_check((P<==>Q)) :- + !, + processRule(P,Q,(P<==>Q)), + processRule(Q,P,(P<==>Q)). + +fc_rule_check(('<-'(P,Q))) :- + !, + pfcDefineBcRule(P,Q,('<-'(P,Q))). + +fc_rule_check(_). + + +fcpt(Fact,F) :- + pfcGetTriggerQuick('$pt$'(F,Body)), + pfcTraceMsg('\n Found positive trigger(+):\n ~p~n body: ~p~n', + [F,Body]), + pfcGetSupport('$pt$'(F,Body),Support), %fbugio(pfcGetSupport('$pt$'(F,Body),Support)), + with_current_why(Support,with_current_why(Fact,fcEvalLHS(Body,(Fact,'$pt$'(F,Body))))), + fail. + +%fcpt(Fact,F) :- +% pfcGetTriggerQuick('$pt$'(presently(F),Body)), +% fcEvalLHS(Body,(presently(Fact),'$pt$'(presently(F),Body))), +% fail. + +fcpt(_,_). + +fcnt(_Fact,F) :- + pfc_spft(X,_,'$nt$'(F,Condition,Body)), + pfcCallSystem(Condition), + pfcRem_S(X,(_,'$nt$'(F,Condition,Body))), + fail. +fcnt(_,_). + + +% % pfcRem_S(P,S) removes support S from P and checks to see if P is still supported. +% % If it is not, then the fact is retreactred from the database and any support +% % relationships it participated in removed. +pfcRem_S(P,S) :- + % pfcDebug(pfcPrintf("removing support ~p from ~p",[S,P])), + pfcTraceMsg(' Removing support: ~p from ~p~n',[S,P]), + pfcRemOneSupport(P,S) + -> removeIfUnsupported(P) + ; pfcWarn("pfcRem_S/2 Could not find support ~p to remove from fact ~p", + [S,P]). + + + +% % pfcDefineBcRule(+Head,+Body,+ParentRule) +% +% defines a backward +% chaining rule and adds the corresponding '$bt$' triggers to the database. +% + +pfcDefineBcRule(Head,_Body,ParentRule) :- + (\+ pfcLiteral(Head)), + pfcWarn("Malformed backward chaining rule. ~p not atomic literal.",[Head]), + pfcError("caused by rule: ~p",[ParentRule]), + !, + fail. + +pfcDefineBcRule(Head,Body,ParentRule) :- + copy_term(ParentRule,ParentRuleCopy), + buildRhs(Head,Rhs), + current_why_U(USER), % @TODO REVIEW _U + pfcForEach(pfc_nf(Body,Lhs), + (buildTrigger(Lhs,rhs(Rhs),Trigger), + pfcAdd('$bt$'(Head,Trigger),(ParentRuleCopy,USER)))). +get_bc_clause(Head,(HeadC:- BodyC)):- get_bc_clause(Head,HeadC,BodyC). + +get_bc_clause(HeadIn, ~HeadC, Body):- compound(HeadIn), HeadIn = ~Head,!, + Body = ( awc, + ( nonvar(HeadC)-> (HeadC = Head,!) ; (HeadC = Head)), + pfc_bc_and_with_pfc(~Head)). +get_bc_clause(Head, Head, Body):- % % :- is_ftNonvar(Head). + Body = ( awc, !, pfc_bc_and_with_pfc(Head)). + +:- thread_initialization(nb_setval('$pfc_current_choice',[])). + +push_current_choice:- current_prolog_flag(pfc_support_cut,false),!. +push_current_choice:- prolog_current_choice(CP),push_current_choice(CP),!. +push_current_choice(CP):- nb_current('$pfc_current_choice',Was)->b_setval('$pfc_current_choice',[CP|Was]);b_setval('$pfc_current_choice',[CP]). + +cut_c:- current_prolog_flag(pfc_support_cut,false),!. +cut_c:- must_ex(nb_current('$pfc_current_choice',[CP|_WAS])),prolog_cut_to(CP). + + +% % +% % +% % eval something on the LHS of a rule. +% % + + +fcEvalLHS((Test->Body),Support) :- + !, + pfcDoAll(pfcCallSystem(Test) -> (fcEvalLHS(Body,Support))), + !. + +fcEvalLHS((Test*->Body),Support) :- + !, + pfcDoAll(pfcCallSystem(Test) *-> (fcEvalLHS(Body,Support))). + +fcEvalLHS(rhs(X),Support) :- + !, + pfcDoAll(pfc_eval_rhs(X,Support)), + !. + +fcEvalLHS(X,Support) :- + pfcType(X,trigger(_Pos)), + !, + pfcAddTrigger(X,Support), + !. + +%fcEvalLHS(snip(X),Support) :- +% snip(Support), +% fcEvalLHS(X,Support). + +fcEvalLHS(X,_) :- + pfcWarn("Unrecognized item found in trigger body, namely ~p.",[X]). + + +% % +% % eval something on the RHS of a rule. +% % + +pfc_eval_rhs([],_) :- !. +pfc_eval_rhs([Head|Tail],Support) :- + pfc_eval_rhs1(Head,Support), + pfc_eval_rhs(Tail,Support). + + +pfc_eval_rhs1(Fact,S) :- control_arg_types(Fact,Fixed),!,pfc_eval_rhs1(Fixed,S). + +pfc_eval_rhs1({Action},Support) :- + % evaluable Prolog code. + !, + fcEvalAction(Action,Support). + +pfc_eval_rhs1(P,_Support) :- + % predicate to remove. + pfcNegatedLiteral(P), + !, + pfcWithdraw(P). + +pfc_eval_rhs1([X|Xrest],Support) :- + % embedded sublist. + !, + pfc_eval_rhs([X|Xrest],Support). + +pfc_eval_rhs1(Assertion,Support) :- + % an assertion to be added. + once_writeq_ln(pfcRHS(Assertion)), + (must_ex(pfcPost1(Assertion,Support))*->true ; + pfcWarn("Malformed rhs of a rule: ~p",[Assertion])). + + +% % +% % evaluate an action found on the rhs of a rule. +% % + +fcEvalAction(Action,Support) :- + pfcCallSystem(Action), + (undoable(Action) + -> pfcAddActionTrace(Action,Support) + ; true). + + +% % +% % +% % + +trigger_trigger(Trigger,Body,_Support) :- + trigger_trigger1(Trigger,Body). +trigger_trigger(_,_,_). + + +%trigger_trigger1(presently(Trigger),Body) :- +% !, +% copy_term(Trigger,TriggerCopy), +% pfc_call(Trigger), +% fcEvalLHS(Body,(presently(Trigger),'$pt$'(presently(TriggerCopy),Body))), +% fail. + +trigger_trigger1(Trigger,Body) :- + copy_term(Trigger,TriggerCopy), + pfc_call(Trigger), + with_current_why(Trigger,fcEvalLHS(Body,(Trigger,'$pt$'(TriggerCopy,Body)))), + fail. + + +% % pfc_call(F) is nondet. +% +% pfc_call(F) is true iff F is a fact available for forward chaining. +% Note that this has the side effect of catching unsupported facts and +% assigning them support from God. +% + +%pfc_call(F) :- var(F), !, pfc_call(F). +pfc_call(P) :- var(P), !, pfcFact(P). +pfc_call(P) :- \+ callable(P), throw(pfc_call(P)). +pfc_call((!)) :-!,cut_c. +pfc_call(true):-!. +pfc_call((A->B;C)) :-!, pfc_call(A)->pfc_call(B);pfc_call(C). +pfc_call((A*->B;C)) :-!, pfc_call(A)*->pfc_call(B);pfc_call(C). +pfc_call((A->B)) :-!, pfc_call(A)->pfc_call(B). +pfc_call((A*->B)) :-!, pfc_call(A)*->pfc_call(B). +pfc_call((A,B)) :-!, pfc_call(A),pfc_call(B). +pfc_call((A;B)) :-!, pfc_call(A);pfc_call(B). +pfc_call(\+ (A)) :-!, \+ pfc_call(A). +pfc_call((A is B)) :-!, A is B. +pfc_call(clause(A,B)) :-!, clause(A,B). +pfc_call(clause(A,B,Ref)) :-!, clause(A,B,Ref). +% we really need to check for system predicates as well. +% this is probably not advisable due to extreme inefficiency. +pfc_call(P) :- + % trigger(?) any bc rules. + '$bt$'(P,Trigger), + pfcGetSupport('$bt$'(P,Trigger),S), + % @TODO REVIEW _U + fcEvalLHS(Trigger,S), + fail. +%pfc_call(P) :- var(P), !, pfcFact(P). +pfc_call(P) :- predicate_property(P,imported_from(system)), !, call(P). +pfc_call(P) :- predicate_property(P,built_in), !, call(P). +pfc_call(P) :- \+ predicate_property(P,_), functor(P,F,A), dynamic(F/A), !, call(P). +pfc_call(P) :- \+ predicate_property(P,number_of_clauses(_)), !, call(P). +pfc_call(P) :- + setup_call_cleanup( + nb_current('$pfc_current_choice',Was), + (prolog_current_choice(CP), push_current_choice(CP), clause(P,Condition), pfc_call(Condition)), + nb_setval('$pfc_current_choice',Was)). + +/* +pfc_call(P) :- + clause(P,true)*-> true ; (clause(P,Condition), Condition\==true, + pfc_call(Condition)). +*/ + +% an action is undoable if there exists a method for undoing it. +undoable(A) :- fcUndoMethod(A,_). + +pfc_cache_bc(P) :- + % trigger(?) any bc rules. + forall('$bt$'(P,Trigger), + forall(pfcGetSupport('$bt$'(P,Trigger),S), + % @TODO REVIEW _U + fcEvalLHS(Trigger,S))). + + +% % +% % +% % defining fc rules +% % + +% % pfc_nf(+In,-Out) maps the LHR of a pfc rule In to one normal form +% % Out. It also does certain optimizations. Backtracking into this +% % predicate will produce additional clauses. + + +pfc_nf(LHS,List) :- + pfc_nf1(LHS,List2), + pfc_nf_negations(List2,List). + + +% % pfc_nf1(+In,-Out) maps the LHR of a pfc rule In to one normal form +% % Out. Backtracking into this predicate will produce additional clauses. + +% handle a variable. + +pfc_nf1(P,[P]) :- var(P), !. + +% these next two rules are here for upward compatibility and will go +% away eventually when the P/Condition form is no longer used anywhere. + +pfc_nf1(P/Cond,[( \+P )/Cond]) :- pfcNegatedLiteral(P), !. + +pfc_nf1(P/Cond,[P/Cond]) :- pfcLiteral(P), !. + +% % handle a negated form + +pfc_nf1(NegTerm,NF) :- + pfc_unnegate(NegTerm,Term), + !, + pfc_nf1_negation(Term,NF). + +% % disjunction. + +pfc_nf1((P;Q),NF) :- + !, + (pfc_nf1(P,NF) ; pfc_nf1(Q,NF)). + + +% % conjunction. + +pfc_nf1((P,Q),NF) :- + !, + pfc_nf1(P,NF1), + pfc_nf1(Q,NF2), + append(NF1,NF2,NF). + +% % handle a random atom. + +pfc_nf1(P,[P]) :- + pfcLiteral(P), + !. + +/*% % % shouln't we have something to catch the rest as errors?*/ +pfc_nf1(Term,[Term]) :- + pfcWarn("pfc_nf doesn''t know how to normalize ~p (accepting though)",[Term]). + + +% % pfc_nf1_negation(P,NF) is true if NF is the normal form of \+P. +pfc_nf1_negation((P/Cond),[(\+(P))/Cond]) :- !. + +pfc_nf1_negation((P;Q),NF) :- + !, + pfc_nf1_negation(P,NFp), + pfc_nf1_negation(Q,NFq), + append(NFp,NFq,NF). + +pfc_nf1_negation((P,Q),NF) :- + % this code is not correct! twf. + !, + pfc_nf1_negation(P,NF) + ; + (pfc_nf1(P,Pnf), + pfc_nf1_negation(Q,Qnf), + append(Pnf,Qnf,NF)). + +pfc_nf1_negation(P,[\+P]). + + +% % pfc_nf_negations(List2,List) sweeps through List2 to produce List, +% % changing ~{...} to {\+...} +% % % ? is this still needed? twf 3/16/90 + +pfc_nf_negations(X,X) :- !. % I think not! twf 3/27/90 + +pfc_nf_negations([],[]). + +pfc_nf_negations([H1|T1],[H2|T2]) :- + pfc_nf_negation(H1,H2), + pfc_nf_negations(T1,T2). + +% Maybe \+ tilded_negation ? + +pfc_nf_negation(Form,{\+ X}) :- + nonvar(Form), + Form=(~({X})), + !. +pfc_nf_negation(Form,{\+ X}) :- tilded_negation, + nonvar(Form), + Form=(-({X})), + !. +pfc_nf_negation(Form,{\+ X}) :- tilded_negation, + nonvar(Form), + Form=( \+ ({X})), + !. +pfc_nf_negation(X,X). + + + + % % constrain_meta(+Lhs, ?Guard) is semidet. + % + % Creates a somewhat sane Guard. + % + % To turn this feature off... + % ?- set_prolog_flag(constrain_meta,false). + % + % + constrain_meta(_,_):- current_prolog_flag(constrain_meta,false),!,fail. + % FACT + constrain_meta(P,mpred_positive_fact(P)):- is_ftVar(P),!. + % NEG chaining + constrain_meta(~ P, CP):- !, constrain_meta(P,CP). + constrain_meta(\+ P, CP):- !, constrain_meta(P,CP). + % FWD chaining + constrain_meta((_==>Q),nonvar(Q)):- !, is_ftVar(Q). + % EQV chaining + constrain_meta((P<==>Q),(nonvar(Q);nonvar(P))):- (is_ftVar(Q);is_ftVar(P)),!. + % BWD chaining + constrain_meta((Q <- _),mpred_literal(Q)):- is_ftVar(Q),!. + constrain_meta((Q <- _),CQ):- !, constrain_meta(Q,CQ). + % CWC chaining + constrain_meta((Q :- _),mpred_literal(Q)):- is_ftVar(Q),!. + constrain_meta((Q :- _),CQ):- !, constrain_meta(Q,CQ). + + + + + + is_simple_lhs(ActN):- is_ftVar(ActN),!,fail. + is_simple_lhs( \+ _ ):-!,fail. + is_simple_lhs( ~ _ ):-!,fail. + is_simple_lhs( _ / _ ):-!,fail. + is_simple_lhs((Lhs1,Lhs2)):- !,is_simple_lhs(Lhs1),is_simple_lhs(Lhs2). + is_simple_lhs((Lhs1;Lhs2)):- !,is_simple_lhs(Lhs1),is_simple_lhs(Lhs2). + is_simple_lhs(ActN):- is_active_lhs(ActN),!,fail. + is_simple_lhs((Lhs1/Lhs2)):- !,fail, is_simple_lhs(Lhs1),is_simple_lhs(Lhs2). + is_simple_lhs(_). + + + is_active_lhs(ActN):- var(ActN),!,fail. + is_active_lhs(!). + is_active_lhs(cut_c). + is_active_lhs(actn(_Act)). + is_active_lhs('{}'(_Act)). + is_active_lhs((Lhs1/Lhs2)):- !,is_active_lhs(Lhs1);is_active_lhs(Lhs2). + is_active_lhs((Lhs1,Lhs2)):- !,is_active_lhs(Lhs1);is_active_lhs(Lhs2). + is_active_lhs((Lhs1;Lhs2)):- !,is_active_lhs(Lhs1);is_active_lhs(Lhs2). + + + add_lhs_cond(Lhs1/Cond,Lhs2,Lhs1/(Cond,Lhs2)):-!. + add_lhs_cond(Lhs1,Lhs2,Lhs1/Lhs2). + + + +% % +% % buildRhs(+Conjunction,-Rhs) +% % + +buildRhs(X,[X]) :- + var(X), + !. + +buildRhs((A,B),[A2|Rest]) :- + !, + pfcCompileRhsTerm(A,A2), + buildRhs(B,Rest). + +buildRhs(X,[X2]) :- + pfcCompileRhsTerm(X,X2). + +pfcCompileRhsTerm((P/C),((P:-C))) :- !. + +pfcCompileRhsTerm(P,P). + + +% % pfc_unnegate(N,P) is true if N is a negated term and P is the term +% % with the negation operator stripped. + +pfc_unnegate(P,_):- var(P),!,fail. +pfc_unnegate((~P),P):- \+ tilded_negation. +pfc_unnegate((-P),P). +pfc_unnegate((\+(P)),P). + +pfcNegatedLiteral(P) :- + callable(P), + pfc_unnegate(P,Q), + pfcPositiveLiteral(Q). + +pfcLiteral(X) :- pfcNegatedLiteral(X). +pfcLiteral(X) :- pfcPositiveLiteral(X). + +pfcPositiveLiteral(X) :- + callable(X), + functor(X,F,_), + \+ pfcConnective(F). + +pfcConnective(';'). +pfcConnective(','). +pfcConnective('/'). +pfcConnective('|'). +pfcConnective(('==>')). +pfcConnective(('<-')). +pfcConnective('<==>'). + +pfcConnective('-'). +pfcConnective('~'):- \+ tilded_negation. +pfcConnective(( \+ )). + +is_implicitly_prolog(Callable):- \+ callable(Callable),!, fail. +is_implicitly_prolog(_ is _). + +processRule(Lhs,Rhs,ParentRule) :- + copy_term(ParentRule,ParentRuleCopy), + buildRhs(Rhs,Rhs2), + current_why_U(USER), % @TODO REVIEW _U + pfcForEach(pfc_nf(Lhs,Lhs2), + buildRule(Lhs2,rhs(Rhs2),(ParentRuleCopy,USER))). + +buildRule(Lhs,Rhs,Support) :- + buildTrigger(Lhs,Rhs,Trigger), + fcEvalLHS(Trigger,Support). + +buildTrigger([],Consequent,Consequent). + +buildTrigger([Test|Triggers],Consequent,(Test *-> X)) :- is_implicitly_prolog(Test), + !, + buildTrigger(Triggers,Consequent,X). + +buildTrigger([V|Triggers],Consequent,'$pt$'(V,X)) :- + var(V), + !, + buildTrigger(Triggers,Consequent,X). + + +buildTrigger([(T1/Test)|Triggers],Consequent,'$nt$'(T2,Test2,X)) :- + pfc_unnegate(T1,T2), + !, + buildNtTest(T2,Test,Test2), + buildTrigger(Triggers,Consequent,X). + +buildTrigger([(T1)|Triggers],Consequent,'$nt$'(T2,Test,X)) :- + pfc_unnegate(T1,T2), + !, + buildNtTest(T2,true,Test), + buildTrigger(Triggers,Consequent,X). + +buildTrigger([{Test}|Triggers],Consequent,(Test *-> X)) :- + !, + buildTrigger(Triggers,Consequent,X). + +buildTrigger([T/Test|Triggers],Consequent,'$pt$'(T,X)) :- + !, + buildTest(Test,Test2), + buildTrigger([{Test2}|Triggers],Consequent,X). + + +%buildTrigger([snip|Triggers],Consequent,snip(X)) :- +% !, +% buildTrigger(Triggers,Consequent,X). + +buildTrigger([T|Triggers],Consequent,'$pt$'(T,X)) :- + !, + buildTrigger(Triggers,Consequent,X). + +% % +% % buildNtTest(+,+,-). +% % +% % builds the test used in a negative trigger(-) ('$nt$'/3). This test is a +% % conjunction of the check than no matching facts are in the db and any +% % additional test specified in the rule attached to this ~ term. +% % + % tilded_negation. +buildNtTest(T,Testin,Testout) :- + buildTest(Testin,Testmid), + pfcConjoin((pfc_call(T)),Testmid,Testout). + + +% this just strips away any currly brackets. + +buildTest({Test},Test) :- !. +buildTest(Test,Test). + +% % + + +% % pfcType(+VALUE1, ?Type) is semidet. +% +% PFC Database Type. +% +% simple typeing for Pfc objects +% + + +pfcType(Var,Type):- var(Var),!, Type=fact(_FT). +pfcType(_:X,Type):- !, pfcType(X,Type). +pfcType(~_,Type):- !, Type=fact(_FT). +pfcType(('==>'(_,_)),Type):- !, Type=rule(fwd). +pfcType( '==>'(X),Type):- !, pfcType(X,Type), pfcWarn(pfcType( '==>'(X), Type)). +pfcType(('<==>'(_,_)),Type):- !, Type=rule(<==>). +pfcType(('<-'(_,_)),Type):- !, Type=rule(bwc). +pfcType((':-'(_,_)),Type):- !, Type=rule(cwc). +pfcType('$pt$'(_,_,_),Type):- !, Type=trigger(+). +pfcType('$pt$'(_,_),Type):- !, Type=trigger(+). +pfcType('$nt$'(_,_,_),Type):- !, Type=trigger(-). +pfcType('$bt$'(_,_),Type):- !, Type=trigger(?). +pfcType(pfcAction(_),Type):- !, Type=action. +pfcType((('::::'(_,X))),Type):- !, pfcType(X,Type). +pfcType(_,fact(_FT)):- + % if it''s not one of the above, it must_ex be a fact! + !. + +pfcAssert(P,Support) :- + (pfc_clause(P) ; assert(P)), + !, + pfcAddSupport(P,Support). + +pfcAsserta(P,Support) :- + (pfc_clause(P) ; asserta(P)), + !, + pfcAddSupport(P,Support). + +pfcAssertz(P,Support) :- + (pfc_clause(P) ; assertz(P)), + !, + pfcAddSupport(P,Support). + +pfc_clause((Head :- Body)) :- + !, + copy_term(Head,Head_copy), + copy_term(Body,Body_copy), + clause(Head,Body), + variant(Head,Head_copy), + variant(Body,Body_copy). + +pfc_clause(Head) :- + % find a unit clause identical to Head by finding one which unifies, + % and then checking to see if it is identical + copy_term(Head,Head_copy), + clause(Head_copy,true), + variant(Head,Head_copy). + +pfcForEach(Binder,Body) :- Binder,pfcdo(Body),fail. +pfcForEach(_,_). + +% pfcdo(X) executes X once and always succeeds. +pfcdo(X) :- X,!. +pfcdo(_). + + +% % pfcUnion(L1,L2,L3) - true if set L3 is the result of appending sets +% % L1 and L2 where sets are represented as simple lists. + +pfcUnion([],L,L). +pfcUnion([Head|Tail],L,Tail2) :- + memberchk(Head,L), + !, + pfcUnion(Tail,L,Tail2). +pfcUnion([Head|Tail],L,[Head|Tail2]) :- + pfcUnion(Tail,L,Tail2). + + +% % pfcConjoin(+Conjunct1,+Conjunct2,?Conjunction). +% % arg3 is a simplified expression representing the conjunction of +% % args 1 and 2. + +pfcConjoin(true,X,X) :- !. +pfcConjoin(X,true,X) :- !. +pfcConjoin(C1,C2,(C1,C2)). + + +% File : pfcdb.pl +% Author : Tim Finin, finin@prc.unisys.com +% Author : Dave Matuszek, dave@prc.unisys.com +% Author : Dan Corpron +% Updated: 10/11/87, ... +% Purpose: predicates to manipulate a pfc database (e.g. save, +% % restore, reset, etc.0 + +% pfcDatabaseTerm(P/A) is true iff P/A is something that pfc adds to +% the database and should not be present in an empty pfc database + +pfcDatabaseTerm('$spft$'/3). +pfcDatabaseTerm('$pt$'/2). +pfcDatabaseTerm('$bt$'/2). +pfcDatabaseTerm('$nt$'/3). +pfcDatabaseTerm('==>'/2). +pfcDatabaseTerm('<==>'/2). +pfcDatabaseTerm('<-'/2). +pfcDatabaseTerm(pfcQueue/1). + +% removes all forward chaining rules and justifications from db. + +pfcReset :- + pfc_spft(P,F,Trigger), + pfcRetractOrWarn(P), + pfcRetractOrWarn('$spft$'(P,F,Trigger)), + fail. +pfcReset :- + (pfcDatabaseItem(T)*-> + (pfcError("Pfc database not empty after pfcReset, e.g., ~p.~n",[T]),fail) + ; true). + + +% true if there is some pfc crud still in the database. +pfcDatabaseItem(Term:-Body) :- + pfcDatabaseTerm(P/A), + functor(Term,P,A), + clause(Term,Body). + +pfcRetractOrWarn(X) :- retract(X), !. +pfcRetractOrWarn(X) :- + pfcWarn("Couldn't retract ~p.",[X]),nop((dumpST,pfcWarn("Couldn't retract ~p.",[X]))),!. + +pfcRetractOrQuietlyFail(X) :- retract(X), !. +pfcRetractOrQuietlyFail(X) :- + nop((pfcTraceMsg("Trace: Couldn't retract ~p.",[X]),nop((dumpST,pfcWarn("Couldn't retract ~p.",[X]))))), + !,fail. + + diff --git a/.Attic/canary_docme/metta_pfc_support.pl b/.Attic/canary_docme/metta_pfc_support.pl new file mode 100644 index 00000000000..c80d81a3716 --- /dev/null +++ b/.Attic/canary_docme/metta_pfc_support.pl @@ -0,0 +1,662 @@ +/* + * 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. + */ + +/* + LogicMOO Base FOL/PFC Setup +% Dec 13, 2035 +% Douglas Miles + +*/ +% :- if( \+ current_predicate(set_fileAssertMt/1)). +% % +% % +% % predicates for manipulating support relationships +% % + +% % pfcAddSupport(+Fact,+Support) + +pfcAddSupport(P,(Fact,Trigger)) :- assert('$spft$'(P,Fact,Trigger)). + +pfcGetSupport(P,(Fact,Trigger)) :- pfc_spft(P,Fact,Trigger). + +pfc_spft(P,F,T) :- pfcCallSystem('$spft$'(P,F,T)). + +% There are three of these to try to efficiently handle the cases +% where some of the arguments are not bound but at least one is. + +pfcRemOneSupport(P,(Fact,Trigger)) :- + must_ex(callable(P);callable(Fact);callable(Trigger)), + pfcRetractOrWarn('$spft$'(P,Fact,Trigger)). + +pfcRemOneSupportOrQuietlyFail(P,(Fact,Trigger)) :- + must_ex(callable(P);callable(Fact);callable(Trigger)), + pfcRetractOrQuietlyFail('$spft$'(P,Fact,Trigger)). + + +pfc_collect_supports(Tripples) :- + bagof(Tripple, pfc_support_relation(Tripple), Tripples), + !. +pfc_collect_supports([]). + +pfc_support_relation((P,F,T)) :- + pfc_spft(P,F,T). + + + +pfc_make_supports((P,S1,S2)) :- + pfcAddSupport(P,(S1,S2)), + (pfcAddType1(P); true), + !. + +% % pfcTriggerKey(+Trigger,-Key) +% % +% % Arg1 is a trigger. Key is the best term to index it on. + +pfcTriggerKey('$pt$'(Key,_),Key). +pfcTriggerKey('$pt$'(Key,_,_),Key). +pfcTriggerKey('$nt$'(Key,_,_),Key). +pfcTriggerKey(Key,Key). + + +% % ^L +% % Get a key from the trigger that will be used as the first argument of +% % the trigger base clause that stores the trigger. +% % + +pfc_trigger_key(X,X) :- var(X), !. +pfc_trigger_key(chart(word(W),_L),W) :- !. +pfc_trigger_key(chart(stem([Char1|_Rest]),_L),Char1) :- !. +pfc_trigger_key(chart(Concept,_L),Concept) :- !. +pfc_trigger_key(X,X). + + +nb_pushval(Name,Value):-nb_current(Name,Before)->nb_setval(Name,[Value|Before]);nb_setval(Name,[Value]). +nb_peekval(Name,Value):-nb_current(Name,[Value|_Before]). +nb_hasval(Name,Value):-nb_current(Name,List),member(Value,List). +nb_popval(Name,Value):-nb_current(Name,[Value|Before])->nb_setval(Name,Before). + +reset_shown_justs:- retractall(t_l:shown_why(_)),nop(color_line(red,1)). +clear_proofs:- retractall(t_l:whybuffer(_P,_Js)),nop(color_line(cyan,1)). + + +lookup_spft_match(A,B,C):- copy_term(A,AA),lookup_spft(A,B,C),A=@=AA. + +lookup_spft_match_deeper(H,Fact,Trigger):- + copy_term(H,HH), + lookup_spft((H:- _B),Fact,Trigger), + H=@=HH. + +lookup_spft_match_first(A,B,C):- nonvar(A),!, + no_repeats(((lookup_spft_match(A,B,C);lookup_spft(A,B,C)))). + +lookup_spft_match_first(A,B,C):- lookup_spft(A,B,C). + + +% % pfc_is_info( :TermC) is semidet. +% +% PFC If Is A Info. +% +pfc_is_info((CWC,Info)):- (atom(CWC),is_a_info(CWC));pfc_is_info(Info). +pfc_is_info(pfc_bc_only(C)):-is_ftNonvar(C),!. +pfc_is_info(infoF(C)):-is_ftNonvar(C),!. +pfc_is_info(inherit_above(_,_)). + + +is_a_info(fail). +is_a_info(CWC):- is_pfc_chained(CWC). + +is_pfc_chained(cwc). +is_pfc_chained(awc). +is_pfc_chained(zwc). +is_pfc_chained(fwc). +is_pfc_chained(bwc). +is_pfc_chained(wac). + +:- forall(is_pfc_chained(Op),assert_if_new(Op)). + +reserved_body(B):-var(B),!,fail. +reserved_body(attr_bind(_)). +reserved_body(attr_bind(_,_)). +reserved_body(B):-reserved_body_helper(B). + +reserved_body_helper(B):- \+ compound(B),!,fail. +reserved_body_helper((ZAWC,_)):- atom(ZAWC),is_pfc_chained(ZAWC). + +call_only_based_mfl(H,mfl4(_VarNameZ,M,F,L)):- + ignore(predicate_property(H,imported_from(M));predicate_property(H,module(M))), + ignore(predicate_property(H,line_count(L))), + ignore(source_file(M:H,F);predicate_property(H,file(F));(predicate_property(H,foreign),F=foreign)). + +uses_call_only(H):- predicate_property(H,foreign),!. +uses_call_only(H):- predicate_property(H,_), \+ predicate_property(H,interpreted),!. + +clause_match(H,_B,uses_call_only(H)):- uses_call_only(H),!. +clause_match(H,B,Ref):- clause_asserted(H,B,Ref),!. +clause_match(H,B,Ref):- ((copy_term(H,HH),clause(H,B,Ref),H=@=HH)*->true;clause(H,B,Ref)), \+ reserved_body_helper(B). + +find_mfl(C,MFL):- lookup_spft_match(C,MFL,ax). +find_mfl(C,MFL):- unwrap_litr0(C,UC) -> C\==UC -> find_mfl(UC,MFL). +find_mfl(C,MFL):- expand_to_hb(C,H,B), + find_hb_mfl(H,B,_Ref,MFL)->true; (clause_match(H,B,Ref),find_hb_mfl(H,B,Ref,MFL)). + +find_hb_mfl(_H,_B,Ref,mfl4(_VarNameZ,M,F,L)):- atomic(Ref),clause_property(Ref,line_count(L)), + clause_property(Ref,file(F)),clause_property(Ref,module(M)). +find_hb_mfl(H,B,_,mfl4(VarNameZ,M,F,L)):- lookup_spft_match_first( (H:-B),mfl4(VarNameZ,M,F,L),_),!. +find_hb_mfl(H,B,_Ref,mfl4(VarNameZ,M,F,L)):- lookup_spft_match_first(H,mfl4(VarNameZ,M,F,L),_),ground(B). +find_hb_mfl(H,_B,uses_call_only(H),MFL):- !,call_only_based_mfl(H,MFL). + +:- fixup_exports. +%:- current_prolog_flag(pfc_shared_module,BaseKB),fixup_module_exports_into(BaseKB). +:- fixup_module_exports_into(system). + +mpred_rule_hb(C,_):- \+ compound(C),!,fail. +mpred_rule_hb((H:-B),H,B):- !. +mpred_rule_hb((H<-B),H,B):- !. +mpred_rule_hb((B==>H),H,B):- !. +mpred_rule_hb((==>H),H,true):- !. +mpred_rule_hb((HB1<==>HB2),(H1,H2),(B1,B2)):- !, (mpred_rule_hb((HB1==>HB2),H2,B2);mpred_rule_hb((HB2==>HB1),H1,B1)). + +:- module_transparent( (get_assertion_head_arg)/3). +get_assertion_head_arg(N,P,E):-get_assertion_head_unnegated(P,PP),!,arg(N,PP,E). + +get_assertion_head_unnegated(P,PP):- mpred_rule_hb(P,H,_), (pfc_unnegate(H,PP)->true;H==PP). +replace_arg(Q,N,NEW,R):- duplicate_term(Q,R),Q=R,nb_setarg(N,R,NEW). + +%% if_missing_mask( +Q, ?R, ?Test) is semidet. +% +% If Missing Mask. +% + +if_missing_mask(M:Q,M:R,M:Test):- nonvar(Q),!,if_missing_mask(Q,R,Test). +if_missing_mask(Q,~Q,\+Q):- \+ is_ftCompound(Q),!. + +%if_missing_mask(ISA, ~ ISA, \+ ISA):- functor(ISA,F,1),(F==tSwim;call_u(functorDeclares(F))),!. +if_missing_mask(HB,RO,TestO):- once(mpred_rule_hb(HB,H,B)),B\==true,HB\==H,!, + if_missing_mask(H,R,TestO),subst(HB,H,R,RO). + +if_missing_mask(ISA, ISA, \+ ISA):- functor(ISA, _F,1),!.% (F==tSwim;call_u(functorDeclares(F))),!. + +if_missing_mask(Q,R,Test):- + which_missing_argnum(Q,N), + if_missing_n_mask(Q,N,R,Test),!. + +if_missing_mask(ISA, ~ ISA, \+ ISA). + +%% if_missing_n_mask( +Q, ?N, ?R, ?Test) is semidet. +% +% If Missing Mask. +% +if_missing_n_mask(Q,N,R,Test):- + get_assertion_head_arg(N,Q,Was), + (nonvar(R)-> (which_missing_argnum(R,RN),get_assertion_head_arg(RN,R,NEW));replace_arg(Q,N,NEW,R)),!, + Test=dif:dif(Was,NEW). + +/* +Old version +if_missing_mask(Q,N,R,dif:dif(Was,NEW)):- + must_ex((is_ftNonvar(Q),acyclic_term(Q),acyclic_term(R),functor(Q,F,A),functor(R,F,A))), + (singleValuedInArg(F,N) -> + (get_assertion_head_arg(N,Q,Was),replace_arg(Q,N,NEW,R)); + ((get_assertion_head_arg(N,Q,Was),is_ftNonvar(Was)) -> replace_arg(Q,N,NEW,R); + (N=A,get_assertion_head_arg(N,Q,Was),replace_arg(Q,N,NEW,R)))). +*/ + + +%% which_missing_argnum( +VALUE1, ?VALUE2) is semidet. +% +% Which Missing Argnum. +% +which_missing_argnum(Q,N):- compound(Q),\+ compound_name_arity(Q,_,0), + must_ex((acyclic_term(Q),is_ftCompound(Q),get_functor(Q,F,A))), + F\=t, + (call_u(singleValuedInArg(F,N)) -> true; which_missing_argnum(Q,F,A,N)). + +which_missing_argnum(_,_,1,_):-!,fail. +which_missing_argnum(Q,_F,A,N):- between(A,1,N),get_assertion_head_arg(N,Q,Was),is_ftNonvar(Was). + +% File : pfcjust.pl +% Author : Tim Finin, finin@prc.unisys.com +% Author : Dave Matuszek, dave@prc.unisys.com +% Updated: +% Purpose: predicates for accessing Pfc justifications. +% Status: more or less working. +% Bugs: + +%= *** predicates for exploring supports of a fact ***** + + +:- use_module(library(lists)). + +justification(F,J) :- supports(F,J). + +justifications(F,Js) :- bagof(J,justification(F,J),Js). + + + +% % base(P,L) - is true iff L is a list of "base" facts which, taken +% % together, allows us to deduce P. A base fact is an axiom (a fact +% % added by the user or a raw Prolog fact (i.e. one w/o any support)) +% % or an assumption. + +base(F,[F]) :- (axiom(F) ; assumption(F)),!. + +base(F,L) :- + % i.e. (reduce 'append (map 'base (justification f))) + justification(F,Js), + bases(Js,L). + + +% % bases(L1,L2) is true if list L2 represents the union of all of the +% % facts on which some conclusion in list L1 is based. + +bases([],[]). +bases([X|Rest],L) :- + base(X,Bx), + bases(Rest,Br), + pfcUnion(Bx,Br,L). + +axiom(F) :- + matches_why_UU(UU), + pfcGetSupport(F,UU); + pfcGetSupport(F,(god,god)). + +% % an assumption is a failed goal, i.e. were assuming that our failure to +% % prove P is a proof of not(P) + +assumption(P) :- pfc_unnegate(P,_). + +% % assumptions(X,As) if As is a set of assumptions which underly X. + +assumptions(X,[X]) :- assumption(X). +assumptions(X,[]) :- axiom(X). +assumptions(X,L) :- + justification(X,Js), + assumptions1(Js,L). + +assumptions1([],[]). +assumptions1([X|Rest],L) :- + assumptions(X,Bx), + assumptions1(Rest,Br), + pfcUnion(Bx,Br,L). + + +% % pfcProofTree(P,T) the proof tree for P is T where a proof tree is +% % of the form +% % +% % [P , J1, J2, ;;; Jn] each Ji is an independent P justifier. +% % ^ and has the form of +% % [J11, J12,... J1n] a list of proof trees. + + +% pfcChild(P,Q) is true iff P is an immediate justifier for Q. +% mode: pfcChild(+,?) + +pfcChild(P,Q) :- + pfcGetSupport(Q,(P,_)). + +pfcChild(P,Q) :- + pfcGetSupport(Q,(_,Trig)), + pfcType(Trig,trigger(_Pos)), + pfcChild(P,Trig). + +pfcChildren(P,L) :- bagof_or_nil(C,pfcChild(P,C),L). + +% pfcDescendant(P,Q) is true iff P is a justifier for Q. + +pfcDescendant(P,Q) :- + pfcDescendant1(P,Q,[]). + +pfcDescendant1(P,Q,Seen) :- + pfcChild(X,Q), + (\+ member(X,Seen)), + (P=X ; pfcDescendant1(P,X,[X|Seen])). + +pfcDescendants(P,L) :- + bagof_or_nil(Q,pfcDescendant1(P,Q,[]),L). + + + +/* +current_why_U(U):- must_ex(current_why(Why)), U = user(Why). +current_why_UU(UU):- current_why_U(U), UU= (U,U). +matches_why_U(U):- freeze(U,U=user(_)). +matches_why_UU(UU):- matches_why_U(U1),matches_why_U(U2), freeze(UU,UU=(U1,U2)). +*/ +current_why_U(U):- get_why_uu((U,_)).% must_ex(current_why(Why)), U = user(Why). +current_why_UU(UU):- get_why_uu(UU). % current_why_U(U), UU= (U,U). +matches_why_U(U):- nop((current_why_U(Y), freeze(U,\+ \+ (U=Y;true)))). +matches_why_UU(UU):- nop(only_is_user_reason(UU)). % matches_why_U(U1),matches_why_U(U2),freeze(UU,UU=(U1,U2)). + + +matterialize_support_term(S,Sup):- term_attvars(S,Atts), Atts\==[] -> copy_term(S,_,Goals),Sup= S+Goals,!. +matterialize_support_term(SS,SS). + + + + + +:- set_prolog_flag(pfc_term_expansion,false). + +pfc_system_term_expansion(I,S0,O,S1):- %use_pfc_term_expansion, % trace, + ( \+ current_prolog_flag(pfc_term_expansion,false), + ( \+ \+ (source_location(File,_), atom_concat(_,'.pfc.pl',File)) + ; current_prolog_flag(pfc_term_expansion,true))) -> + once((prolog_load_context('term',T),nop(writeln(T)),T=@=I)) + ->(pfc_term_expansion(I,O)-> I\=@=O->S0=S1, fbugio(I-->O)). + + +:- multifile(system:term_expansion/4). +:- asserta((system:term_expansion(I,S0,O,S1):- + pfc_system_term_expansion(I,S0,O,S1))). +%:- listing(term_expansion/4). + +% :- endif. + + + +end_of_file. + + + + + + + + + + + + + + + + + + + + + +%% is_fc_body( +P) is semidet. +% +% If Is A Forward Chaining Body. +% +is_fc_body(P):- has_body_atom(fwc,P). + +%% is_bc_body( +P) is semidet. +% +% If Is A Backchaining Body. +% +is_bc_body(P):- has_body_atom(bwc,P). + +%% is_action_body( +P) is semidet. +% +% If Is A Action Body. +% +is_action_body(P):- has_body_atom(wac,P). + + + +%% has_body_atom( +WAC, ?P) is semidet. +% +% Has Body Atom. +% +has_body_atom(WAC,P):- call( + WAC==P -> true ; (is_ftCompound(P),get_assertion_head_arg(1,P,E),has_body_atom(WAC,E))),!. + +/* +has_body_atom(WAC,P,Rest):- call(WAC==P -> Rest = true ; (is_ftCompound(P),functor(P,F,A),is_atom_body_pfa(WAC,P,F,A,Rest))). +is_atom_body_pfa(WAC,P,F,2,Rest):-get_assertion_head_arg(1,P,E),E==WAC,get_assertion_head_arg(2,P,Rest),!. +is_atom_body_pfa(WAC,P,F,2,Rest):-get_assertion_head_arg(2,P,E),E==WAC,get_assertion_head_arg(1,P,Rest),!. +*/ + + +same_functors(Head1,Head2):-must_det(get_unnegated_functor(Head1,F1,A1)),must_det(get_unnegated_functor(Head2,F2,A2)),!,F1=F2,A1=A2. + +%% mpred_update_literal( +P, ?N, ?Q, ?R) is semidet. +% +% PFC Update Literal. +% +mpred_update_literal(P,N,Q,R):- + get_assertion_head_arg(N,P,UPDATE),call(replace_arg(P,N,Q_SLOT,Q)), + must_ex(call_u(Q)),update_value(Q_SLOT,UPDATE,NEW), + replace_arg(Q,N,NEW,R). + + +% '$spft'(MZ,5,5,5). + +%% update_single_valued_arg(+Module, +P, ?N) is semidet. +% +% Update Single Valued Argument. +% +:- module_transparent( (update_single_valued_arg)/3). + +update_single_valued_arg(M,M:Pred,N):-!,update_single_valued_arg(M,Pred,N). +update_single_valued_arg(_,M:Pred,N):-!,update_single_valued_arg(M,Pred,N). + +update_single_valued_arg(world,P,N):- !, current_prolog_flag(pfc_shared_module,BaseKB), update_single_valued_arg(BaseKB,P,N). +update_single_valued_arg(M,P,N):- ibreak, \+ clause_b(mtHybrid(M)), trace, clause_b(mtHybrid(M2)),!, + update_single_valued_arg(M2,P,N). + +update_single_valued_arg(M,P,N):- + get_assertion_head_arg(N,P,UPDATE), + is_relative(UPDATE),!, + dtrace, + ibreak, + replace_arg(P,N,OLD,Q), + must_det_l((clause_u(Q),update_value(OLD,UPDATE,NEW),\+ is_relative(NEW), replace_arg(Q,N,NEW,R))),!, + update_single_valued_arg(M,R,N). + + +update_single_valued_arg(M,P,N):- + call_u((must_det_l(( + + call_u(mtHybrid(M)), + mpred_type_args \= M, + mpred_kb_ops \= M, + get_assertion_head_arg(N,P,UPDATE), + replace_arg(P,N,Q_SLOT,Q), + var(Q_SLOT), + same_functors(P,Q), + % current_why(U), + must_det_l(( + % rtrace(attvar_op(assert_if_new,M:'$spft'(MZ,P,U,ax))), + % (call_u(P)->true;(assertz_mu(P))), + assertz(M:P), + doall(( + lookup_u(M:Q,E), + UPDATE \== Q_SLOT, + erase(E), + mpred_unfwc1(M:Q))))))))). + +% ======================= +% utils +% ======================= + +%% map_literals( +P, ?G) is semidet. +% +% Map Literals. +% +map_literals(P,G):-map_literals(P,G,[]). + + +%% map_literals( +VALUE1, :TermH, ?VALUE3) is semidet. +% +% Map Literals. +% +map_literals(_,H,_):-is_ftVar(H),!. % skip over it +map_literals(_,[],_) :- !. +map_literals(Pred,(H,T),S):-!, apply(Pred,[H|S]), map_literals(Pred,T,S). +map_literals(Pred,[H|T],S):-!, apply(Pred,[H|S]), map_literals(Pred,T,S). +map_literals(Pred,H,S):- mpred_literal(H),must_ex(apply(Pred,[H|S])),!. +map_literals(_Pred,H,_S):- \+ is_ftCompound(H),!. % skip over it +map_literals(Pred,H,S):-H=..List,!,map_literals(Pred,List,S),!. + + + +%% map_unless( :PRED1Test, ?Pred, ?H, ?S) is semidet. +% +% Map Unless. +% +map_unless(Test,Pred,H,S):- call(Test,H),ignore(apply(Pred,[H|S])),!. +map_unless(_Test,_,[],_) :- !. +map_unless(_Test,_Pred,H,_S):- \+ is_ftCompound(H),!. % skip over it +map_unless(Test,Pred,(H,T),S):-!, apply(Pred,[H|S]), map_unless(Test,Pred,T,S). +map_unless(Test,Pred,[H|T],S):-!, apply(Pred,[H|S]), map_unless(Test,Pred,T,S). +map_unless(Test,Pred,H,S):-H=..List,!,map_unless(Test,Pred,List,S),!. + + +:- meta_predicate(map_first_arg(*,+)). +%% map_first_arg( +Pred, ?List) is semidet. +% +% PFC Maptree. +% +map_first_arg(CMPred,List):- strip_module(CMPred,CM,Pred), map_first_arg(CM,Pred,List,[]). + +:- meta_predicate(map_first_arg(+,*,+,+)). +%% map_first_arg( +Pred, :TermH, ?S) is semidet. +% +% PFC Maptree. +% +map_first_arg(CM,Pred,H,S):-is_ftVar(H),!,CM:apply(Pred,[H|S]). +map_first_arg(_,_,[],_) :- !. +map_first_arg(CM,Pred,(H,T),S):-!, map_first_arg(CM,Pred,H,S), map_first_arg(CM,Pred,T,S). +map_first_arg(CM,Pred,(H;T),S):-!, map_first_arg(CM,Pred,H,S) ; map_first_arg(CM,Pred,T,S). +map_first_arg(CM,Pred,[H|T],S):-!, CM:apply(Pred,[H|S]), map_first_arg(CM,Pred,T,S). +map_first_arg(CM,Pred,H,S):- CM:apply(Pred,[H|S]). + +%:- fixup_exports. + +% % :- ensure_loaded(logicmoo(util/rec_lambda)). + +%example pfcVerifyMissing(mpred_isa(I,D), mpred_isa(I,C), ((mpred_isa(I,C), {D==C});-mpred_isa(I,C))). +%example pfcVerifyMissing(mudColor(I,D), mudColor(I,C), ((mudColor(I,C), {D==C});-mudColor(I,C))). + + +%% pfcVerifyMissing( +GC, ?GO, ?GO) is semidet. +% +% Prolog Forward Chaining Verify Missing. +% +pfcVerifyMissing(GC, GO, ((GO, {D==C});\+ GO) ):- GC=..[F,A|Args],append(Left,[D],Args),append(Left,[C],NewArgs),GO=..[F,A|NewArgs],!. + +%example mpred_freeLastArg(mpred_isa(I,C),~(mpred_isa(I,C))):-is_ftNonvar(C),!. +%example mpred_freeLastArg(mpred_isa(I,C),(mpred_isa(I,F),C\=F)):-!. + +%% mpred_freeLastArg( +G, ?GG) is semidet. +% +% PFC Free Last Argument. +% +mpred_freeLastArg(G,GG):- G=..[F,A|Args],append(Left,[_],Args),append(Left,[_],NewArgs),GG=..[F,A|NewArgs],!. +mpred_freeLastArg(_G,false). + + +%% mpred_current_op_support( +VALUE1) is semidet. +% +% PFC Current Oper. Support. +% +mpred_current_op_support((p,p)):-!. + + +%% pfcVersion( +VALUE1) is semidet. +% +% Prolog Forward Chaining Version. +% +%pfcVersion(6.6). + + +% % :- '$set_source_module'(mpred_kb_ops). + +%% correctify_support( +S, ?S) is semidet. +% +% Correctify Support. +% +correctify_support(U,(U,ax)):-var(U),!. +correctify_support((U,U),(U,ax)):-!. +correctify_support((S,T),(S,T)):-!. +correctify_support((U,_UU),(U,ax)):-!. +correctify_support([U],S):-correctify_support(U,S). +correctify_support(U,(U,ax)). + + +%% clause_asserted_local( :TermABOX) is semidet. +% +% Clause Asserted Local. +% +clause_asserted_local(MCL):- + must_ex(strip_mz(MCL,MZ,CL)), + must_ex(CL='$spft'(MZ,P,Fact,Trigger )),!, + clause_u('$spft'(MZ,P,Fact,Trigger),true,Ref), + clause_u('$spft'(MZ,UP,UFact,UTrigger),true,Ref), + (((UP=@=P,UFact=@=Fact,UTrigger=@=Trigger))). + + + +%% is_already_supported( +P, ?S, ?UU) is semidet. +% +% If Is A Already Supported. +% +is_already_supported(P,(S,T),(S,T)):- clause_asserted_local('$spft'(_MZ,P,S,T)),!. +is_already_supported(P,_S,UU):- clause_asserted_local('$spft'(_MZ,P,US,UT)),must_ex(get_source_uu(UU)),UU=(US,UT). + +% TOO UNSAFE +% is_already_supported(P,_S):- copy_term_and_varnames(P,PC),sp ftY(PC,_,_),P=@=PC,!. + + +if_missing1(Q):- mpred_literal_nv(Q), call_u( \+ ~ Q), if_missing_mask(Q,R,Test),!, lookup_u(R), Test. + + +mpred_run_pause:- asserta(t_l:mpred_run_paused). +mpred_run_resume:- retractall(t_l:mpred_run_paused). + +fwithout_running(G):- (t_l:mpred_run_paused->G;locally_tl(mpred_run_pause,G)). + + diff --git a/.Attic/canary_docme/metta_printer.pl b/.Attic/canary_docme/metta_printer.pl new file mode 100644 index 00000000000..74979ba1e02 --- /dev/null +++ b/.Attic/canary_docme/metta_printer.pl @@ -0,0 +1,392 @@ +:- encoding(iso_latin_1). +:- flush_output. +:- setenv('RUST_BACKTRACE',full). + +% =============================== +% PRINTERS +% =============================== +% 'ppc' and 'ppc1' rules pretty-print original terms and convert them to metta if different, +% printing the converted forms as well. +ppc(Msg,Term):- ppc1(Msg,Term), p2m(Term,MeTTa),!, (MeTTa\==Term -> ppc1(p2m(Msg),MeTTa) ; true). + +ppc1(Msg,Term):- \+ \+ ( ppct(Msg,Term) ),!. + +ppc1(Msg,Term):- \+ \+ ( ignore(guess_pretty(Term)), + writeln('---------------------'), + write(p(Msg)),write(':'),nl, + portray_clause(Term), + writeln('---------------------'), + \+ \+ (print_tree(?-show_cvts(Term))),nl, + writeln('---------------------'), + write(s(Msg)),write(':'),nl, + write_src(Term),nl). + +ppct(Msg,Term):- is_list(Term),!, + writeln('---------------------'), + numbervars(Term,666,_,[attvar(bind)]), + write((Msg)),write(':'),nl, + write_src(Term),nl. +ppct(Msg,Term):- Term=(_ :- _),!, + writeln('---------------------'), + write((Msg)),write(':'),nl, + portray_clause(Term),nl. +ppct(Msg,Term):- Term=(_=_),!, + writeln('---------------------'), + write((Msg)),write(':'),nl, + numbervars(Term,444,_,[attvar(bind)]), + write_src(Term),nl. +ppct(Msg,Term):- Term=(_ :- _),!, + writeln('---------------------'), + write((Msg)),write(':'),nl, + numbervars(Term,222,_,[attvar(bind)]), + print_tree(Term),nl. + +% 'pp_metta' rule is responsible for pretty-printing metta terms. +pp_metta(P):- pretty_numbervars(P,PP),with_option(concepts=false,pp_fb(PP)). + +string_height(Pt1,H1):- split_string(Pt1,"\r\n", "\s\t\n\n", L),length(L,H1). + +:- dynamic(just_printed/1). +% 'print_pl_source' rule is responsible for printing the source of a Prolog term. + + +print_pl_source(P):- run_pl_source(print_pl_source0(P)). + +run_pl_source(G):- catch(G,E,(fail,write_src_uo(G=E),rtrace(G))). +print_pl_source0(_):- notrace(is_compatio),!. +print_pl_source0(_):- notrace(silent_loading),!. +print_pl_source0(P):- notrace((just_printed(PP), PP=@=P)),!. + print_pl_source0((A:-B)):-!, portray_clause((A:-B)). + print_pl_source0((:-B)):-!, portray_clause((:-B)). +print_pl_source0(P):- format('~N'), print_tree(P),format('~N'),!. +print_pl_source0(P):- + Actions = [print_tree, portray_clause, pp_fb1_e], % List of actions to apply + findall(H-Pt, + (member(Action, Actions), + must_det_ll(( + run_pl_source(with_output_to(string(Pt), call(Action, P))), + catch(string_height(Pt, H),_,H=0)))), HeightsAndOutputs), + sort(HeightsAndOutputs, Lst), last(Lst, _-Pt), writeln(Pt), + retractall(just_printed(_)), + assert(just_printed(P)), + !. + + +pp_fb1_a(P):- format("~N "), \+ \+ (numbervars_w_singles(P), pp_fb1_e(P)), format("~N "),flush_output. + +pp_fb1_e(P):- pp_fb2(print_tree,P). +pp_fb1_e(P):- pp_fb2(pp_ilp,P). +pp_fb1_e(P):- pp_fb2(pp_as,P). +pp_fb1_e(P):- pp_fb2(portray_clause,P). +pp_fb1_e(P):- pp_fb2(print,P). +pp_fb1_e(P):- pp_fb2(fbdebug1,P). +pp_fb1_e(P):- pp_fb2(fmt0(P)). +pp_fb2(F,P):- atom(F),current_predicate(F/1), call(F,P). + + + +pp_sax(V) :- is_final_write(V),!. +pp_sax(S) :- \+ allow_concepts,!, write_src(S). +pp_sax(S) :- is_englishy(S),!,print_concept("StringValue",S). +pp_sax(S) :- symbol_length(S,1),symbol_string(S,SS),!,print_concept("StringValue",SS). +pp_sax(S) :- is_an_arg_type(S,T),!,print_concept("TypeNode",T). +pp_sax(S) :- has_type(S,T),!,format('(~wValueNode "~w")',[T,S]). +pp_sax(S) :- sub_atom(S,0,4,Aft,FB),flybase_identifier(FB,Type),!, + (Aft>0->format('(~wValueNode "~w")',[Type,S]);'format'('(TypeNode "~w")',[Type])). +pp_sax(S) :- print_concept("ConceptNode",S). + +%print_concept( CType,V):- allow_concepts, !, write("("),write(CType),write(" "),ignore(with_concepts(false,write_src(V))),write(")"). +print_concept(_CType,V):- ignore(write_src(V)). +write_val(V):- is_final_write(V),!. +write_val(V):- number(V),!, write_src(V). +write_val(V):- compound(V),!, write_src(V). +write_val(V):- write('"'),write(V),write('"'). + + +% Handling the final write when the value is a variable or a '$VAR' structure. +is_final_write(V):- var(V), !, write_dvar(V),!. +is_final_write('$VAR'(S)):- !, write_dvar(S),!. +is_final_write('#\\'(S)):- !, format("'~w'",[S]). +is_final_write(V):- py_is_enabled,py_is_py(V),!,py_ppp(V),!. + +is_final_write([VAR,V|T]):- '$VAR'==VAR, T==[], !, write_dvar(V). +is_final_write('[|]'):- write('Cons'),!. +is_final_write([]):- !, write('()'). +%is_final_write([]):- write('Nil'),!. + + +write_dvar(S):- S=='_', !, write_dname(S). +write_dvar(S):- S=='__', !, write('$'). +write_dvar(S):- var(S), get_var_name(S,N),write_dname(N),!. +write_dvar(S):- var(S), !, format('$~p',[S]). +write_dvar(S):- atom(S), symbol_concat('_',N,S),write_dname(N). +write_dvar(S):- string(S), symbol_concat('_',N,S),write_dname(N). +%write_dvar(S):- number(S), write_dname(S). +write_dvar(S):- write_dname(S). +write_dname(S):- write('$'),write(S). + +pp_as(V) :- \+ \+ pp_sex(V),flush_output. +pp_sex_nc(V):- with_no_quoting_symbols(true,pp_sex(V)),!. + +unlooped_fbug(Mesg):- + fbug_message_hook(fbug_message_hook,fbug(Mesg)). + +into_hyphens(D,U):- atom(D),!,always_dash_functor(D,U). +into_hyphens(D,U):- descend_and_transform(into_hyphens,D,U),!. + + +unlooped_fbug(W,Mesg):- nb_current(W,true),!, + print(Mesg),nl,bt,break. +unlooped_fbug(W,Mesg):- + setup_call_cleanup(nb_setval(W,true), + once(Mesg),nb_setval(W,false)),nb_setval(W,false). + +:- dynamic(py_is_enabled/0). +py_is_enabled:- predicate_property(py_ppp(_),defined), asserta((py_is_enabled:-!)). + +%write_src(V):- !, \+ \+ quietly(pp_sex(V)),!. +write_src(V):- \+ \+ notrace(pp_sex(V)),!. +write_src_woi_ln(X):- + format('~N'),write_src_woi(X),format('~N'). + + +pp_sex(V):- pp_sexi(V),!. +% Various 'write_src' and 'pp_sex' rules are handling the writing of the source, +% dealing with different types of values, whether they are lists, atoms, numbers, strings, compounds, or symbols. +pp_sexi(V):- is_final_write(V),!. +pp_sexi(V):- is_dict(V),!,print(V). +pp_sexi((USER:Body)) :- USER==user,!, pp_sex(Body). +pp_sexi(V):- allow_concepts,!,with_concepts('False',pp_sex(V)),flush_output. +pp_sexi('Empty') :- !. +pp_sexi('') :- !, writeq(''). +% Handling more cases for 'pp_sex', when the value is a number, a string, a symbol, or a compound. +%pp_sex('') :- format('(EmptyNode null)',[]). +pp_sexi(V):- number(V),!, writeq(V). +pp_sexi(V):- string(V),!, writeq(V). +pp_sexi(S):- string(S),!, print_concept('StringValue',S). +pp_sexi(V):- symbol(V), should_quote(V),!, symbol_string(V,S), write("'"),write(S),write("'"). +% Base case: atoms are printed as-is. +%pp_sexi(S):- symbol(S), always_dash_functor(S,D), D \=@= S, pp_sax(D),!. +pp_sexi(V):- symbol(V),!,write(V). +pp_sexi(V) :- (number(V) ; is_dict(V)), !, print_concept('ValueAtom',V). +%pp_sex((Head:-Body)) :- !, print_metta_clause0(Head,Body). +%pp_sex(''):- !, write('()'). + +% Continuing with 'pp_sex', 'write_mobj', and related rules, +% handling different cases based on the value�s type and structure, and performing the appropriate writing action. +% Lists are printed with parentheses. +pp_sexi(V) :- \+ compound(V), !, format('~p',[V]). + +%pp_sexi(V):- is_list(V),!, pp_sex_l(V). +%pp_sex(V) :- (symbol(V),symbol_number(V,N)), !, print_concept('ValueAtom',N). +%pp_sex(V) :- V = '$VAR'(_), !, format('$~p',[V]). +pp_sexi(V) :- no_src_indents,!,pp_sex_c(V). +pp_sexi(V) :- w_proper_indent(2,w_in_p(pp_sex_c(V))). + +write_mobj(H,_):- \+ symbol(H),!,fail. +write_mobj('$VAR',[S]):- write_dvar(S). +write_mobj(exec,[V]):- !, write('!'),write_src(V). +write_mobj('$OBJ',[_,S]):- write('['),write_src(S),write(' ]'). +write_mobj('{}',[S]):- write('{'),write_src(S),write(' }'). +write_mobj('{...}',[S]):- write('{'),write_src(S),write(' }'). +write_mobj('[...]',[S]):- write('['),write_src(S),write(' ]'). +write_mobj('$STRING',[S]):- !, writeq(S). +write_mobj(F,Args):- fail, mlog_sym(K),!,pp_sex_c([K,F|Args]). +%write_mobj(F,Args):- pp_sex_c([F|Args]). + +print_items_list(X):- is_list(X),!,print_list_as_sexpression(X). +print_items_list(X):- write_src(X). + +pp_sex_l(V):- pp_sexi_l(V),!. +pp_sexi_l(V) :- is_final_write(V),!. +%pp_sexi_l([F|V]):- integer(F), is_codelist([F|V]),!,format("|~s|",[[F|V]]). +pp_sexi_l([F|V]):- symbol(F), is_list(V),write_mobj(F,V),!. +pp_sexi_l([H|T]):-T ==[],!,write('('), pp_sex_nc(H),write(')'). +pp_sexi_l([H,H2]):- write('('), pp_sex_nc(H), write(' '), with_indents(false,print_list_as_sexpression([H2])), write(')'),!. +pp_sexi_l([H|T]):- write('('), + pp_sex_nc(H), write(' '), print_list_as_sexpression(T), write(')'),!. + +pp_sexi_l([H,S]):-H=='[...]', write('['),print_items_list(S),write(' ]'). +pp_sexi_l([H,S]):-H=='{...}', write('{'),print_items_list(S),write(' }'). +%pp_sex_l(X):- \+ compound(X),!,write_src(X). +%pp_sex_l('$VAR'(S))):- +pp_sexi_l([=,H,B]):- pp_sexi_hb(H,B),!. + +pp_sexi_l([H|T]) :- \+ no_src_indents, symbol(H),member(H,['If','cond','let','let*']),!, + with_indents(true,w_proper_indent(2,w_in_p(pp_sex([H|T])))). + +pp_sexi_l([H|T]) :- is_list(T), length(T,Args),Args =< 2, fail, + wots(SS,((with_indents(false,(write('('), pp_sex_nc(H), write(' '), print_list_as_sexpression(T), write(')')))))), + ((symbol_length(SS,Len),Len < 20) ->write(SS); + with_indents(true,w_proper_indent(2,w_in_p(pp_sex_c([H|T]))))),!. +/* + +pp_sexi_l([H|T]) :- is_list(T),symbol(H),upcase_atom(H,U),downcase_atom(H,U),!, + with_indents(false,(write('('), pp_sex_nc(H), write(' '), print_list_as_sexpression(T), write(')'))). + +%pp_sex([H,B,C|T]) :- T==[],!, +% with_indents(false,(write('('), pp_sex(H), print_list_as_sexpression([B,C]), write(')'))). +*/ + +pp_sexi_hb(H,B):- + write('(= '), with_indents(false,pp_sex(H)), write(' '), + ((is_list(B),maplist(is_list,B)) + ->with_indents(true,maplist(write_src_inl,B)) + ;with_indents(true,pp_sex(B))), + write(')'). + +write_src_inl(B):- nl, write(' '),pp_sex(B). + +pp_sex_c(V):- pp_sexi_c(V),!. +pp_sexi_c(V) :- is_final_write(V),!. +pp_sexi_c((USER:Body)) :- USER==user,!, pp_sex(Body). +pp_sexi_c(exec([H|T])) :- is_list(T),!,write('!'),pp_sex_l([H|T]). +pp_sexi_c(!([H|T])) :- is_list(T),!,write('!'),pp_sex_l([H|T]). +%pp_sexi_c([H|T]) :- is_list(T),!,unlooped_fbug(pp_sexi_c,pp_sex_l([H|T])). +pp_sexi_c([H|T]) :- is_list(T),!,pp_sex_l([H|T]). +%pp_sexi_c(V) :- print(V),!. + +pp_sexi_c(=(H,B)):- !, pp_sexi_hb(H,B),!. +pp_sexi_c(V):- compound_name_list(V,F,Args),write_mobj(F,Args),!. +% Compound terms. +%pp_sex(Term) :- compound(Term), Term =.. [Functor|Args], write('('),format('(~w ',[Functor]), write_args_as_sexpression(Args), write(')'). +%pp_sex(Term) :- Term =.. ['=',H|Args], length(Args,L),L>2, write('(= '), pp_sex(H), write('\n\t\t'), maplist(pp_sex(2),Args). +pp_sexi_c(V):- ( \+ compound(V) ; is_list(V)),!, pp_sex(V). +pp_sexi_c(listOf(S,_)) :- !,write_mobj(listOf(S)). +pp_sexi_c(listOf(S)) :- !,format('(ListValue ~@)',[pp_sex(S)]). +pp_sexi_c('!'(V)) :- write('!'),!,pp_sex(V). +%pp_sex_c('exec'(V)) :- write('!'),!,pp_sex(V). +pp_sexi_c('='(N,V)):- allow_concepts, !, format("~N;; ~w == ~n",[N]),!,pp_sex(V). +%pp_sex_c(V):- writeq(V). + +pp_sexi_c(Term) :- compound_name_arity(Term,F,0),!,pp_sex_c([F]). +pp_sexi_c(Term) :- Term =.. [Functor|Args], always_dash_functor(Functor,DFunctor), format('(~w ',[DFunctor]), write_args_as_sexpression(Args), write(')'),!. +pp_sexi_c(Term) :- allow_concepts, Term =.. [Functor|Args], format('(EvaluationLink (PredicateNode "~w") (ListLink ',[Functor]), write_args_as_sexpression(Args), write('))'),!. +pp_sexi_c(Term) :- + Term =.. [Functor|Args], + always_dash_functor(Functor,DFunctor), format('(~w ',[DFunctor]), + write_args_as_sexpression(Args), write(')'),!. + +pp_sexi(2,Result):- write('\t\t'),pp_sex(Result). + + +current_column(Column) :- current_output(Stream), line_position(Stream, Column),!. +current_column(Column) :- stream_property(current_output, position(Position)), stream_position_data(column, Position, Column). +min_indent(Sz):- current_column(Col),Col>Sz,nl,indent_len(Sz). +min_indent(Sz):- current_column(Col),Need is Sz-Col,indent_len(Need),!. +min_indent(Sz):- nl, indent_len(Sz). +indent_len(Need):- forall(between(1,Need,_),write(' ')). + +w_proper_indent(N,G):- + flag(w_in_p,X,X), %(X==0->nl;true), + XX is (X*2)+N,setup_call_cleanup(min_indent(XX),G,true). +w_in_p(G):- setup_call_cleanup(flag(w_in_p,X,X+1),G,flag(w_in_p,_,X)). + + +always_dash_functor(A,B):- once(dash_functor(A,B)),A\=@=B,!. +always_dash_functor(A,A). + + +dash_functor(A,C):- \+ symbol(A),!,C=A. +% dash_functor(A,C):- p2m(A,B),A\==B,!,always_dash_functor(B,C). +dash_functor(ASymbolProc,O):- fail, symbol_contains(ASymbolProc,'_'), + symbol_contains(ASymbolProc,'atom'), + current_predicate(system:ASymbolProc/_), + symbolic_list_concat(LS,'atom',ASymbolProc), + symbolic_list_concat(LS,'symbol',SymbolProc), + always_dash_functor(SymbolProc,O),!. +dash_functor(ASymbolProc,O):- symbol_concat('$',LS,ASymbolProc),!, + symbol_concat('%',LS,SymbolProc), + always_dash_functor(SymbolProc,O). + +dash_functor(Functor,DFunctor):- fail, + symbolic_list_concat(L,'_',Functor), L\=[_], + symbolic_list_concat(L,'-',DFunctor). + +% Print arguments of a compound term. +write_args_as_sexpression([]). +write_args_as_sexpression([H|T]) :- write(' '), pp_sex(H), write_args_as_sexpression(T). + +% Print the rest of the list. +print_list_as_sexpression([]). +print_list_as_sexpression([H]):- pp_sex(H). +%print_list_as_sexpression([H]):- w_proper_indent(pp_sex(H)),!. +print_list_as_sexpression([H|T]):- pp_sex(H), write(' '), print_list_as_sexpression(T). + + + +% The predicate with_indents/2 modifies the src_indents option value during the execution of a goal. +% The first argument is the desired value for src_indents, +% and the second argument is the Goal to be executed with the given src_indents setting. +with_indents(TF, Goal) :- + % Set the value of the `src_indents` option to TF and then execute the Goal + as_tf(TF,Value), + with_option(src_indents, Value, Goal). + +no_src_indents:- option_else(src_indents,TF,true),!,TF=='False'. + +no_quoting_symbols:- option_else(no_quoting_symbols,TF,true),!,TF=='True'. + +with_no_quoting_symbols(TF, Goal) :- + % Set the value of the `no_src_indents` option to TF and then execute the Goal + with_option(no_quoting_symbols, TF, Goal). + +% The predicate allow_concepts/0 checks whether the use of concepts is allowed. +% It does this by checking the value of the concepts option and ensuring it is not false. +allow_concepts :- !, fail, + % Check if the option `concepts` is not set to false + option_else(concepts, TF, 'False'), + \+ TF == 'False'. + +% The predicate with_concepts/2 enables or disables the use of concepts during the execution of a given goal. +% The first argument is a Boolean indicating whether to enable (true) or disable (false) concepts. +% The second argument is the Goal to be executed with the given concepts setting. +with_concepts(TF, Goal) :- + % Set the value of the `concepts` option to TF and then execute the Goal + with_option(concepts, TF, Goal). + +% Rules for determining when a symbol needs to be quoted in metta. +dont_quote(Atom):- symbol_length(Atom,1), !, char_type(Atom,punct). +dont_quote(Atom):- symbol(Atom),upcase_atom(Atom,Atom),downcase_atom(Atom,Atom). + +should_quote(Atom) :- \+ symbol(Atom), \+ string(Atom),!,fail. +should_quote(Atom) :- + \+ dont_quote(Atom), + % symbol(Atom), % Ensure that the input is an symbol + symbol_chars(Atom, Chars), + once(should_quote_chars(Chars);should_quote_symbol_chars(Atom,Chars)). + +contains_unescaped_quote(['"']):- !, fail. % End with a quote +contains_unescaped_quote(['"'|_]) :- !. +contains_unescaped_quote(['\\', '"'|T]) :- !, contains_unescaped_quote(T). +contains_unescaped_quote([_|T]) :- contains_unescaped_quote(T). + +% Check if the list of characters should be quoted based on various conditions +should_quote_chars([]). +should_quote_chars(['"'|Chars]):- !, contains_unescaped_quote(Chars). +should_quote_chars(Chars) :- + member('"', Chars); % Contains quote not captured with above clause + member(' ', Chars); % Contains space + member('''', Chars); % Contains single quote + % member('/', Chars); % Contains slash + member(',', Chars); % Contains comma + (fail,member('|', Chars)). % Contains pipe +%should_quote_symbol_chars(Atom,_) :- symbol_number(Atom,_),!. +should_quote_symbol_chars(Atom,[Digit|_]) :- fail, char_type(Digit, digit), \+ symbol_number(Atom,_). + +% Example usage: +% ?- should_quote('123abc'). +% true. +% ?- should_quote('123.456'). +% false. + + +:- ensure_loaded(metta_interp). +:- ensure_loaded(metta_compiler). +:- ensure_loaded(metta_convert). +:- ensure_loaded(metta_types). +:- ensure_loaded(metta_space). +:- ensure_loaded(metta_testing). +:- ensure_loaded(metta_utils). +:- ensure_loaded(metta_printer). +:- ensure_loaded(metta_eval). diff --git a/.Attic/canary_docme/metta_python.pl b/.Attic/canary_docme/metta_python.pl new file mode 100644 index 00000000000..fb3d70563f7 --- /dev/null +++ b/.Attic/canary_docme/metta_python.pl @@ -0,0 +1,1039 @@ +/* + * 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. + */ + +:- encoding(iso_latin_1). +:- flush_output. +:- setenv('RUST_BACKTRACE',full). +%:- '$set_source_module'('user'). +:- set_prolog_flag(py_backtrace_depth,10). +:- set_prolog_flag(py_backtrace, true). +:- set_prolog_flag(py_argv,[]). +%:- set_prolog_flag(argv,[]). +/* +# Core in Rust +In the original version, the core logic and functionalities of the MeTTa system are implemented in Rust. Rust is known for its performance and safety features, making it a suitable choice for building robust, high-performance systems. + +# Python Extensions +Python is used to extend or customize MeTTa. Typically, Python interacts with the Rust core through a Foreign Function Interface (FFI) or similar bridging mechanisms. This allows Python programmers to write code that can interact with the lower-level Rust code, while taking advantage of Python's ease of use and rich ecosystem. + +# Prolog Allows Python Extensions +Just like the Rust core allowed for Python extensions, the Prolog code also permits Python and Rust developers (thru python right now) to extend or customize parts of MeTTa. This maintains the system?s extensibility and allows users who are more comfortable with Python to continue working with the system effectively. + +*/ +:- use_module(library(filesex)). + +:- + (module_property(janus,file(File))-> + janus:ensure_loaded(File); + (exists_file('/usr/local/lib/swipl/library/ext/swipy/janus.pl') + -> janus:ensure_loaded('/usr/local/lib/swipl/library/ext/swipy/janus.pl') + ; janus:ensure_loaded(library(janus)))). + +:- multifile(is_python_space/1). +:- dynamic(is_python_space/1). +:- volatile(is_python_space/1). + +is_rust_space(GSpace):- is_python_space(GSpace). + +is_not_prolog_space(GSpace):- is_rust_space(GSpace), !. +is_not_prolog_space(GSpace):- \+ is_asserted_space(GSpace), \+ is_nb_space(GSpace), !. + +with_safe_argv(Goal):- + current_prolog_flag(argv,Was), + setup_call_cleanup(set_prolog_flag(argv,[]), + py_catch(Goal), + set_prolog_flag(argv,Was)). +with_safe_argv(G1,G2):- with_safe_argv((G1,G2)). +py_catch((G1,G2)):-!,py_catch(G1),py_catch(G2). +py_catch(Goal):- catch(Goal,E,(pybug(E=py_catch(Goal)),py_dump,trace,Goal)). +%py_catch(Goal):- trace,catch(Goal,E,(pybug(E),py_dump)),!. +py_dump:- py_call(traceback:print_exc()). + +py_call_c(G):- py_catch(py_call(G)). +py_call_c(G,R):- py_catch(py_call(G,R)). + +py_is_module(M):-notrace((with_safe_argv(py_is_module_unsafe(M)))). + +py_is_module_unsafe(M):- py_is_object(M),!,py_type(M,module). +py_is_module_unsafe(M):- catch((py_call(M,X),py_type(X,module)),_,fail). + +%py_is_py(_):- \+ py_is_enabled, !, fail. +py_is_py(V):- var(V),!, get_attr(V,pyobj,_),!. +py_is_py(V):- compound(V),!,fail. +py_is_py(V):- is_list(V),!,fail. +py_is_py(V):- atomic(V), !, \+ atom(V), py_is_object(V),!. +py_is_py(V):- \+ callable(V),!,fail. +py_is_py(V):- py_is_tuple(V),!. +py_is_py(V):- py_is_py_dict(V),!. +py_is_py(V):- py_is_list(V),!. + +py_resolve(V,Py):- var(V),!, get_attr(V,pyobj,Py),!. +py_resolve(V,Py):- \+ compound(V),!,py_is_object(V),Py=V. +py_resolve(V,Py):- is_list(V),!,fail,maplist(py_resolve,V,Py). +py_resolve(V,Py):- V=Py. + +py_is_tuple(X):- py_resolve(X,V), py_tuple(V,T),py_tuple(T,TT),T==TT, \+ py_type(V,str). +py_is_py_dict(X):- atomic(X),py_is_object(X),py_type(X,dict). +%py_is_py_dict(X):- py_resolve(X,V), py_dict(V,T), py_dict(T,TT), T==TT. +py_is_list(X):- py_resolve(X,V), py_type(V,list). +%py_is_list(V):- py_is_tuple(V). + +% Evaluations and Iterations +:- thread_local(did_load_builtin_module/0). +:- volatile(did_load_builtin_module/0). +:- dynamic(did_load_builtin_module/0). +load_builtin_module:- did_load_builtin_module,!. +load_builtin_module:- assert(did_load_builtin_module), +py_module(builtin_module, +' +import sys +#import numpy + +the_modules_and_globals=None + +def eval_string(s): + global the_modules_and_globals + global_vars = the_modules_and_globals + local_vars = locals() + return eval(s,global_vars,local_vars) + +def exec_string(s): + global the_modules_and_globals + global_vars = the_modules_and_globals + local_vars = locals() + return exec(s,global_vars,local_vars) + +def py_nth(s,nth): + return s[nth] + +def identity(s): + return s + +def get_globals(): + return globals() + +def merge_modules_and_globals(): + # Get all currently loaded modules + loaded_modules = sys.modules + + # Get all global variables + global_vars = globals() + + # Prepare a combined dictionary + global the_modules_and_globals + combined_dict = the_modules_and_globals + if combined_dict is None: + combined_dict = {} + + # Add modules with a prefix or special key to distinguish them + for mod_name, mod_obj in loaded_modules.items(): + combined_dict[f"module_{mod_name}"] = mod_obj + combined_dict[f"{mod_name}"] = mod_obj + + # Add global variables with a prefix or special key + for var_name, var_value in global_vars.items(): + combined_dict[f"global_{var_name}"] = var_value + combined_dict[f"{var_name}"] = var_value + + the_modules_and_globals = combined_dict + return combined_dict + +def get_locals(): + return locals() + +def iter_collection(s): + return iter(s) + +def string_conversion(s): + return str(s) + +def string_representation(s): + return repr(s) + +def py_len(s): + return len(s) + +def py_list(s): + return list(s) + +def py_dict(s): + return dict(s) + +def py_dict0(): + return dict() + +def py_map(s): + return map(s) + +def py_tuple(s): + return tuple(s) + +def py_set(s): + return set(s) + +def absolute_value(num): + return abs(num) + +def all_true(iterable): + return all(iterable) + +def any_true(iterable): + return any(iterable) + +def as_ascii(s): + return ascii(s) + +def binary_conversion(num): + return bin(num) + +def boolean_conversion(val): + return bool(val) + +def chr_conversion(num): + return chr(num) + +def hexadecimal_conversion(num): + return hex(num) + +def octal_conversion(num): + return oct(num) + +# Arithmetic and Conversion +def int_conversion(s): + return int(s) + +def float_conversion(s): + return float(s) + +def complex_conversion(real, imag=0): + return complex(real, imag) + +def divmod_func(a, b): + return divmod(a, b) + +def pow_func(base, exp): + return pow(base, exp) + +# Collection Handling +def sorted_iterable(iterable, key=None, reverse=False): + return sorted(iterable, key=key, reverse=reverse) + +def sum_iterable(iterable, start=0): + return sum(iterable, start) + +def min_value(*args, key=None): + return min(*args, key=key) + +def max_value(*args, key=None): + return max(*args, key=key) + +# Type and Attribute Handling +def type_of(obj): + return type(obj) + +def isinstance_of(obj, classinfo): + return isinstance(obj, classinfo) + +def print_nonl(sub): + return print(sub, end="") + +def issubclass_of(sub, superclass): + return issubclass(sub, superclass) + +def getattr_func(obj, name, default=None): + return getattr(obj, name, default) + +def setattr_func(obj, name, value): + setattr(obj, name, value) + +def hasattr_func(obj, name): + return hasattr(obj, name) + +# File and I/O +def open_file(filename, mode="r", buffering=-1): + return open(filename, mode, buffering) + +# Exception Handling +def raise_exception(exctype, msg=None): + if msg: + raise exctype(msg) + else: + raise exctype() + +# Miscellaneous +def callable_check(obj): + return callable(obj) + +def id_func(obj): + return id(obj) + +def help_func(obj): + help(obj) # This will print the help to the standard output + +import inspect + +def get_str_rep(func): + if not inspect.isfunction(func): + return func + if func.__module__ == "__main__": + return func.__name__ + return f"{func.__module__}.{func.__name__}" + +the_modules_and_globals = merge_modules_and_globals() + +'). + +pych_chars(Chars,P):- \+ is_list(Chars), !, P = Chars. +pych_chars(Chars,P):- append(O,`\r@(none)`,Chars),!,pych_chars(O,P). +pych_chars(Chars,P):- append(O,`\n@(none)`,Chars),!,pych_chars(O,P). +pych_chars(Chars,P):- append(O,`@(none)`,Chars),!,pych_chars(O,P). +pych_chars(Chars,P):- append(O,[WS],Chars),code_type(WS,new_line),!,pych_chars(O,P). +pych_chars(Chars,P):- append(O,[WS],Chars),code_type(WS,end_of_line),!,pych_chars(O,P). +pych_chars(P,P). + + +py_ppp(V):-flush_output, with_output_to(codes(Chars), once(py_pp(V))), + pych_chars(Chars,P),!,format('~s',[P]),!,flush_output. + +%atom_codes(Codes,P),writeq(Codes), +%py_ppp(V):- !, flush_output, py_mbi(print_nonl(V),_),!,flush_output. +%py_ppp(V):- writeq(py(V)),!. +%py_ppp(V):-once((py_is_object(V),py_to_pl(V,PL))),V\=@=PL,!,print(PL). +%py_ppp(V):-metta_py_pp(V). + +% Evaluations and Iterations +:- thread_local(did_load_hyperon_module/0). +:- volatile(did_load_hyperon_module/0). +:- dynamic(did_load_hyperon_module/0). +load_hyperon_module:- did_load_hyperon_module,!. +load_hyperon_module:- assert(did_load_hyperon_module), + py_module(hyperon_module,' + +from hyperon.base import Atom +from hyperon.atoms import OperationAtom, E, GroundedAtom, GroundedObject +from hyperon.ext import register_tokens +from hyperon.ext import register_atoms +from hyperon.atoms import G, AtomType +from hyperon.runner import MeTTa +from hyperon.atoms import * +import hyperonpy as hp + +import sys +import readline +import os +import atexit + +class MeTTaVS(MeTTa): + def copy(self): + return self + +runner = MeTTaVS() + +def rust_metta_run(obj): + return runner.run(obj) + +def rust_unwrap(obj): + if isinstance(obj,SymbolAtom): + return obj.get_name() + if isinstance(obj,ExpressionAtom): + return obj.get_children() + if isinstance(obj,GroundedAtom): + return obj.get_object() + if isinstance(obj,GroundedObject): + return obj.content + return obj + +def rust_deref(obj): + while True: + undone = rust_unwrap(obj) + if undone is obj: return obj + if undone is None: return obj + obj = undone + +'). + + +py_mcall(I,O):- catch(py_call(I,M,[py_object(false),py_string_as(string),py_dict_as({})]),error(_,_),fail),!,O=M. +py_scall(I,O):- catch(py_call(I,M,[py_string_as(string)]),error(_,_),fail),!,O=M. +py_acall(I,O):- catch(py_call(I,M,[py_string_as(atom)]),error(_,_),fail),!,O=M. +py_ocall(I,O):- catch(py_call(I,M,[py_object(true),py_string_as(string)]),error(_,_),fail),!,O=M. + + +py_bi(I,O,Opts):- load_builtin_module,catch(py_call(builtin_module:I,M,Opts),error(_,_),fail),!,O=M. +py_obi(I,O):- load_builtin_module,py_ocall(builtin_module:I,O). +py_mbi(I,O):- load_builtin_module,py_mcall(builtin_module:I,O). +%?- py_call(type(hi-there), P),py_pp(P). +get_str_rep(I,O):- py_mbi(get_str_rep(I),O),!. + +py_atom(I,O):- var(I),!,O=I. +py_atom([I|Is],O):-!, py_dot(I,II),py_dot_from(II,Is,O),!. +py_atom(I,O):- atomic(I),!,py_atomic(I,O). +py_atom(I,O):- py_ocall(I,O),!. +py_atom(I,O):- I=O. + +py_atom_type(I,_Type,O):- var(I),!,O=I. +py_atom_type([I|Is],_Type,O):-!, py_dot(I,II),py_dot_from(II,Is,O). +py_atom_type(I,_Type,O):- atomic(I),!,py_atomic(I,O). +py_atom_type(I,_Type,O):- py_ocall(I,O),!. +py_atom_type(I,_Type,O):- I=O. + +py_atomic([],O):-py_ocall("[]",O),!. +py_atomic(I,O):- py_is_object(I),!,O=I. +py_atomic(I,O):- string(I),py_eval(I,O),!. +py_atomic(I,O):- py_ocall(I,O),!. +py_atomic(I,O):- py_eval(I,O),!. +py_atomic(I,O):- \+ symbol_contains(I,'('),atomic_list_concat([A,B|C],'.',I),py_dot([A,B|C],O),!. +py_atomic(I,O):- string(I), py_dot(I,O),!. +py_atomic(I,O):- I=O. + +get_globals(O):- py_mbi(get_globals(),O). +get_locals(O):- py_mbi(get_locals(),O). +merge_modules_and_globals(O):- py_mbi(merge_modules_and_globals(),O). +py_eval(I,O):- py_obi(eval_string(I),O). +py_eval(I):- py_eval(I,O),pybug(O). +py_exec(I,O):- py_mbi(exec_string(I),O). +py_exec(I):- py_exec(I,O),pybug(O). + +py_dot(I,O):- string(I),atom_string(A,I),py_atom(A,O),A\==O,!. +py_dot(I,O):- py_atom(I,O). + +py_dot_from(From,I,O):- I==[],!,O=From. +py_dot_from(From,[I|Is],O):- !, py_dot_from(From,I,M),py_dot_from(M,Is,O). +py_dot_from(From,I,O):- atomic_list_concat([A,B|C],'.',I),!,py_dot_from(From,[A,B|C],O). +py_dot_from(From,I,O):- py_dot(From,I,O). + +py_eval_object(Var,VO):- var(Var),!,VO=Var. +py_eval_object([V|VI],VO):- py_is_function(V),!,py_eval_from(V,VI,VO). +py_eval_object([V|VI],VO):- maplist(py_eval_object,[V|VI],VO). +py_eval_object(VO,VO). + +py_is_function(O):- \+ py_is_object(O),!,fail. +py_is_function(O):- py_type(O, function),!. +%py_is_function(O):- py_type(O, method),!. + +py_eval_from(From,I,O):- I==[],!,py_dot(From,O). +py_eval_from(From,[I],O):- !, py_fcall(From,I,O). +py_eval_from(From,[I|Is],O):- !, py_dot_from(From,I,M),py_eval_from(M,Is,O). +py_eval_from(From,I,O):- atomic_list_concat([A,B|C],'.',I),!,py_eval_from(From,[A,B|C],O). +py_eval_from(From,I,O):- py_fcall(From,I,O). + +py_fcall(From,I,O):- py_ocall(From:I,O). + +ensure_space_py(Space,GSpace):- py_is_object(Space),!,GSpace=Space. +ensure_space_py(Space,GSpace):- var(Space),ensure_primary_metta_space(GSpace), Space=GSpace. +ensure_space_py(metta_self,GSpace):- ensure_primary_metta_space(GSpace),!. + +:- dynamic(is_metta/1). +:- volatile(is_metta/1). +ensure_rust_metta(MeTTa):- is_metta(MeTTa),py_is_object(MeTTa),!. +ensure_rust_metta(MeTTa):- with_safe_argv(ensure_rust_metta0(MeTTa)),asserta(is_metta(MeTTa)). + +ensure_rust_metta0(MeTTa):- ensure_mettalog_py(MettaLearner), py_call(MettaLearner:'get_metta'(),MeTTa), + py_is_object(MeTTa). +ensure_rust_metta0(MeTTa):- py_call('mettalog':'MeTTaLog'(),MeTTa). +ensure_rust_metta0(MeTTa):- py_call(hyperon:runner:'MeTTa'(),MeTTa),!. + +ensure_rust_metta:- ensure_rust_metta(_). + +:- dynamic(is_mettalog/1). +:- volatile(is_mettalog/1). +ensure_mettalog_py(MettaLearner):- is_mettalog(MettaLearner),!. +ensure_mettalog_py(MettaLearner):- + with_safe_argv( + (want_py_lib_dir, + %py_call('mettalog',MettaLearner), + %py_call('motto',_), + %py_call('motto.sparql_gate':'sql_space_atoms'(),Res1),pybug(Res1), + %py_call('motto.llm_gate':'llmgate_atoms'(MeTTa),Res2),pybug(Res2), + + pybug(is_mettalog(MettaLearner)), + asserta(is_mettalog(MettaLearner)))). + +ensure_mettalog_py:- + %load_builtin_module, + %load_hyperon_module, + setenv('VSPACE_VERBOSE',0), + with_safe_argv(ensure_mettalog_py(_)),!. + + + +:- multifile(space_type_method/3). +:- dynamic(space_type_method/3). +space_type_method(is_not_prolog_space,new_space,new_rust_space). +space_type_method(is_not_prolog_space,add_atom,add_to_space). +space_type_method(is_not_prolog_space,remove_atom,remove_from_space). +space_type_method(is_not_prolog_space,replace_atom,replace_in_space). +space_type_method(is_not_prolog_space,atom_count,atom_count_from_space). +space_type_method(is_not_prolog_space,get_atoms,query_from_space). +space_type_method(is_not_prolog_space,atom_iter,atoms_iter_from_space). +space_type_method(is_not_prolog_space,query,query_from_space). + +:- dynamic(is_primary_metta_space/1). +:- volatile(is_primary_metta_space/1). +% Initialize a new hyperon.base.GroundingSpace and get a reference +ensure_primary_metta_space(GSpace) :- is_primary_metta_space(GSpace),!. +ensure_primary_metta_space(GSpace) :- ensure_rust_metta(MeTTa), + with_safe_argv(py_call(MeTTa:space(),GSpace)), + asserta(is_primary_metta_space(GSpace)). +ensure_primary_metta_space(GSpace) :- new_rust_space(GSpace). +ensure_primary_metta_space:- ensure_primary_metta_space(_). + +:- if( \+ current_predicate(new_rust_space/1 )). +% Initialize a new hyperon.base.GroundingSpace and get a reference +new_rust_space(GSpace) :- + with_safe_argv(py_call(hyperon:base:'GroundingSpace'(), GSpace)), + asserta(is_python_space(GSpace)). +:- endif. + +:- if( \+ current_predicate(query_from_space/3 )). +% Query from hyperon.base.GroundingSpace +query_from_space(Space, QueryAtom, Result) :- + ensure_space(Space,GSpace), + py_call(GSpace:'query'(QueryAtom), Result). + + +% Replace an atom in hyperon.base.GroundingSpace +replace_in_space(Space, FromAtom, ToAtom) :- + ensure_space(Space,GSpace), + py_call(GSpace:'replace'(FromAtom, ToAtom), _). + +% Get the atom count from hyperon.base.GroundingSpace +atom_count_from_space(Space, Count) :- + ensure_space(Space,GSpace), + py_call(GSpace:'atom_count'(), Count). + +% Get the atoms from hyperon.base.GroundingSpace +atoms_from_space(Space, Atoms) :- + ensure_space(Space,GSpace), + py_call(GSpace:'get_atoms'(), Atoms). + +atom_from_space(Space, Sym):- + atoms_iter_from_space(Space, Atoms),elements(Atoms,Sym). + +% Get the atom iterator from hyperon.base.GroundingSpace +atoms_iter_from_space(Space, Atoms) :- + ensure_space(Space,GSpace), + with_safe_argv(py_call(src:'mettalog':get_atoms_iter_from_space(GSpace),Atoms)), + %py_call(GSpace:'atoms_iter'(), Atoms). + true. +:- endif. + +metta_py_pp(V):- py_is_enabled,once((py_is_object(V),py_to_pl(V,PL))),V\=@=PL,!,metta_py_pp(PL). +metta_py_pp(V):- atomic(V),py_is_enabled,py_is_object(V),py_pp(V),!. +metta_py_pp(V):- format('~p',[V]),!. + +% py_to_pl/2 - Converts a Python object to a Prolog term. +py_to_pl(I,O):- py_to_pl(_,I,O). + +% py_to_pl/3 - Calls py_to_pl/6 with initial parameters. +py_to_pl(VL,I,O):- ignore(VL=[vars]), py_to_pl(VL,[],[],_,I,O),!. + +% is_var_or_nil/1 - Checks if the input is a variable or an empty list. +is_var_or_nil(I):- var(I),!. +is_var_or_nil([]). + +% py_to_pl/6 - Main conversion predicate. +% print what we are doing +%py_to_pl(VL,Par,_Cir,_,L,_):- pybug(py_to_pl(VL,Par,L)),fail. +% If L is a variable, E is unified with L. +py_to_pl(_VL,_Par,Cir,Cir,L,E):- var(L),!,E=L. +% If L is an empty list, unify E with L. +py_to_pl(_VL,_Par,Cir,Cir,L,E):- L ==[],!,E=L. + +% If O is an object, convert it to Prolog. +py_to_pl(VL, Par, Cir, CirO, O, E) :- py_is_object(O), py_class(O, Cl), !, + pyo_to_pl(VL, Par, [O = E | Cir], CirO, Cl, O, E). +% If L is in the Cir list, unify E with L. + +%py_to_pl(_VL,_Par,Cir,Cir,L,E):- py_is_dict(L),!,py_mbi(identity(L),E). +py_to_pl(_VL,_Par,Cir,Cir,L,E):- member(N-NE,Cir), N==L, !, (E=L;NE=E), !. +% If LORV is a variable or nil, unify it directly. +py_to_pl(_VL,_Par,Cir,Cir, LORV:B,LORV:B):- is_var_or_nil(LORV), !. +py_to_pl(_VL,_Par,Cir,Cir, LORV:_B:_C,LORV):- is_var_or_nil(LORV), !. +% If L is not callable, unify E with L. +py_to_pl(_VL,_Par,Cir,Cir,L,E):- \+ callable(L),!,E=L. +% Convert lists with annotations. +py_to_pl(VL, Par, Cir, CirO, [H|T]:B:C, [HH|TT]) :- + py_to_pl(VL, Par, Cir, CirM, H:B:C, HH), + py_to_pl(VL, Par, CirM, CirO, T:B:C, TT),!. +py_to_pl(VL, Par, Cir, CirO, [H|T]:B, [HH|TT]) :- + py_to_pl(VL, Par, Cir, CirM, H:B, HH), + py_to_pl(VL, Par, CirM, CirO, T:B, TT). +% Handle objects with callable methods. +py_to_pl(VL, Par, Cir, CirO, A:B:C, AB) :- + py_is_object(A), + callable(B), + py_call(A:B, R), + py_to_pl(VL, Par, Cir, CirO, R:C, AB). +py_to_pl(VL, Par, Cir, CirO, A:B, AB) :- + py_is_object(A), + callable(B), + py_call(A:B, R), + py_to_pl(VL, Par, Cir, CirO, R, AB). + +% Convert compound terms. +py_to_pl(VL, Par, Cir, CirO, A:B, AA:BB) :- !, + py_to_pl(VL, Par, Cir, CirM, A, AA), + py_to_pl(VL, Par, CirM, CirO, B, BB). +py_to_pl(VL, Par, Cir, CirO, A-B, AA-BB) :- !, + py_to_pl(VL, Par, Cir, CirM, A, AA), + py_to_pl(VL, Par, CirM, CirO, B, BB). + +py_to_pl(_VL,_Par,Cir,Cir,L,E):- \+ callable(L),!,E=L. + +% If L is an atom, unify E with L. +py_to_pl(_VL,_Par,Cir,Cir,L,E):- atom(L),!,E=L. + +% Convert lists. +py_to_pl(VL, Par, Cir, CirO, [H|T], [HH|TT]) :- !, + py_to_pl(VL, Par, Cir, CirM, H, HH), + py_to_pl(VL, Par, CirM, CirO, T, TT). + +% Handle dictionaries. +py_to_pl(VL, Par, Cir, CirO, L, E) :- is_dict(L, F), !, + dict_pairs(L, F, NV), !, + py_to_pl(VL, Par, Cir, CirO, NV, NVL), + dict_pairs(E, F, NVL). + +% If L is not callable, unify E with L. +py_to_pl(_VL,_Par,Cir,Cir,L,E):- \+ callable(L),!,E=L. +%py_to_pl(VL,Par,Cir,CirO,A:B:C,AB):- py_is_object(A),callable(B),py_call(A:B,R),!, py_to_pl(VL,Par,[A:B-AB|Cir],CirO,R:C,AB). +%py_to_pl(VL,Par,Cir,CirO,A:B,AB):- py_is_object(A),callable(B),py_call(A:B,R),!, py_to_pl(VL,Par,[A:B-AB|Cir],CirO,R,AB). + +% Convert compound terms using compound_name_arguments/3. +py_to_pl(VL, Par, Cir, CirO, A, AA) :- compound(A), !, + compound_name_arguments(A, F, L), + py_to_pl(VL, Par, Cir, CirO, L, LL), + compound_name_arguments(AA, F, LL). + +% Default case: unify E with E. +py_to_pl(_VL,_Par,Cir,Cir,E,E). +/* +varname_to_real_var(RL,E):- upcase_atom(RL,R),varname_to_real_var0(R,E). +varname_to_real_var0(R,E):- nb_current('cvariable_names',VL),!,varname_to_real_var0(R,VL,E). +varname_to_real_var0(R,E):- nb_setval('cvariable_names',[R=v(_)]),!,varname_to_real_var0(R,E). +varname_to_real_var0(R,[],E):- nb_setval('cvariable_names',[R=v(_)]),!,varname_to_real_var0(R,E). +varname_to_real_var0(R,VL,E):- member(N=V,VL), N==R,!,arg(1,V,E). +varname_to_real_var0(R,VL,E):- extend_container(VL,R=v(_)),varname_to_real_var0(R,E).*/ +% Predicate to extend the list inside the container +extend_container(Container, Element) :- + arg(2, Container, List), + nb_setarg(2, Container, [Element|List]). + +rinto_varname(R,RN):- atom_number(R,N),atom_concat('Num',N,RN). +rinto_varname(R,RN):- upcase_atom(R,RN). +real_VL_var(RL,VL,E):- nonvar(RL), !, rinto_varname(RL,R),!,real_VL_var0(R,VL,E). +real_VL_var(RL,VL,E):- member(N=V,VL), V==E,!,RL=N. +real_VL_var(RL,VL,E):- compound(E),E='$VAR'(RL),ignore(real_VL_var0(RL,VL,E)),!. +real_VL_var(RL,VL,E):- format(atom(RL),'~p',[E]), member(N=V,VL), N==RL,!,V=E. +real_VL_var(RL,VL,E):- format(atom(RL),'~p',[E]), real_VL_var0(RL,VL,E). +real_VL_var0(R,VL,E):- member(N=V,VL), N==R,!,V=E. +real_VL_var0(R,VL,E):- extend_container(VL,R=E),!. % ,E='$VAR'(R). + +pyo_to_pl(VL,_Par,Cir,Cir,Cl,O,E):- Cl=='VariableAtom', !, py_call(O:get_name(),R), real_VL_var(R,VL,E),!. +pyo_to_pl(VL,Par,Cir,CirO,Cl,O,E):- class_to_pl1(Par,Cl,M),py_member_values(O,M,R), !, py_to_pl(VL,[Cl|Par],Cir,CirO,R,E). +pyo_to_pl(VL,Par,Cir,CirO,Cl,O,E):- class_to_pl(Par,Cl,M), % pybug(class_to_pl(Par,Cl,M)), + py_member_values(O,M,R), !, py_to_pl(VL,[Cl|Par],Cir,CirO,R,E). +pyo_to_pl(VL,Par,Cir,CirO,Cl,O,E):- catch(py_obj_dir(O,L),_,fail),pybug(py_obj_dir(O,L)),py_decomp(M),meets_dir(L,M),pybug(py_decomp(M)), + py_member_values(O,M,R), member(N-_,Cir), R\==N, !, py_to_pl(VL,[Cl|Par],Cir,CirO,R,E),!. + % If L is not callable, unify E with L. +%pyo_to_pl(_VL,_Par,Cir,Cir,Cl,O,E):- get_str_rep(O,Str), E=..[Cl,Str]. +pyo_to_pl(_VL,_Par,Cir,Cir,_Cl,O,E):- O = E,!. + +pl_to_rust(Var,Py):- pl_to_rust(_VL,Var,Py). +pl_to_rust(VL,Var,Py):- var(VL),!,ignore(VL=[vars]),pl_to_rust(VL,Var,Py). + +pl_to_rust(_VL,Sym,Py):- is_list(Sym),!, maplist(pl_to_rust,Sym,PyL), py_call(src:'mettalog':'MkExpr'(PyL),Py),!. +pl_to_rust(VL,Var,Py):- var(Var), !, real_VL_var(Sym,VL,Var), py_call('hyperon.atoms':'V'(Sym),Py),!. +pl_to_rust(VL,'$VAR'(Sym),Py):- !, real_VL_var(Sym,VL,_),py_call('hyperon.atoms':'V'(Sym),Py),!. +pl_to_rust(VL,DSym,Py):- atom(DSym),atom_concat('$',VName,DSym), rinto_varname(VName,Sym),!, pl_to_rust(VL,'$VAR'(Sym),Py). +pl_to_rust(_VL,Sym,Py):- atom(Sym),!, py_call('hyperon.atoms':'S'(Sym),Py),!. +%pl_to_rust(VL,Sym,Py):- is_list(Sym), maplist(pl_to_rust,Sym,PyL), py_call('hyperon.atoms':'E'(PyL),Py),!. +pl_to_rust(_VL,Sym,Py):- string(Sym),!, py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. +pl_to_rust(_VL,Sym,Py):- py_is_object(Sym),py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. +pl_to_rust(_VL,Sym,Py):- py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. + +py_list(MeTTa,PyList):- pl_to_py(MeTTa,PyList). + +py_tuple(O,Py):- py_ocall(tuple(O),Py),!. +py_tuple(O,Py):- py_obi(py_tuple(O),Py),!. + +py_dict(O,Py):- catch(py_is_py_dict(O),_,fail),!,O=Py. +py_dict(O,Py):- py_ocall(dict(O),Py),!. + +% ?- py_list([1, 2.0, "string"], X),py_type(X,Y). +% ?- py_list_index([1, 2.0, "string"], X),py_type(X,Y). +py_nth(L,Nth,E):- py_obi(py_nth(L,Nth),E). +py_len(L,E):- py_mbi(py_len(L),E). +py_o(O,Py):- py_obi(identity(O),Py),!. +py_m(O,Py):- py_mbi(identity(O),Py),!. +pl_to_py(Var,Py):- pl_to_py(_VL,Var,Py). +pl_to_py(VL,Var,Py):- var(VL),!,ignore(VL=[vars]),pl_to_py(VL,Var,Py). +pl_to_py(_VL,Sym,Py):- py_is_object(Sym),!,Sym=Py. +%pl_to_py(_VL,O,Py):- py_is_dict(O),!,py_obi(identity(O),Py). +pl_to_py(_VL,MeTTa,Python):- float(MeTTa), !, py_obi(float_conversion(MeTTa),Python). +pl_to_py(_VL,MeTTa,Python):- string(MeTTa), !, py_obi(string_conversion(MeTTa),Python). +pl_to_py(_VL,MeTTa,Python):- integer(MeTTa), !, py_obi(int_conversion(MeTTa),Python). +pl_to_py(VL,Sym,Py):- is_list(Sym),!, maplist(pl_to_py(VL),Sym,PyL), py_obi(py_list(PyL),Py). +pl_to_py(VL,Var,Py):- var(Var), !, real_VL_var(Sym,VL,Var), py_call('hyperon.atoms':'V'(Sym),Py),!. +pl_to_py(VL,'$VAR'(Sym),Py):- !, real_VL_var(Sym,VL,_),py_call('hyperon.atoms':'V'(Sym),Py),!. +pl_to_py(_VL,O,Py):- py_type(O,_),!,O=Py. +% % %pl_to_py(_VL,O,Py):- py_is_dict(O),!,O=Py. +%pl_to_py(VL,DSym,Py):- atom(DSym),atom_concat('$',VName,DSym), rinto_varname(VName,Sym),!, pl_to_py(VL,'$VAR'(Sym),Py). +%pl_to_py(_VL,Sym,Py):- atom(Sym),!, py_call('hyperon.atoms':'S'(Sym),Py),!. +%pl_to_py(_VL,Sym,Py):- string(Sym),!, py_call('hyperon.atoms':'S'(Sym),Py),!. +%pl_to_py(VL,Sym,Py):- is_list(Sym), maplist(pl_to_py,Sym,PyL), py_call('hyperon.atoms':'E'(PyL),Py),!. +%pl_to_py(_VL,Sym,Py):- py_is_object(Sym),py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. +pl_to_py(_VL,MeTTa,MeTTa). +%pl_to_py(_VL,Sym,Py):- py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. + +py_key(O,I):- py_m(O,M),key(M,I). +py_items(O,I):- py_m(O,M),items(M,I). +%py_values(O,K,V):- py_m(O,M),values(M,K,V). +py_values(O,K,V):- py_items(O,L),member(K:V,L). + +%elements(Atoms,E):- is_list(Atoms),!, +meets_dir(L,M):- atom(M),!,member(M,L),!. +meets_dir(L,M):- is_list(M),!,maplist(meets_dir(L),M). +meets_dir(L,M):- compound_name_arity(M,N,0),!,member(N,L),!. +meets_dir(L,M):- compound(M),!,compound_name_arguments(M,F,[A|AL]),!,maplist(meets_dir(L),[F,A|AL]). + +py_member_values(O,C,R):- is_list(O),!,maplist(py_member_values,O,C,R). +py_member_values(O,C,R):- is_list(C),!,maplist(py_member_values(O),C,R). +%py_member_values(O,C,R):- atom(C),!,compound_name_arity(CC,C,0),!,py_call(O:CC,R). +py_member_values(O,f(F,AL),R):- !,py_member_values(O,[F|AL],[RF|RAL]), compound_name_arguments(R,RF,RAL). +py_member_values(O,C,R):- py_call(O:C,R,[py_string_as(atom),py_object(false)]). + +py_to_str(PyObj,Str):- + with_output_to(string(Str),py_pp(PyObj,[nl(false)])). + + tafs:- + atoms_from_space(Space, _),py_to_pl(VL,Space,AA), print_tree(aa(Pl,aa)),pl_to_rust(VL,AA,Py), print_tree(py(Pl,py)),pl_to_rust(VL,Py,Pl),print_tree(pl(Pl,pl)) + , + atoms_from_space(Space, [A]),py_to_pl(VL,A,AA), + atoms_from_space(Space, [A]),py_obj_dir(A,D),writeq(D),!,py_to_pl(VL,D:get_object(),AA),writeq(AA),!,fail. + +py_class(A,AA):- py_call(A:'__class__',C), py_call(C:'__name__',AA,[py_string_as(atom)]),!. +py_decomp(M,C):- py_decomp(M), compound_name_arity(C,M,0). + + +class_to_pl1(_Par,'GroundingSpaceRef',get_atoms()). +class_to_pl1(_Par,'ExpressionAtom',get_children()). +class_to_pl1(_Par,'SpaceRef',get_atoms()). +class_to_pl1(_Par,'VariableAtom','__repr__'()). +class_to_pl1(_Par,'SymbolAtom',get_name()). +class_to_pl1(_Par,'bool','__repr__'()). +class_to_pl(_Par,'ValueAtom','__repr__'()). +class_to_pl(_Par,'ValueObject','value'). +class_to_pl(Par,'GroundedAtom','__repr__'()):- length(Par,Len),Len>=5,!. +class_to_pl(Par,_,'__str__'()):- length(Par,Len),Len>15,!. +class_to_pl(_Par,'GroundedAtom',get_object()). + +/* + + +class_to_pl(Par,'bool','__repr__'()). + +*/ +py_decomp('__repr__'()). +py_decomp('__str__'()). +py_decomp(get_atoms()). +py_decomp(get_children()). +py_decomp(get_object()). +py_decomp(get_name()). +py_decomp(value()). + +py_decomp('__class__':'__name__'). +%py_decomp(f(get_grounded_type(),['__str__'()])). +py_decomp(f('__class__',['__str__'()])). +%__class__ +%get_type() + +%atoms_from_space(Space, [Atoms]),py_pp(Atoms),py_call(Atoms:get_object(),A),atoms_from_space(A,Dir),member(E,Dir),py_obj_dir(E,C),py_call(E:get_children(),CH),py_pp(CH). + + +% Remove an atom from hyperon.base.GroundingSpace +:- if( \+ current_predicate(remove_from_space/2 )). +remove_from_space(Space, Sym) :- + ensure_space(Space,GSpace), + py_call(GSpace:'remove'(Sym), _). +:- endif. + +% Add an atom to hyperon.base.GroundingSpace +:- if( \+ current_predicate(add_to_space/2 )). +add_to_space(Space, Sym) :- + ensure_space(Space,GSpace), + py_call(GSpace:'add'(Sym), _). +:- endif. + +must_det_llp((A,B)):-!, must_det_llp(A), must_det_llp(B). +must_det_llp(B):- pybug(B),!,once(ignore(must_det_ll(B))). + +:- dynamic(is_pymod_in_space/2). +:- dynamic(is_pymod_loaded/2). + +py_ready:- nb_current('$py_ready','true'),!. +py_ready:- \+ is_mettalog(_),!,fail. +%py_ready:- is_metta(_),!. +py_ready. + +%pybug(P):- py_pp(P),!. +pybug(P):- \+ py_ready,!, fbug(P). +pybug(P):- fbug(P). +pypp(P):- py_to_pl(P,PL),!,fbug(PL),!. +pypp(P):- fbug(P),!. + +'extend-py!'(Module,R):- (notrace((extend_py(Module,R)))). +extend_py(Module,R):- + current_self(Self), + self_extend_py(Self,Module,_Base,R). +self_extend_py(Self,Module):- + self_extend_py(Self,Module,_Base,_). + +self_extend_py(Self,Module,File,R):- + with_safe_argv(( + assert_new(is_pymod_in_space(Module,Self)), + (nonvar(File)-> Use=File ; Use=Module), + pybug('extend-py!'(Use)), + %py_call(mettalog:use_mettalog()), + (Use==mettalog->true;py_load_modfile(Use)), + %listing(ensure_rust_metta/1), + %ensure_mettalog_py, + nb_setval('$py_ready','true'), + %working_directory(PWD,PWD), py_add_lib_dir(PWD), + %replace_in_string(["/"="."],Module,ToPython), + %py_mcall(mettalog:import_module_to_rust(ToPython)), + %sformat(S,'!(import! &self ~w)',[Use]),rust_metta_run(S,R), + R = [], + %py_module_exists(Module), + %py_call(MeTTa:load_py_module(ToPython),Result), + true)),!. + +py_load_modfile(Use):- py_ocall(mettalog:load_functions(Use),R),!,pybug(R). +py_load_modfile(Use):- exists_directory(Use),!,directory_file_path(Use,'_init_.py',File),py_load_modfile(File). +py_load_modfile(Use):- file_to_modname(Use,Mod),read_file_to_string(Use,Src,[]),!,py_module(Mod,Src). + +file_to_modname(Filename,ModName):- symbol_concat('../',Name,Filename),!,file_to_modname(Name,ModName). +file_to_modname(Filename,ModName):- symbol_concat('./',Name,Filename),!,file_to_modname(Name,ModName). +file_to_modname(Filename,ModName):- symbol_concat(Name,'/_init_.py',Filename),!,file_to_modname(Name,ModName). +file_to_modname(Filename,ModName):- symbol_concat(Name,'.py',Filename),!,file_to_modname(Name,ModName). +file_to_modname(Filename,ModName):- replace_in_string(["/"="."],Filename,ModName). + +%import_module_to_rust(ToPython):- sformat(S,'!(import! &self ~w)',[ToPython]),rust_metta_run(S). +rust_metta_run(S,Run):- var(S),!,freeze(S,rust_metta_run(S,Run)). +%rust_metta_run(exec(S),Run):- \+ callable(S), string_concat('!',S,SS),!,rust_metta_run(SS,Run). +rust_metta_run(S,Run):- coerce_string(S,R),!,rust_metta_run1(R,Run). +%rust_metta_run(I,O):- +rust_metta_run1(I,O):- load_hyperon_module, !, py_ocall(hyperon_module:rust_metta_run(I),M),!,rust_return(M,O). +rust_metta_run1(R,Run):- % run + with_safe_argv(((( + %ensure_rust_metta(MeTTa), + py_call(mettalog:rust_metta_run(R),Run))))). + +rust_return(M,O):- (py_iter(M,R,[py_object(true)]),py_iter(R,R1,[py_object(true)]))*->rust_to_pl(R1,O);(fail,rust_to_pl(M,O)). +%rust_return(M,O):- rust_to_pl(M,O). +%rust_return(M,O):- py_iter(M,R,[py_object(true)]),rust_to_pl(R,O). +%rust_return(M,O):- py_iter(M,O). %,delist1(R,O). +delist1([R],R):-!. +delist1(R,R). % Maybe warn here? + +rust_to_pl(L,P):- var(L),!,L=P. +%rust_to_pl([],P):- !, P=[]. +rust_to_pl(L,P):- is_list(L),!,maplist(rust_to_pl,L,P). +rust_to_pl(R,P):- compound(R),!,compound_name_arguments(R,F,RR),maplist(rust_to_pl,RR,PP),compound_name_arguments(P,F,PP). +rust_to_pl(R,P):- \+ py_is_object(R),!,P=R. +rust_to_pl(R,P):- py_type(R,'ExpressionAtom'),py_mcall(R:get_children(),L),!,maplist(rust_to_pl,L,P). +rust_to_pl(R,P):- py_type(R,'SymbolAtom'),py_acall(R:get_name(),P),!. +rust_to_pl(R,P):- py_type(R,'VariableAtom'),py_scall(R:get_name(),N),!,as_var(N,P),!. +%rust_to_pl(R,P):- py_type(R,'VariableAtom'),py_acall(R:get_name(),N),!,atom_concat('$',N,P). +rust_to_pl(R,N):- py_type(R,'OperationObject'),py_acall(R:name(),N),!,cache_op(N,R). +rust_to_pl(R,P):- py_type(R,'SpaceRef'),!,P=R. % py_scall(R:'__str__'(),P),!. +rust_to_pl(R,P):- py_type(R,'ValueObject'),py_ocall(R:'value'(),L),!,rust_to_pl(L,P). +rust_to_pl(R,PT):- py_type(R,'GroundedAtom'),py_ocall(R:get_grounded_type(),T),rust_to_pl(T,TT),py_ocall(R:get_object(),L),!,rust_to_pl(L,P),combine_term_l(TT,P,PT). +rust_to_pl(R,P):- py_is_list(R),py_m(R,L),R\==L,!,rust_to_pl(L,P). +rust_to_pl(R,PT):- py_type(R,T),combine_term_l(T,R,PT),!. +%rust_to_pl(R,P):- py_acall(R:'__repr__'(),P),!. +rust_to_pl(R,P):- + load_hyperon_module, !, py_ocall(hyperon_module:rust_deref(R),M),!, + (R\==M -> rust_to_pl(M,P) ; M=P). + +as_var('_',_):-!. +as_var(N,'$VAR'(S)):-sformat(S,'_~w',[N]),!. + +rust_metta_run(S):- + rust_metta_run(S,Py), + print_py(Py). + +:- volatile(cached_py_op/2). +cache_op(N,R):- asserta_if_new(cached_py_op(N,R)),fbug(cached_py_op(N,R)). +:- volatile(cached_py_type/2). +cache_type(N,R):- asserta_if_new(cached_py_type(N,R)),fbug(cached_py_type(N,R)). + +print_py(Py):- + py_to_pl(Py,R), print(R),nl. + +combine_term_l('OperationObject',P,P):-!. +combine_term_l('Number',P,P):-!. +combine_term_l('Bool',P,P):-!. +combine_term_l('ValueObject',R,P):-R=P,!. %rust_to_pl(R,P),!. +combine_term_l('%Undefined%',R,P):-rust_to_pl(R,P),!. +combine_term_l('hyperon::space::DynSpace',P,P):-!. +combine_term_l([Ar|Stuff],Op,Op):- Ar == (->), !, cache_type(Op,[Ar|Stuff]). +combine_term_l(T,P,ga(P,T)). + +%coerce_string(S,R):- atom(S), sformat(R,'~w',[S]),!. +coerce_string(S,R):- string(S),!,S=R. +coerce_string(S,R):- with_output_to(string(R),write_src(S)),!. + +load_functions_motto:- load_functions_motto(Def),pypp(Def). +load_functions_motto(Def):- + load_functions_ext, + with_safe_argv(py_call(mettalog:load_functions_motto(),Def)). + +load_functions_ext:- load_functions_ext(Def),pypp(Def). +load_functions_ext(Def):- + with_safe_argv(py_call(mettalog:load_functions_ext(),Def)). + +% Example usage +example_usage :- + with_safe_argv(ensure_primary_metta_space(GSpace)), + %some_query(Query), + Query = [], + with_safe_argv(query_from_space(GSpace, Query , Result)), + writeln(Result). + +%atoms_from_space(Sym):- atoms_iter_from_space(metta_self, Atoms),py_iter(Atoms,Sym). +atom_count_from_space(Count):- atom_count_from_space(metta_self, Count). + + +%:- . +%:- ensure_rust_metta. +%:- with_safe_argv(ensure_primary_metta_space(_GSpace)). +/* +Rust: The core of MeTTa is implemented in Rust, which provides performance and safety features. + +Python Extensions: Python is used for extending the core functionalities. Python communicates with Rust via a Foreign Function Interface (FFI) or similar mechanisms. + +Prolog: The Prolog code is an additional layer that allows you to extend or customize parts of MeTTa using Python and Rust. It maintains the system's extensibility. + + +VSpace is a space with its backend in Prolog, it implies that you're using Prolog's logic programming capabilities to manage and manipulate a particular domain, which in this context is referred to as a "space" (possibly akin to the GroundingSpace in Python, but implemented in Prolog). + +To integrate VSpace with the existing Python and Rust components, similar interfacing techniques could be used. You could expose Prolog predicates as functions that can be called from Python or Rust, and likewise, call Python or Rust functions from within Prolog. + + +*/ + +%:- ensure_loaded(metta_interp). + +:- dynamic(want_py_lib_dir/1). +:- prolog_load_context(directory, ChildDir), + file_directory_name(ChildDir, ParentDir), + file_directory_name(ParentDir, GParentDir), + pfcAdd_Now(want_py_lib_dir(GParentDir)). + +want_py_lib_dir:- + with_safe_argv((forall(want_py_lib_dir(GParentDir), + py_add_lib_dir(GParentDir)), + sync_python_path)). + +sync_python_path:- + working_directory(PWD,PWD), py_add_lib_dir(PWD), + ignore(( getenv('PYTHONPATH', CurrentPythonPath), + symbolic_list_concat(List, ':', CurrentPythonPath), + list_to_set(List,Set), + py_lib_dirs(DirsA), + forall(member(E,Set),if_t( \+member(E,DirsA), if_t( \+ atom_length(E,0), py_add_lib_dir(E)))))), + py_lib_dirs(DirsL), + list_to_set(DirsL,Dirs), + fbug(py_lib_dirs(Dirs)), + symbolic_list_concat(Dirs, ':',NewPythonPath), + setenv('PYTHONPATH', NewPythonPath). + +is_rust_operation([Fun|Args]):- + get_list_arity(Args,Arity), + py_call(mettalog:get_operation_definition_with_arity(Fun,Arity),O),O\=='@'('none'). + +get_list_arity(Args,Arity):- is_list(Args),!,length(Args,Arity). +get_list_arity(_Args,-1). + +:- set_prolog_flag(debugger_write_options,[quoted(true), portray(true), max_depth(60), attributes(portray), spacing(next_argument)] ). +:- set_prolog_flag(answer_write_options,[quoted(true), portray(true), max_depth(60), attributes(portray), spacing(next_argument)] ). +:- set_prolog_flag(py_backtrace_depth,50). +:- set_prolog_flag(py_backtrace, true). +:- set_prolog_flag(py_argv , []). +:- initialization(on_restore1,restore). +:- initialization(on_restore2,restore). + + + +% py_initialize(, +Argv, +Options) +on_restore1:- ensure_mettalog_py. +on_restore2:- !. +%on_restore2:- load_builtin_module. +%:- load_hyperon_module. + + + +% grab the 1st variable Var +subst_each_var([Var|RestOfVars],Term,Output):- !, + % replace all occurences of Var with _ (Which is a new anonymous variable) + subst(Term, Var, _ ,Mid), + % Do the RestOfVars + subst_each_var(RestOfVars,Mid,Output). +% no more vars left to replace +subst_each_var(_, TermIO, TermIO). + + + + diff --git a/.Attic/canary_docme/metta_reader.pl b/.Attic/canary_docme/metta_reader.pl new file mode 100644 index 00000000000..62fe47c60e9 --- /dev/null +++ b/.Attic/canary_docme/metta_reader.pl @@ -0,0 +1,1711 @@ +/* + * 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. + */ + + +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + Parsing +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ +%:- encoding(iso_latin_1). +:- if(flush_output). :- endif. +:- if(setenv('RUST_BACKTRACE',full)). :- endif. +%:- if(\+ current_module(sxpr_reader)). +:- if( (false, \+ current_prolog_flag(wamcl_modules,false))). +:- module(s3xpr,[ + parse_sexpr/2, + codelist_to_forms/2, + svar_fixvarname/2, + parse_sexpr_untyped/2, + with_kifvars/1, + current_input_to_forms/2, + input_to_forms/2, + input_to_forms/3, + input_to_forms_debug/1, + input_to_forms_debug/2, + sexpr_sterm_to_pterm_list/3, + sexpr//1, + fixvars/4, + txt_to_codes/2, + quietly_sreader/1, + file_sexpr_with_comments//1, + with_lisp_translation/2, + to_untyped/2, + ok_var_name/1, + with_all_rest_info/1, + svar_fixvarname/2, + sexpr_sterm_to_pterm/2, + lisp_read/2, + phrase_from_stream_nd/2, + write_trans/4, + parse_sexpr/2]). +:- endif. + +:- ensure_loaded(swi_support). +:- ensure_loaded(metta_utils). +:- ensure_loaded(metta_testing). +:- set_prolog_flag(encoding,iso_latin_1). +is_wam_cl:- fail. + +:- use_module(library(backcomp)). +:- use_module(library(rbtrees)). + + +:- use_module(library(logicmoo/dcg_must)). +:- use_module(library(logicmoo/dcg_meta)). + + +%:- meta_predicate always_b(//,?,?). +%:- meta_predicate bx(0). +:- meta_predicate call_proc(1,?). +:- meta_predicate dcg_and2(//,//,?,?). +:- meta_predicate dcg_each_call_cleanup(0,//,0,?,?). +:- meta_predicate dcg_not(//,?,?). +:- meta_predicate dcg_phrase(//,?,?). +:- meta_predicate dcg_xor(//,//,?,?). +%:- meta_predicate expr_with_text(*,2,*,*,*). + +:- meta_predicate remove_optional_char(//,?,?). + +:- meta_predicate sexpr_vector0(*,//,?,?). +:- meta_predicate with_all_rest_info(1). +:- meta_predicate with_lisp_translation_stream(*,1). +:- meta_predicate write_trans(+,*,2,?). + +%:- assert((s3xpr:'$exported_op'(_,_,_):- fail)). +%:- assert((xlisting:'$exported_op'(_,_,_):- fail)). +:- assert((user:'$exported_op'(_,_,_):- fail)). +:- abolish((system:'$exported_op'/3)). +:- assert((system:'$exported_op'(_,_,_):- fail)). + +def_is_characterp(CH):- current_predicate(is_characterp/1),!,call(call,is_characterp,CH). +def_is_characterp_def('#\\'(_)). + +def_to_prolog_string(I,O):- current_predicate(to_prolog_string/2),!,call(call,to_prolog_string,I,O). +def_to_prolog_string(I,O):- any_to_string(I,O). + + +def_compile_all(I,O):- current_predicate(compile_all/2),!,call(call,compile_all,I,O). +def_compile_all(I,O):- fbug(undefined_compile_all(I)),I=O. + + +zalwayzz(G):- call(G)*->true;throw(fail_zalwayzz(G)). +zalwayzz(G,I,O):- phrase(G,I,O)*->true;ignore(((ignore((append(I,[],Txt),name(Str,Txt))),throw(fail_zalwayzz(Str,G))))). + + +% DCG rules for S-expressions metta_with metta_whitespace and comments +s_expr_metta(List) --> metta_wspace,!, s_expr_metta(List). +s_expr_metta(List) --> `(`, !, items_metta(List, `)`). +s_expr_metta(['[...]',List]) --> `[`, !, items_metta(List, `]`). +s_expr_metta(['{...}',List]) --> `{`, !, items_metta(List, `}`). + + +items_metta([], Until) --> Until,!. +items_metta([Item|Rest], Until) --> s_item_metta(Item, dcg_peek(Until)), !, items_metta(Rest, Until). + +%s_line_metta(end_of_file) --> file_eof,!. +s_line_metta(Expr) --> metta_wspace, !, s_line_metta(Expr). +s_line_metta(exec(Expr)) --> `!`, !, s_item_metta(Expr, e_o_s). +s_line_metta(Expr) --> s_item_metta(Expr, e_o_s). + +%s_item_metta(end_of_file, _) --> file_eof,!. +s_item_metta(Expr, Until) --> metta_wspace, !, s_item_metta(Expr, Until). +%s_item_metta('Expr', Until) --> Until,!. +s_item_metta(List,_Until) --> s_expr_metta(List),!. +s_item_metta(String,_Until) --> string_metta(String),!. +s_item_metta(Symbol, Until) --> symbol_metta(Symbol, Until). + +:- encoding(iso_latin_1). +%string_metta(S) --> `"`, !, string_until_metta(S, `"`), {atomics_to_string_metta(A,S)}. +%string_metta(Text) --> `"`, !, zalmetta_wayzz_metta(string_until_metta(Text,`"`)),!. +%string_metta(Text) --> `“`, !, zalmetta_wayzz_metta(string_until_metta(Text,(`”`;`“`))),!. +string_metta(Text) --> (`"`), string_until_metta(L,(`"`)), {atomics_to_string(L,Text)}, !. +string_metta(Text) --> (`”`;`“`;`"`), !, string_until_metta(L,(`“`;`”`;`"`)), {atomics_to_string(L,Text)}. +:- encoding(utf8). +%string_metta(Text) --> `#|`, !, zalmetta_wayzz_metta(string_until_metta(Text,`|#`)),!. + +% string_until_metta([], _) --> e_o_s, !. +%string_until_metta([], _) --> file_eof,!. +string_until_metta([], Until) --> Until, !. +string_until_metta([C|Cs], Until) --> escape_sequence_metta(C), !, string_until_metta(Cs, Until). +string_until_metta([C|Cs], Until) --> [R], { name(C, [R]) }, string_until_metta(Cs, Until). + +escape_sequence_metta(Char) --> `\\`,[Esc], { escape_char_metta([Esc], Char) }. +escape_char_metta(`"`, "\""). +escape_char_metta(`\\`, "\\"). +escape_char_metta(`n`, "\n"). +escape_char_metta(`r`, "\r"). +escape_char_metta(`t`,"\t"). +escape_char_metta(C,S):- sformat(S,'~s',[[C]]). + +symbol_metta(S, Until) --> metta_wspace,!,symbol_metta(S, Until). +symbol_metta(S, Until) --> string_until_metta(SChars,(dcg_peek(metta_white); Until)), { symbolic_list_concat(SChars, S) }. + +%comment --> `;`,!,comment_chars_metta(S). +comment_chars_metta(S) --> string_until_metta(SChars,`\n`), { symbolic_list_concat(SChars, S) }. + +%e_o_s --> file_eof,!. +e_o_s --> \+ [_|_]. + +%metta_ws --> e_o_s,!. +metta_ws --> metta_wspace, !, metta_ws. +metta_ws --> []. +metta_wspace --> `;`,!, comment_chars_metta(S), {assert(comment_metta(S))}. +metta_wspace --> metta_white. +metta_white --> [W], { char_type(W, white) }, !. + + + +%:- meta_predicate(always(0)). +%always(G):- must(G). + +:- use_module(library(logicmoo/filestreams)). +%:- use_module(library(bugger)). + +:- if(exists_file('./header')). +% :- include('./header'). +:- endif. +%:- use_module(eightball). + +:- thread_local(t_l:sreader_options/2). +kif_ok:- t_l:sreader_options(logicmoo_read_kif,TF),!,TF==true. + +with_kif_ok(G):- + locally(t_l:sreader_options(logicmoo_read_kif,true),G). + +with_kif_not_ok(G):- + locally(t_l:sreader_options(logicmoo_read_kif,false),G). + + +:- meta_predicate((with_lisp_translation(+,1),input_to_forms_debug(+,:))). +:- meta_predicate sexpr_vector(*,//, + ?,?). + + + :- dynamic user:file_search_path/2. + :- multifile user:file_search_path/2. + +:- thread_local(t_l:s_reader_info/1). + +:- meta_predicate(quietly_sreader(0)). +%quietly_sreader(G):- quietly(G). +quietly_sreader(G):- !, call(G). + +%% with_lisp_translation( +FileOrStream, :Pred1) is det. +% +% With File or Stream read all S-expressions submitting each to Pred1 +% +with_lisp_translation(In,Pred1):- + is_stream(In),!,with_lisp_translation_stream(In,Pred1). +with_lisp_translation(Other,Pred1):- + setup_call_cleanup(l_open_input(Other,In), + with_lisp_translation_stream(In,Pred1), + ignore(notrace_catch_fail(close(In)))),!. + +with_lisp_translation_stream(In,Pred1):- + repeat, + once((lisp_read(In,O))), + (O== end_of_file + -> (with_all_rest_info(Pred1),!) ; + (((once((zalwayzz(call_proc(Pred1,O))))),fail))). + +call_proc(Pred1,O):- call(Pred1,O),!,with_all_rest_info(Pred1),!. + +with_all_rest_info(Pred1):- + forall(clause(t_l:s_reader_info(O2),_,Ref), + (zalwayzz(once(call(Pred1,O2))),erase(Ref))),!. + +parse_sexpr_untyped(I,O):- quietly_sreader((parse_sexpr(I,M))), + quietly_sreader((to_untyped(M,O))). + +read_pending_whitespace(In):- repeat, peek_char(In,Code), + (( \+ char_type(Code,space), \+ char_type(Code,white))-> ! ; (get_char(In,_),fail)). + + +make_tmpfile_name(Name,Temp):- + symbolic_list_concat(List1,'/',Name),symbolic_list_concat(List1,'_',Temp1), + symbolic_list_concat(List2,'.',Temp1),symbolic_list_concat(List2,'_',Temp2), + symbolic_list_concat(List3,'\\',Temp2),symbolic_list_concat(List3,'_',Temp3), + atom_concat_or_rtrace(Temp3,'.tmp',Temp),!. + + + + +:- meta_predicate(with_lisp_translation_cached(:,2,1)). +:- meta_predicate(maybe_cache_lisp_translation(+,+,2)). + +with_lisp_translation_cached(M:LFile,WithPart2,WithPart1):- + absolute_file_name(LFile,File), + make_tmpfile_name(LFile,Temp), + maybe_cache_lisp_translation(File,Temp,WithPart2),!, + finish_lisp_translation_cached(M,File,Temp,WithPart1). + +finish_lisp_translation_cached(M,File,Temp,WithPart1):- + multifile(M:lisp_trans/2), + dynamic(M:lisp_trans/2), + file_base_name(File,BaseName), + M:load_files([Temp],[qcompile(auto)]), + forall(M:lisp_trans(Part2,BaseName:Line), + once((b_setval('$lisp_translation_line',Line), + zalwayzz(M:call(WithPart1,Part2))))). + +maybe_cache_lisp_translation(File,Temp,_):- \+ file_needs_rebuilt(Temp,File),!. +maybe_cache_lisp_translation(File,Temp,WithPart2):- + file_base_name(File,BaseName), + setup_call_cleanup(open(Temp,write,Outs,[encoding(utf8)]), + must_det((format(Outs,'~N~q.~n',[:- multifile(lisp_trans/2)]), + format(Outs,'~N~q.~n',[:- dynamic(lisp_trans/2)]), + format(Outs,'~N~q.~n',[:- style_check(-singleton)]), + format(Outs,'~N~q.~n',[lisp_trans(translated(File,Temp,BaseName),BaseName:( -1))]), + with_lisp_translation(File,write_trans(Outs,BaseName,WithPart2)), + format(Outs,'~N~q.~n',[end_of_file]))), + ((ignore(notrace_catch_fail(flush_output(Outs),_,true)),ignore(notrace_catch_fail(close(Outs),_,true))))),!. + + +write_trans(Outs,File,WithPart2,Lisp):- + zalwayzz((call(WithPart2,Lisp,Part), + nb_current('$lisp_translation_line',Line), + format(Outs,'~N~q.~n',[lisp_trans(Part,File:Line)]))),!. + +/* alternate method*/ +phrase_from_stream_partial(Grammar, In):- + phrase_from_stream((Grammar,!,lazy_forgotten(In)), In). + +lazy_forgotten(In,UnUsed,UnUsed):- + (is_list(UnUsed)-> true ; append(UnUsed,[],UnUsed)), + length(UnUsed,PlzUnread), + seek(In, -PlzUnread, current, _). + + +% :- use_module(library(yall)). +% :- rtrace. +% tstl(I):- with_lisp_translation(I,([O]>>(writeq(O),nl))). +tstl(I):- with_kifvars(with_lisp_translation(I,writeqnl)). + +with_kifvars(Goal):- + locally(t_l:sreader_options(logicmoo_read_kif,true),Goal). + + + +%:- thread_local(t_l:fake_buffer_codes/2). + + +%% parse_sexpr( :TermS, -Expr) is det. +% +% Parse S-expression. +% + +parse_sexpr(S, Expr) :- quietly_sreader(parse_meta_term( + file_sexpr_with_comments, S, Expr)), + nb_setval('$parser_last_read',Expr). + + +%% parse_sexpr_ascii( +Codes, -Expr) is det. +% +% Parse S-expression Codes. +% +parse_sexpr_ascii(S, Expr) :- quietly_sreader(parse_meta_ascii(file_sexpr_with_comments, S,Expr)),!. + + +parse_sexpr_ascii_as_list(Text, Expr) :- txt_to_codes(Text,DCodes), + clean_fromt_ws(DCodes,Codes),!,append([`(`,Codes,`)`],NCodes),!, + phrase(sexpr_rest(Expr), NCodes, []). + + +%% parse_sexpr_string( +Codes, -Expr) is det. +% +% Parse S-expression That maybe sees string from Codes. +% +parse_sexpr_string(S,Expr):- + locally_setval('$maybe_string',t,parse_sexpr(string(S), Expr)),!. + +%% parse_sexpr_stream( +Stream, -Expr) is det. +% +% Parse S-expression from a Stream +% +parse_sexpr_stream(S,Expr):- + quietly_sreader(parse_meta_stream(file_sexpr_with_comments,S,Expr)),!, + nb_setval('$parser_last_read',Expr). + +:- export('//'(file_sexpr,1)). +:- export('//'(sexpr,1)). + +% for offline use of this lisp reader +intern_and_eval(UTC,V):- current_predicate(lisp_compiled_eval/2),!, + call(call,(reader_intern_symbols(UTC,M),!,lisp_compiled_eval(M,V))). +intern_and_eval(UTC,'$intern_and_eval'(UTC)). + +% Use DCG for parser. + + +%file_sexpr_with_comments(O) --> [], {clause(t_l:s_reader_info(O),_,Ref),erase(Ref)},!. +file_sexpr_with_comments(end_of_file) --> file_eof,!. +file_sexpr_with_comments('+') --> `+`, swhite,!. + +file_sexpr_with_comments(O) --> one_blank,!,file_sexpr_with_comments(O),!. % WANT? +file_sexpr_with_comments(end_of_file) --> `:EOF`,!. +file_sexpr_with_comments(C) --> dcg_peek(`#|`),!,zalwayzz(comment_expr(C)),swhite,!. +file_sexpr_with_comments(C) --> dcg_peek(`;`),!, zalwayzz(comment_expr(C)),swhite,!. +file_sexpr_with_comments(Out) --> {kif_ok}, prolog_expr_next, prolog_readable_term(Out), !. +file_sexpr_with_comments(Out,S,E):- \+ t_l:sreader_options(with_text,true),!,phrase(file_sexpr(Out),S,E),!. +file_sexpr_with_comments(Out,S,E):- expr_with_text(Out,file_sexpr(O),O,S,E),!. + +prolog_expr_next--> dcg_peek(`:-`). +prolog_expr_next--> dcg_peek(read_string_until(S,(eol;`.`))),{atom_contains(S,':-')}. +prolog_expr_next--> dcg_peek(`.{`). + +prolog_readable_term(Expr) --> `.`,prolog_readable_term(Read), {arg(1,Read,Expr),!}. +prolog_readable_term(Expr,S,E):- + notrace(catch((read_term_from_codes(S,Expr,[subterm_positions(FromTo),cycles(true), module( baseKB), + double_quotes(string), + comments(CMT), variable_names(Vars)]),implode_threse_vars(Vars), + arg(2,FromTo,To), length(TermCodes,To), + append(TermCodes,Remaining,S), + `.`=[Dot],(Remaining=[Dot|E]/*;Remaining=E*/),!, + must(record_plterm_comments(CMT))),_,fail)). +record_plterm_comments(L):- is_list(L),!,maplist(record_plterm_comments,L). +record_plterm_comments(_-CMT):- assert(t_l:s_reader_info(CMT)). + + +% in Cyc there was a fitness heuristic that every time an logical axiom had a generated a unique consequent it was considered to have utility as it would expand the breadth of a search .. the problem often was those consequents would feed a another axiom's antecedant where that +:- asserta((system:'$and'(X,Y):- (X,Y))). + +%expr_with_text(Out,DCG,O,S,E):- +% call(DCG,S,E) -> append(S,Some,E) -> get_sexpr_with_comments(O,Some,Out,S,E),!. + +get_sexpr_with_comments(O,_,O,_,_):- compound(O),functor(O,'$COMMENT',_),!. +get_sexpr_with_comments(O,Txt,with_text(O,Str),S,_E):-append(Txt,_,S),!,text_to_string(Txt,Str). +%file_sexpr_with_comments(O,with_text(O,Txt),S,E):- copy_until_tail(S,Copy),text_to_string_safe(Copy,Txt),!. + + +file_sexpr(end_of_file) --> file_eof,!. +% WANT? +file_sexpr(O) --> sblank,!,file_sexpr(O),!. +% file_sexpr(planStepLPG(Name,Expr,Value)) --> swhite,sym_or_num(Name),`:`,swhite, sexpr(Expr),swhite, `[`,sym_or_num(Value),`]`,swhite. % 0.0003: (PICK-UP ANDY IBM-R30 CS-LOUNGE) [0.1000] +% file_sexpr(Term,Left,Right):- eoln(EOL),append(LLeft,[46,EOL|Right],Left),read_term_from_codes(LLeft,Term,[double_quotes(string),syntax_errors(fail)]),!. +% file_sexpr(Term,Left,Right):- append(LLeft,[46|Right],Left), ( \+ member(46,Right)),read_term_from_codes(LLeft,Term,[double_quotes(string),syntax_errors(fail)]),!. +file_sexpr(Expr) --> sexpr(Expr),!. +% file_sexpr(Expr,H,T):- lisp_dump_break,rtrace(phrase(file_sexpr(Expr), H,T)). +/* +file_sexpr(Expr) --> {fail}, + sexpr_lazy_list_character_count(Location,Stream), + {break, + seek(Stream,Location,bof,_), + read_clause(Stream,Expr,[cycles(true),double_quotes(string),variable_names(Vars)]), + implode_threse_vars(Vars)},!. + +file_sexpr(Expr) --> sexpr(Expr),!. + +file_sexpr(end_of_file) --> []. +*/ +% file_sexpr('$ERROR'(S_EOF)) --> read_until_eof_e(Unitl_EOF),!,{sformat(S_EOF,'~s',[Unitl_EOF])}. +% read_until_eof_e(Unitl_EOF,S,E):- append(S,E,Unitl_EOF),break,is_list(Unitl_EOF),!. + +%read_dispatch(E,[Disp,Char|In],Out):- read_dispatch_char([Disp,Char],E,In,Out). +read_dispatch(E,[DispatCH|In],Out):- read_dispatch_char([DispatCH],E,In,Out). + +read_dispatch_char(DispatCH,Form,In,Out):- sread_dyn:plugin_read_dispatch_char(DispatCH,Form,In,Out),!. +% read_dispatch_char(`@`,Form,In,Out):- phrase(sexpr(Form), In, Out),!. + +read_dispatch_error(Form,In,Out):- trace, dumpST,trace_or_throw((read_dispatch_error(Form,In,Out))). + + + + +:- multifile(sread_dyn:plugin_read_dispatch_char/4). +:- dynamic(sread_dyn:plugin_read_dispatch_char/4). + +:- use_module(library(dcg/basics)). + +% #x Hex +sread_dyn:plugin_read_dispatch_char([DispatCH],Form,In,Out):- + member(DispatCH,`Xx`),(phrase((`-`,dcg_basics:xinteger(FormP)), In, Out)),!,Form is -FormP. + +sread_dyn:plugin_read_dispatch_char([DispatCH],Form,In,Out):- + member(DispatCH,`Xx`),!,zalwayzz(phrase(dcg_basics:xinteger(Form), In, Out)),!. + +% #B Binary +sread_dyn:plugin_read_dispatch_char([DispatCH],Form,In,Out):- + member(DispatCH,`Bb`),!,phrase(signed_radix_2(2,Form), In, Out),!. + +% #O Octal +sread_dyn:plugin_read_dispatch_char([DispatCH],Form,In,Out):- + member(DispatCH,`Oo`),!,phrase(signed_radix_2(8,Form), In, Out),!. + +signed_radix_2(W,V)--> signed_radix_2_noext(W,Number),extend_radix(W,Number,V). + +signed_radix_2_noext(W,Number) --> `-`,!,unsigned_radix_2(W,NumberP),{Number is - NumberP },!. +signed_radix_2_noext(W,Number) --> `+`,!,unsigned_radix_2(W,Number). +signed_radix_2_noext(W,Number) --> unsigned_radix_2(W,Number). + +unsigned_radix_2(W,Number) --> radix_digits(W,Xs),!,{mkvar_w(Xs,W,Number)},!. + + +radix(Radix)-->`#`,integer(Radix),ci(`r`). +radix(16)-->`#`,ci(`X`). +radix(8)-->`#`,ci(`O`). +radix(2)-->`#`,ci(`B`). + +signed_radix_number(V)--> radix(Radix),!,signed_radix_2(Radix,V). +unsigned_radix_number(V)--> radix(Radix),!,unsigned_radix_2(Radix,V). + +extend_radix(Radix,Number0,'$RATIO'(Number0,Number1)) --> `/`,unsigned_radix_2(Radix,Number1). +%extend_radix(Radix,Number0,'/'(NumberB,Number1)) --> `.`,radix_number(Radix,Number1),{NumberB is (Number0*Number1)+1},!. +%extend_radix(Radix,Number0,'/'(NumberB,NumberR)) --> `.`,radix_number(Radix,Number1),{NumberR is Number1 * Radix, NumberB is (Number0*Number1)+1},!. +extend_radix(_Radix,Number,Number) --> []. + +radix_digits(OF,[X|Xs]) --> xdigit(X),{X alpha_to_lower(C),{X is C - 87,X []. + + + +mkvar_w([W0|Weights], Base, Val) :- + mkvar_w(Weights, Base, W0, Val). + +mkvar_w([], _, W, W). +mkvar_w([H|T], Base, W0, W) :- + W1 is W0*Base+(H), + mkvar_w(T, Base, W1, W). + + +ci([])--> !, []. +ci([U|Xs]) --> {to_lower(U,X)},!,alpha_to_lower(X),ci(Xs). + + +remove_optional_char(S)--> S,!. +remove_optional_char(_)-->[]. + +implode_threse_vars([N='$VAR'(N)|Vars]):-!, implode_threse_vars(Vars). +implode_threse_vars([]). + +ugly_sexpr_cont('$OBJ'([S|V])) --> rsymbol_maybe(``,S), sexpr_vector(V,`>`),swhite,!. +ugly_sexpr_cont('$OBJ'(V)) --> sexpr_vector(V,`>`),swhite,!. +ugly_sexpr_cont('$OBJ'(V)) --> sexpr_vector(V,`>`),swhite,!. +ugly_sexpr_cont('$OBJ'(V)) --> read_string_until_pairs(VS,`>`), swhite,{parse_sexpr_ascii_as_list(VS,V)},!. +ugly_sexpr_cont('$OBJ'(sugly,S)) --> read_string_until(S,`>`), swhite,!. + +%% sexpr(L)// is det. +% + +%sexpr(L) --> sblank,!,sexpr(L),!. +%sexpr(_) --> `)`,!,{trace,break,throw_reader_error(": an object cannot start with #\\)")}. +sexpr(X,H,T):- zalwayzz(sexpr0(X),H,M),zalwayzz(swhite,M,T), nop(if_debugging(sreader,(fbug(sexpr(X))))),!. +%sexpr(X,H,T):- zalwayzz(sexpr0(X,H,T)),!,swhite. +is_common_lisp:- fail. +is_scm:- fail. +is_metta:- true. + +:- discontiguous(sexpr0/3). + +sexpr0(L) --> sblank,!,sexpr(L),!. +sexpr0(L) --> `(`, !, swhite, zalwayzz(sexpr_list(L)),!, swhite. +sexpr0((Expr)) --> `.{`, read_string_until(S,`}.`), swhite, + {prolog_readable_term(Expr,S,_)}. + + +sexpr0(['#'(quote),E]) --> {\+ is_metta}, `'`, !, sexpr(E). % ' +sexpr0(['#'(hbackquote),E]) --> {is_scm}, `#```, !, sexpr(E). +sexpr0(['#'(backquote),E]) --> {\+ is_metta}, ````, !, sexpr(E). +sexpr0(['#BQ-COMMA-ELIPSE',E]) --> {\+ is_metta}, `,@`, !, sexpr(E). +sexpr0(['#COMMA',E]) --> { is_common_lisp }, `,`, !, sexpr(E). +sexpr0(['#HCOMMA',E]) --> {is_scm}, `#,`, !, sexpr(E). + +sexpr0('#\\'(A))--> { is_metta}, `'`,[C],`'`,{C>=32},!, {atom_codes(A,[C])}. + +% sexpr_metta('$STRING'(S)) --> s_string(S),!. + + + +sexpr_metta(O) --> dcg_peek(dcg_not( ( `(` ; `)` ; ` ` ; + sblank_ch) )), + (read_string_until(Text, dcg_peek( ( `(` ; `)` ; ` ` ; + sblank_ch) ))),!,{atom_string(O,Text)}. + + +sexpr0('$OBJ'(claz_bracket_vector,V)) --> `[`, sexpr_vector(V,`]`),!, swhite. + +% MeTTA/NARS % sexpr0('#'(A)) --> `|`, !, read_string_until(S,`|`), swhite,{quietly_sreader(((atom_string(A,S))))}. + +% maybe this is KIF +sexpr0('?'(E)) --> {kif_ok}, `?`, dcg_peek(([C],{sym_char(C)})),!, rsymbol(``,E), swhite. +% @TODO if KIF sexpr('#'(E)) --> `&%`, !, rsymbol(`#$`,E), swhite. + +sexpr0('$STRING'(S)) --> s_string(S),!. + +/******** BEGIN HASH ************/ + +sexpr0('#') --> `#`, swhite,!. +sexpr0('#\\'(35)) --> `#\\#`,!, swhite. +sexpr0(E) --> `#`,read_dispatch(E),!. + + +%sexpr('#\\'(C)) --> `#\\`,ci(`u`),!,remove_optional_char(`+`),dcg_basics:xinteger(C),!. +%sexpr('#\\'(C)) --> `#\\`,dcg_basics:digit(S0), swhite,!,{atom_codes(C,[S0])}. +sexpr0('#\\'(32)) --> `#\\ `,!. +sexpr0('#\\'(C)) --> `#\\`,!,zalwayzz(rsymbol(``,C)), swhite. + +%sexpr(['#-',K,Out]) --> `#-`,!,sexpr(C),swhite,expr_with_text(Out,sexpr(O),O),!,{as_keyword(C,K)}. +%sexpr(['#+',K,Out]) --> `#+`,!,sexpr(C),swhite,expr_with_text(Out,sexpr(O),O),!,{as_keyword(C,K)}. + +sexpr0(['#-',K,O]) --> `#-`,!,sexpr(C),swhite,sexpr(O),!,{as_keyword(C,K)},!. +sexpr0(['#+',K,O]) --> `#+`,!,sexpr(C),swhite,sexpr(O),!,{as_keyword(C,K)},!. + +:- if(is_wam_cl). + sexpr0(P) --> `#`,ci(`p`),!,zalwayzz((sexpr(C),{f_pathname(C,P)})),!. +:- endif. +sexpr0('$S'(C)) --> (`#`, ci(`s`),`(`),!,zalwayzz(sexpr_list(C)),swhite,!. +%sexpr('$COMPLEX'(R,I)) --> `#`,ci(`c`),`(`,!, lnumber(R),lnumber(I),`)`. +sexpr0('$COMPLEX'(R,I)) --> (`#`, ci(`c`),`(`),!,zalwayzz(sexpr_list([R,I])),swhite,!. +sexpr0('$OBJ'(claz_bitvector,C)) --> `#*`,radix_digits(2,C),swhite,!. + +sexpr0(function(E)) --> `#\'`, sexpr(E), !. %, swhite. % ' +sexpr0('$OBJ'(claz_vector,V)) --> `#(`, !, zalwayzz(sexpr_vector(V,`)`)),!, swhite,!. + +sexpr0(Number) --> `#`,integer(Radix),ci(`r`),!,zalwayzz((signed_radix_2(Radix,Number0),extend_radix(Radix,Number0,Number))),!. +sexpr0('$ARRAY'(Dims,V)) --> `#`,integer(Dims),ci(`a`),!,sexpr(V). +sexpr0(V) --> `#.`, !,sexpr(C),{to_untyped(C,UTC),!,intern_and_eval(UTC,V)},!. +sexpr0('#'(E)) --> `#:`, !,zalwayzz(rsymbol(`#:`,E)), swhite. + +sexpr0(OBJ)--> `#<`,!,zalwayzz(ugly_sexpr_cont(OBJ)),!. + +% @TODO if CYC sexpr('#'(E)) --> `#$`, !, rsymbol(`#$`,E), swhite. +% @TODO if scheme sexpr('#'(t)) --> `#t`, !, swhite. +% @TODO if schemesexpr('#'(f)) --> `#f`, !, swhite. + +% sexpr(E) --> `#`,read_dispatch_error(E). + +/*********END HASH ***********/ + +sexpr0(L)--> { is_metta }, sexpr_metta(L),!. + +sexpr0(E) --> sym_or_num(E), swhite,!. +sexpr0(Sym) --> `#`,integer(N123), swhite,!, {atom_concat('#',N123,Sym)}. +sexpr0(C) --> s_line_metta(C) ,swhite, !. %s_line_metta(C), !. +sexpr0(C) --> s_item_metta(C, e_o_s), swhite. %s_line_metta(C), !. +sexpr0(E) --> !,zalwayzz(sym_or_num(E)), swhite,!. + + +% c:/opt/logicmoo_workspace/packs_sys/logicmoo_opencog/guile/module/ice-9/and-let-star.scm + +priority_symbol((`|-`)). +/* +priority_symbol((`#=`)). +priority_symbol((`#+`)). +priority_symbol((`#-`)). +priority_symbol((`#false`)). +priority_symbol((`#true`)). +priority_symbol((`#nil`)). +priority_symbol((`#null`)). +priority_symbol((`#f`)). +priority_symbol((`#;`)):- is_scm. +priority_symbol((`#t`)). +priority_symbol((`+1+`)). +priority_symbol((`+1-`)). +priority_symbol((`-#+`)). +priority_symbol((`-1+`)). +priority_symbol((`-1-`)). +priority_symbol((`1+`)). +priority_symbol((`1-`)). +*/ + +sym_or_num('$COMPLEX'(L)) --> `#C(`,!, swhite, sexpr_list(L), swhite. +%sym_or_num((E)) --> unsigned_number(S),{number_string(E,S)}. +%sym_or_num((E)) --> unsigned_number(S),{number_string(E,S)}. + +%sym_or_num((E)) --> lnumber(E),swhite,!. +sym_or_num(E) --> rsymbol_maybe(``,E),!. +%sym_or_num('#'(E)) --> [C],{atom_codes(E,[C])}. + +sym_or_num(E) --> dcg_xor(rsymbol(``,E),lnumber(E)),!. +%sym_or_num(E) --> dcg_xor(rsymbol(``,E),lnumber(E)),!. +% sym_or_num('#'(E)) --> [C],{atom_codes(E,[C])}. + + +dcg_xor(DCG1,DCG2,S,E):- copy_term(DCG1,DCG1C),phrase(DCG1C,S,E),!, + (phrase(DCG2,S,[])->true;zalwayzz(DCG1C=DCG1)),!. +dcg_xor(_,DCG2,S,E):- phrase(DCG2,S,E),!. +%sblank --> [C], {var(C)},!. + +% sblank --> comment_expr(S,I,CP),!,{assert(t_l:s_reader_info('$COMMENT'(S,I,CP)))},!,swhite. +sblank --> sblank_char, comment_expr(CMT),!,{assert(t_l:s_reader_info(CMT))},!,swhite. +sblank --> sblank_ch. +sblank_ch --> sblank_char,!,swhite. + +sblank_char --> [C], {nonvar(C),charvar(C),!,bx(C =< 32)}. + +sblank_line --> eoln,!. +sblank_line --> [C],{bx(C =< 32)},!, sblank_line. + +s_string(Text) --> sexpr_string(Text). +s_string(Text) --> {kif_ok},`'`, !, zalwayzz(read_string_until(Text,`'`)),!. + +:- export(sblank_ch/2). + +swhite --> sblank,!. +swhite --> []. + + +sexpr_lazy_list_character_count(Location, Stream, Here, Here) :- + sexpr_lazy_list_character_count(Here, Location, Stream). + +sexpr_lazy_list_character_count(Here, CharNo, Stream) :- + '$skip_list'(Skipped, Here, Tail), + ( attvar(Tail) + -> frozen(Tail, + pure_input:read_to_input_stream(Stream, _PrevPos, Pos, _List)), + stream_position_data(char_count, Pos, EndRecordCharNo), + CharNo is EndRecordCharNo - Skipped + ; Tail == [] + -> CharNo = end_of_file-Skipped + ; type_error(lazy_list, Here) + ). + + + +comment_expr('$COMMENT'(Expr,I,CP)) --> comment_expr_3(Expr,I,CP),!. + +comment_expr_3(T,N,CharPOS) --> {\+ kif_ok}, `#|`, !, my_lazy_list_location(file(_,_,N,CharPOS)),!, zalwayzz(read_string_until_no_esc(S,`|#`)),!, + {text_to_string_safe(S,T)},!. +comment_expr_3(T,N,CharPOS) --> `;`,!, my_lazy_list_location(file(_,_,N,CharPOS)),!,zalwayzz(read_string_until_no_esc(S,eoln)),!, + {text_to_string_safe(S,T)},!. +comment_expr_3(T,N,CharPOS) --> {kif_ok}, `#!`,!, my_lazy_list_location(file(_,_,N,CharPOS)),!,zalwayzz(read_string_until_no_esc(S,eoln)),!, + {text_to_string_safe(S,T)},!. +% For Scheme +comment_expr_3(T,N,CharPOS) --> `#!`,!, my_lazy_list_location(file(_,_,N,CharPOS)),!,zalwayzz(read_string_until_no_esc(S,`!#`)),!, + {text_to_string_safe(S,T)},!. + + +sexprs([H|T]) --> sexpr(H), !, sexprs(T). +sexprs([]) --> []. + + +:- export('//'(sexpr_list,1)). + + +peek_symbol_breaker_or_number --> dcg_peek([C]),{\+ sym_char(C),\+ char_type(C,digit)}. +peek_symbol_breaker --> dcg_peek([C]),{\+ sym_char(C)}. +peek_symbol_breaker --> one_blank. + +sexpr_list(X) --> one_blank,!,sexpr_list(X). +sexpr_list([]) --> `)`, !. +%sexpr_list(_) --> `.`, [C], {\+ sym_char(C)}, {fail}. +sexpr_list([Car|Cdr]) --> sexpr(Car), !, sexpr_rest(Cdr),!. + +sexpr_rest([]) --> `)`, !. +% allow dotcons/improper lists.. but also allow dot in the middle of the list (non-CL) +sexpr_rest(E) --> `.`, [C], {\+ sym_char(C)}, sexpr(E,C), `)` , ! . +sexpr_rest(E) --> {kif_ok}, `@`, rsymbol(`?`,E), `)`. +sexpr_rest([Car|Cdr]) --> sexpr(Car), !, {Car\==''}, + %maybe_throw_reader_error(Car), + sexpr_rest(Cdr),!. + +maybe_throw_reader_error(Car,I,O):- Car=='',lazy_list_location(Info,I,O),!, + write_src(Info), + if_t(nb_current('$parser_last_read',V),write_src('$parser_last_read'=V)), + throw(ll_read_error(Info)). +maybe_throw_reader_error(Car,I,I):- Car=='', !, + ignore(sexpr_lazy_list_character_count(I,CharPos,Stream)),!, + Info= ics(I,CharPos,Stream), + write_src(Info), + throw(ll_read_error(Info)). +maybe_throw_reader_error(_,I,I). + +sexpr_vector(O,End) --> zalwayzz(sexpr_vector0(IO,End)),!,{zalwayzz(O=IO)}. + +sexpr_vector0(X) --> one_blank,!,sexpr_vector0(X). +sexpr_vector0([],End) --> End, !. +sexpr_vector0([First|Rest],End) --> sexpr(First), !, sexpr_vector0(Rest,End). + +%s_string_cont(Until,"") --> Until,!, swhite. +:- encoding(iso_latin_1). +sexpr_string(Text) --> `"`, !, zalwayzz(read_string_until(Text,`"`)),!. +sexpr_string(Text) --> `“`, !, zalwayzz(read_string_until(Text,(`”`;`“`))),!. +sexpr_string(Text) --> (`”`;`“`), !, zalwayzz(read_string_until(Text,(`”`;`“`))),!. +sexpr_string(Text) --> `#|`, !, zalwayzz(read_string_until(Text,`|#`)),!. +:- encoding(utf8). +%sexpr_string([C|S],End) --> `\\`,!, zalwayzz(escaped_char(C)),!, sexpr_string(S,End). +%sexpr_string([],End) --> End, !. +% sexpr_string([32|S]) --> [C],{eoln(C)}, sexpr_string(S). +%sexpr_string([C|S],End) --> [C],!,sexpr_string(S,End). + +rsymbol_chars([C1,C2|Rest]) --> [C1,C2], {priority_symbol([C1,C2|Rest])},Rest,!. +rsymbol_chars([C|S])--> [C], {sym_char(C)},!, sym_continue(S),!. +%rsymbol_cont(Prepend,E) --> sym_continue(S), {append(Prepend,S,AChars),string_to_atom(AChars,E)},!. + +rsymbol(Chars,E) --> rsymbol_chars(List), {append(Chars,List,AChars),string_to_atom(AChars,E)},!. + +rsymbol_maybe(Prepend,ES) --> rsymbol(Prepend,E),{maybe_string(E,ES)},!. + +maybe_string(E,ES):- nb_current('$maybe_string',t),!,text_to_string_safe(E,ES),!. +maybe_string(E,E). + +sym_continue([H|T]) --> [H], {sym_char(H)},!, sym_continue(T). +sym_continue([39]) --> `'`, peek_symbol_breaker,!. % ' +sym_continue([]) --> peek_symbol_breaker,!. +sym_continue([]) --> []. + +string_vector([First|Rest]) --> sexpr(First), !, string_vector(Rest),!. +string_vector([]) --> [], !. + +% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +lnumber(_)--> [C],{code_type(C,alpha)},!,{fail}. +lnumber(N)--> lnumber0(N),!. % (peek_symbol_breaker;[]). + +oneof_ci(OneOf,[C])--> {member(C,OneOf)},ci([C]). +dcg_and2(DCG1,DCG2,S,E) :- dcg_phrase(DCG1,S,E),!,dcg_phrase(DCG2,S,E),!. +dcg_each_call_cleanup(Setup,DCG,Cleanup,S,E) :- each_call_cleanup(Setup,dcg_phrase(DCG,S,E),Cleanup). +dcg_phrase(\+ DCG1,S,E):- !, \+ phrase(DCG1,S,E). +dcg_phrase(DCG1,S,E):- phrase(DCG1,S,E),!. + +dcg_not(DCG1,S,E) :- \+ dcg_phrase(DCG1,S,E). + +enumber(N)--> lnumber(L),!,{to_untyped(L,N)},!. + +/* +Format Minimum Precision Minimum Exponent Size +Short 13 bits 5 bits +Single 24 bits 8 bits +Double 50 bits 8 bits +Long 50 bits 8 bits +*/ + +float_e_type(`E`,claz_single_float). +float_e_type(`f`,claz_single_float). +float_e_type(`d`,claz_double_float). +float_e_type(`L`,claz_long_float). +float_e_type(`s`,claz_short_float). + +lnumber_exp('$EXP'(N,T,E))-->snumber_no_exp(N),!,oneof_ci(`EsfdL`,TC),dcg_basics:integer(E),{exp:float_e_type(TC,T)},!. +lnumber_exp('$EXP'(N,T,E))-->dcg_basics:integer(N),!,oneof_ci(`EsfdL`,TC),dcg_basics:integer(E),!,{float_e_type(TC,T)},!. + + +lnumber0(N) --> lnumber_exp(N),!. +lnumber0('$RATIO'(N,D)) --> sint(N),`/`,uint(D),!. +lnumber0(N) --> snumber_no_exp(N),!. +%lnumber0(N) --> dcg_basics:number(N),!. + + +snumber_no_exp(N)--> `-`,!,unumber_no_exp(S),{N is -S},!. +snumber_no_exp(N)--> `+`,!,unumber_no_exp(N),!. +snumber_no_exp(N)--> unumber_no_exp(N),!. +%snumber_no_exp(N)--> sint(N),!. + + +sint(N) --> signed_radix_number(N),!. +sint(N)--> `-`,!,uint(S),{N is -S},!. +sint(N)--> `+`,!,uint(N),!. +sint(N)--> uint(N),!. + +natural_int(_) --> dcg_not(dcg_basics:digit(_)),!,{fail}. +natural_int(N) --> dcg_basics:integer(N),!. + +digits_dot_digits --> natural_int(_),!,`.`,!,natural_int(_),!. + +unumber_no_exp(N) --> dcg_and2(digits_dot_digits,dcg_basics:float(N)),!. +unumber_no_exp(N) --> `.`,!,dcg_basics:digit(S0),!,dcg_basics:digits(S),{(notrace_catch_fail(number_codes(N,[48,46,S0|S])))},!. +unumber_no_exp(N)--> natural_int(E),`.`,natural_int(S),{(notrace_catch_fail(number_codes(ND,[48,46|S]))),N is ND + E},!. +unumber_no_exp(N) --> natural_int(N),!,remove_optional_char(`.`),!. + +uint(N) --> unsigned_radix_number(N),!. +uint(N) --> natural_int(N),!,remove_optional_char(`.`),!. + + +% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + + +%= + +%% sexpr( ?E, ?C, ?X, ?Z) is det. +% +% S-Expression. +% +sexpr(E,C,X,Z) :- swhite([C|X],Y), sexpr(E,Y,Z),!. + +% dquote semicolon parens hash qquote comma backquote + +%= + +%% sym_char( ?C) is det. +% +% Sym Char. (not ";()#',` +% ) +% + +sym_char(C):- bx(C =< 32),!,fail. +%sym_char(44). % allow comma in middle of symbol +sym_char(C):- memberchk(C,`"()```),!,fail. +% maybe 44 ? comma maybe not # or ; ? ' `'`'````'" +%sym_char(C):- nb_current('$maybe_string',t),memberchk(C,`,.:;!%`),!,fail. +sym_char(_):- !. + +sym_char_start(C):- C\==44,C\==59,sym_char(C). + + + +:- thread_initialization(nb_setval('$maybe_string',[])). + +:- thread_local(t_l:s2p/1). +:- thread_local(t_l:each_file_term/1). + +string_to_syms:- !, false. +string_to_syms:- option_value('string-are-atoms',true). + + +%= + +%% to_unbackquote( ?I, ?O) is det. +% +% Converted To Unbackquote. +% +to_unbackquote(I,O):-to_untyped(I,O),!. + +:- export(to_untyped/2). + + +%atom_or_string(X):- (atom(X);string(X)),!. +as_keyword(C,K):- atom(C),!,(atom_concat_or_rtrace(':',_,C)->K=C;atom_concat_or_rtrace(':',C,K)),!. +as_keyword(C,C):- \+compound(C),!. +as_keyword([A|B],[AK|BK]):- !, as_keyword(A,AK),as_keyword(B,BK),!. +as_keyword(C,C). + + +%% to_untyped( :TermVar, :TermName) is det. +% +% Converted To Untyped. +% +to_untyped(S,S):- var(S),!. +to_untyped(S,S):- is_dict(S),!. +to_untyped([],[]):-!. +to_untyped('#-'(C,I),'#-'(K,O)):- as_keyword(C,K),!,to_untyped(I,O),!. +to_untyped('#+'(C,I),'#+'(K,O)):- as_keyword(C,K),!,to_untyped(I,O),!. +to_untyped('?'(S),_):- S=='??',!. +% to_untyped('?'(S),'$VAR'('_')):- S=='??',!. +% to_untyped(VAR,NameU):-atom(VAR),atom_concat_or_rtrace('#$',NameU,VAR),!. +to_untyped(VAR,NameU):-atom(VAR),(atom_concat_or_rtrace(N,'.',VAR)->true;N=VAR),(notrace_catch_fail(atom_number(N,NameU))),!. +%to_untyped(S,s(L)):- string(S),atom_contains(S,' '),atomic_list_concat(['(',S,')'],O),parse_sexpr_string(O,L),!. +to_untyped(S,S):- string(S),!. +to_untyped(S,S):- number(S),!. +%to_untyped(S,O):- atom(S),notrace_catch_fail(atom_number(S,O)),!. +to_untyped(Var,'$VAR'(Name)):-svar(Var,Name),!. +to_untyped('?'(Var),'$VAR'(Name)):-svar_fixvarname(Var,Name),!. +to_untyped(Atom,Atom):- \+ compound(Atom),!. +to_untyped('@'(Var),'$VAR'(Name)):-svar_fixvarname(Var,Name),!. +to_untyped('#'(S),O):- !, (nonvar(S)->to_untyped(S,O) ; O='#'(S)). +to_untyped('$CHAR'(S),C):-!,to_untyped('#\\'(S),C),!. +to_untyped('#\\'(S),C):-to_char(S,C),!. +to_untyped('#\\'(S),'#\\'(S)):-!. +to_untyped('$OBJ'([FUN, F]),O):- atom(FUN),!,to_untyped('$OBJ'(FUN, F),O). +to_untyped('$OBJ'([FUN| F]),O):- atom(FUN),!,to_untyped('$OBJ'(FUN, F),O). +to_untyped('$OBJ'(S),'$OBJ'(O)):-to_untyped(S,O),!. +to_untyped('$OBJ'(Ungly,S),'$OBJ'(Type,O)):- text_to_string_safe(Ungly,Str),string_to_atom(Str,Type),to_untyped(S,O),!. +to_untyped('$OBJ'(Ungly,S),'$OBJ'(Ungly,O)):-to_untyped(S,O),!. +to_untyped('$OBJ'(Ungly,S),O):-to_untyped(S,SO),!,O=..[Ungly,SO]. +to_untyped('$COMPLEX'(N0,D0),N):- to_untyped(D0,D), notrace_catch_fail(( 0 =:= D)),to_untyped(N0,N). +to_untyped('$RATIO'(N0,D0),V):- to_untyped(N0,N),to_untyped(D0,D), notrace_catch_fail(( 0 is N mod D, V is N div D)). +to_untyped('$NUMBER'(S),O):-nonvar(S),to_number(S,O),to_untyped(S,O),!. +to_untyped('$NUMBER'(S),'$NUMBER'(claz_short_float,S)):- float(S),!. +to_untyped('$NUMBER'(S),'$NUMBER'(claz_bignum,S)). +to_untyped('$EXP'(I,'E',E),N):- (notrace_catch_fail(N is 0.0 + ((I * 10^E)))),!. +to_untyped('$EXP'(I,claz_single_float,E),N):- (notrace_catch_fail(N is 0.0 + ((I * 10^E)))),!. +to_untyped('$EXP'(I,T,E),'$NUMBER'(T,N)):- (notrace_catch_fail(N is (I * 10^E))),!. +to_untyped('$EXP'(I,T,E),'$EXP'(I,T,E)):-!. + +to_untyped(with_text(I,_Txt),O):-to_untyped(I,O),!. +to_untyped(with_text(I,Txt),with_text(O,Txt)):-to_untyped(I,O),!. + +% to_untyped([[]],[]):-!. +to_untyped('$STR'(Expr),Forms):- (text_to_string_safe(Expr,Forms);to_untyped(Expr,Forms)),!. +to_untyped('$STRING'(Expr),'$STRING'(Forms)):- (text_to_string_safe(Expr,Forms);to_untyped(Expr,Forms)),!. +to_untyped(['#'(Backquote),Rest],Out):- is_common_lisp, Backquote == backquote, !,to_untyped(['#'('#BQ'),Rest],Out). +to_untyped(['#'(S)|Rest],OOut):- nonvar(S), is_list(Rest),must_maplist(to_untyped,[S|Rest],[F|Mid]), + ((atom(F),t_l:s2p(F))-> Out=..[F|Mid];Out=[F|Mid]), + to_untyped(Out,OOut). +to_untyped(ExprI,ExprO):- ExprI=..[F|Expr],atom_concat_or_rtrace('$',_,F),!,must_maplist(to_untyped,Expr,TT),ExprO=..[F|TT]. + +% to_untyped([H|T],Forms):-is_list([H|T]),zalwayzz(text_to_string_safe([H|T],Forms);maplist(to_untyped,[H|T],Forms)). +to_untyped([H|T],[HH|TT]):-!,zalwayzz((to_untyped(H,HH),!,to_untyped(T,TT))). +to_untyped(ExprI,ExprO):- zalwayzz(ExprI=..Expr), + must_maplist(to_untyped,Expr,[HH|TT]),(atom(HH)-> ExprO=..[HH|TT] ; ExprO=[HH|TT]),!. +% to_untyped(Expr,Forms):-def_compile_all(Expr,Forms),!. + +to_number(S,S):-number(S),!. +to_number(S,N):- text_to_string_safe(S,Str),number_string(N,Str),!. + + +to_char(S,'#\\'(S)):- var(S),!. +to_char('#'(S),C):- !, to_char(S,C). +to_char('#\\'(S),C):- !, to_char(S,C). +to_char(S,C):- atom(S),atom_concat('^',SS,S),upcase_atom(SS,SU),atom_codes(SU,[N64]),N is N64-64,N>=0,!,to_char(N,C). +to_char(S,C):- atom(S),atom_codes(S,[N]),!,to_char(N,C). +to_char(N,C):- text_to_string_safe(N,Str),name_to_charcode(Str,Code),to_char(Code,C),!. +%to_char(N,'#\\'(S)):- to_number(N,NC),!,char_code_to_char(NC,S),!. +to_char(N,'#\\'(S)):- integer(N),!,char_code_to_char(N,S),!. +to_char(N,'#\\'(N)). + +char_code_int(Char,Code):- notrace_catch_fail(char_code(Char,Code)),!. +char_code_int(Char,Code):- notrace_catch_fail(atom_codes(Char,[Code])),!. +char_code_int(Char,Code):- atom(Char),name_to_charcode(Char,Code),!. +char_code_int(Char,Code):- var(Char),!,fbug(char_code_int(Char,Code)), only_debug(break). +char_code_int(Char,Code):- fbug(char_code_int(Char,Code)),only_debug(break). + +char_code_to_char(N,S):- atom(N),atom_codes(N,[_]),!,S=N. +char_code_to_char(N,S):- atom(N),!,S=N. +%char_code_to_char(N,S):- code_type(N,graph),atom_codes(S,[N]),atom(S),!. +%char_code_to_char(N,O):- \+ integer(N),char_type(N,_),!,N=O. +%char_code_to_char(32,' '):-!. +%char_code_to_char(N,N):- \+ code_type(N,graph),!. +%char_code_to_char(N,N):- code_type(N,white),!. +char_code_to_char(N,S):- notrace_catch_fail(atom_codes(S,[N])),!. + + + +name_to_charcode(Str,Code):-find_from_name(Str,Code),!. +name_to_charcode(Str,Code):-text_upper(Str,StrU),find_from_name2(StrU,Code). +name_to_charcode(Str,Code):-string_codes(Str,[S,H1,H2,H3,H4|HEX]),memberchk(S,`Uu`),char_type(H4,xdigit(_)), + notrace_catch_fail(read_from_codes([48, 120,H1,H2,H3,H4|HEX],Code)). +name_to_charcode(Str,Code):-string_codes(Str,[S,H1|BASE10]),memberchk(S,`nd`),char_type(H1,digit), + notrace_catch_fail(read_from_codes([H1|BASE10],Code)). + +find_from_name(Str,Code):-string_codes(Str,Chars),lisp_code_name_extra(Code,Chars). +find_from_name(Str,Code):-lisp_code_name(Code,Str). +find_from_name(Str,Code):-string_chars(Str,Chars),lisp_code_name(Code,Chars). + +make_lisp_character(I,O):-quietly(to_char(I,O)). + +f_code_char(CH,CC):- zalwayzz(to_char(CH,CC)),!. +f_name_char(Name,CC):- zalwayzz((def_to_prolog_string(Name,CH),name_to_charcode(CH,Code),to_char(Code,CC))). +f_char_name(CH,CC):- zalwayzz(def_is_characterp(CH)),zalwayzz(code_to_name(CH,CC)). +f_char_int(CH,CC):- zalwayzz(def_is_characterp(CH)),zalwayzz('#\\'(C)=CH),(integer(C)->CC=C;char_code_int(C,CC)). +f_char_code(CH,CC):- f_char_int(CH,CC). + +to_prolog_char('#\\'(X),O):-!,to_prolog_char(X,O). +to_prolog_char(Code,Char):- number(Code),!,zalwayzz(char_code_int(Char,Code)),!. +%to_prolog_char(S,S):- atom(S),char_type(S,_),!. +to_prolog_char(Atom,Char):- name(Atom,[C|Odes]),!, + ((Odes==[] -> char_code_int(Char,C); + zalwayzz((text_to_string(Atom,String),name_to_charcode(String,Code),char_code_int(Char,Code))))). + +code_to_name(Char,Str):- number(Char),Char=Code,!,zalwayzz((code_to_name0(Code,Name),!,text_to_string(Name,Str))). +code_to_name(Char,Str):- zalwayzz((to_prolog_char(Char,PC),char_code_int(PC,Code),code_to_name0(Code,Name),!,text_to_string(Name,Str))). + +code_to_name0(Code,Name):-lisp_code_name_extra(Code,Name). +code_to_name0(Code,Name):-lisp_code_name(Code,Name). +code_to_name0(Code,Name):- Code<32, Ascii is Code+64,atom_codes(Name,[94,Ascii]). +code_to_name0(Code,Name):- code_type(Code,graph),!,atom_codes(Name,[Code]). + + +find_from_name2(Str,Code):-find_from_name(Str,Code). +find_from_name2(Str,Code):-lisp_code_name(Code,Chars),text_upper(Chars,Str). +find_from_name2(Str,Code):-lisp_code_name_extra(Code,Chars),text_upper(Chars,Str). + +text_upper(T,U):-text_to_string_safe(T,S),string_upper(S,U). + +lisp_code_name_extra(0,`Null`). +lisp_code_name_extra(1,`Soh`). +lisp_code_name_extra(2,`^B`). +lisp_code_name_extra(7,`Bell`). +lisp_code_name_extra(7,`bell`). +lisp_code_name_extra(8,`BCKSPC`). +lisp_code_name_extra(10,`Newline`). +lisp_code_name_extra(10,`LF`). +lisp_code_name_extra(10,`Linefeed`). +lisp_code_name_extra(11,`Vt`). +lisp_code_name_extra(27,`Escape`). +lisp_code_name_extra(27,`Esc`). +lisp_code_name_extra(32,`Space`). +lisp_code_name_extra(28,`fs`). +lisp_code_name_extra(13,`Ret`). + + +% @TODO undo this temp speedup +:- set_prolog_flag(all_lisp_char_names,false). +:- use_module('chars.data'). +/* + +(with-open-file (strm "lisp_code_names.pl" :direction :output :if-exists :supersede :if-does-not-exist :create) + (format strm ":- module(lisp_code_names,[lisp_code_name/2]).~%:- set_prolog_flag(double_quotes,chars).~%~%") + (loop for i from 0 to 655360 do (let ((cname (char-name (code-char i))) (uname4 (format () "U~4,'0X" i)) (uname8 (format () "U~8,'0X" i))) + (unless (equal cname uname4) (unless (equal cname uname8) (format strm "lisp_code_name(~A,~S).~%" i cname )))))) +*/ + + +%% remove_incompletes( :TermN, :TermCBefore) is det. +% +% Remove Incompletes. +% +remove_incompletes([],[]). +remove_incompletes([N=_|Before],CBefore):-var(N),!, + remove_incompletes(Before,CBefore). +remove_incompletes([NV|Before],[NV|CBefore]):- + remove_incompletes(Before,CBefore). + +:- export(extract_lvars/3). + +%= + +%% extract_lvars( ?A, ?B, ?After) is det. +% +% Extract Lvars. +% +extract_lvars(A,B,After):- + (get_varname_list(Before)->true;Before=[]), + remove_incompletes(Before,CBefore),!, + copy_lvars(A,CBefore,B,After),!. + +% copy_lvars( VAR,Vars,VAR,Vars):- var(VAR),!. + +%= + +%% copy_lvars( :TermVAR, ?Vars, :TermNV, ?NVars) is det. +% +% Copy Lvars. +% +copy_lvars(Term,Vars,Out,VarsO):- Term ==[],!,zalwayzz((Out=Term,VarsO=Vars)). +copy_lvars( VAR,Vars,Out,VarsO):- var(VAR),!,zalwayzz((Out=VAR,VarsO=Vars)). +copy_lvars([H|T],Vars,[NH|NT],VarsO):- !, copy_lvars(H,Vars,NH,SVars),!, copy_lvars(T,SVars,NT,VarsO). +copy_lvars('?'(Inner),Vars,Out,VarsO):- !, copy_lvars(Inner,Vars,NInner,VarsO), zalwayzz((atom(NInner) -> atom_concat_or_rtrace('?',NInner,Out) ; Out = '?'(NInner))),!. +copy_lvars( VAR,Vars,Out,VarsO):- svar(VAR,Name)->zalwayzz(atom(Name)),!,zalwayzz(register_var(Name=Out,Vars,VarsO)). +copy_lvars( VAR,Vars,Out,VarsO):- \+ compound(VAR),!,zalwayzz((Out=VAR,VarsO=Vars)). +copy_lvars(Term,Vars,NTerm,VarsO):- + Term=..[F|Args], % decompose term + (svar(F,_)-> copy_lvars( [F|Args],Vars,NTerm,VarsO); + % construct copy term + (copy_lvars(Args,Vars,NArgs,VarsO), NTerm=..[F|NArgs])),!. + + + +%= + +%% svar( ?Var, ?NameU) is det. +% +% If this is a KIF var, convert to a name for prolog +% +svar(SVAR,UP):- nonvar(UP),!,trace_or_throw(nonvar_svar(SVAR,UP)). +svar(Var,Name):- var(Var),!,zalwayzz(svar_fixvarname(Var,Name)). +svar('$VAR'(Var),Name):-number(Var),Var > -1, !, zalwayzz(format(atom(Name),'~w',['$VAR'(Var)])),!. +svar('$VAR'(Name),VarName):-!,zalwayzz(svar_fixvarname(Name,VarName)). +svar('?'(Name),NameU):-svar_fixvarname(Name,NameU),!. +svar(_,_):- \+ kif_ok,!,fail. +svar(VAR,Name):-atom(VAR),atom_concat_or_rtrace('?',A,VAR),non_empty_atom(A),svar_fixvarname(VAR,Name),!. +svar([],_):-!,fail. +svar('#'(Name),NameU):-!,svar(Name,NameU),!. +svar('@'(Name),NameU):-svar_fixvarname(Name,NameU),!. +% svar(VAR,Name):-atom(VAR),atom_concat_or_rtrace('_',_,VAR),svar_fixvarname(VAR,Name),!. +svar(VAR,Name):-atom(VAR),atom_concat_or_rtrace('@',A,VAR),non_empty_atom(A),svar_fixvarname(VAR,Name),!. + + +:- export(svar_fixvarname/2). + +%= + +%% svar_fixvarname( ?SVARIN, ?UP) is det. +% +% Svar Fixvarname. +% + +svar_fixvarname(SVAR,UP):- nonvar(UP),!,trace_or_throw(nonvar_svar_fixvarname(SVAR,UP)). +svar_fixvarname(SVAR,UP):- svar_fixname(SVAR,UP),!. +svar_fixvarname(SVAR,UP):- fail,trace_or_throw(svar_fixname(SVAR,UP)). + +svar_fixname(Var,NameO):-var(Var),!,variable_name_or_ref(Var,Name),sanity(nonvar(Name)),!,svar_fixvarname(Name,NameO). +svar_fixname('$VAR'(Name),UP):- !,svar_fixvarname(Name,UP). +svar_fixname('@'(Name),UP):- !,svar_fixvarname(Name,UP). +svar_fixname('?'(Name),UP):- !,svar_fixvarname(Name,UP). +svar_fixname('block'(Name),UP):- !,svar_fixvarname(Name,UP). +svar_fixname(SVAR,SVARO):- ok_var_name(SVAR),!,SVARO=SVAR. +svar_fixname('??','_'):-!. +svar_fixname(QA,AU):-atom_concat_or_rtrace('??',A,QA),non_empty_atom(A),!,svar_fixvarname(A,AO),atom_concat_or_rtrace('_',AO,AU). +svar_fixname(QA,AO):-atom_concat_or_rtrace('?',A,QA),non_empty_atom(A),!,svar_fixvarname(A,AO). +svar_fixname(QA,AO):-atom_concat_or_rtrace('@',A,QA),non_empty_atom(A),!,svar_fixvarname(A,AO). +svar_fixname(NameU,NameU):-atom_concat_or_rtrace('_',Name,NameU),non_empty_atom(Name),atom_number(Name,_),!. +svar_fixname(NameU,NameUO):-atom_concat_or_rtrace('_',Name,NameU),non_empty_atom(Name), + \+ atom_number(Name,_),!,svar_fixvarname(Name,NameO),atom_concat_or_rtrace('_',NameO,NameUO). +svar_fixname(I,O):- + notrace(( + notrace(catch(fix_varcase(I,M0),_,fail)), + atom_subst(M0,'@','_AT_',M1), + atom_subst(M1,'?','_Q_',M2), + atom_subst(M2,':','_C_',M3), + atom_subst(M3,'-','_',O), + ok_var_name(O))),!. + +%= + +%% fix_varcase( ?I, ?O) is det. +% +% Fix Varcase. +% +fix_varcase(Word,Word):- atom_concat_or_rtrace('_',_,Word),!. +fix_varcase(Word,WordC):- !, atom_codes(Word,[F|R]),to_upper(F,U),atom_codes(WordC,[U|R]). +% the cut above stops the rest +fix_varcase(Word,Word):-upcase_atom(Word,UC),UC=Word,!. +fix_varcase(Word,WordC):-downcase_atom(Word,UC),UC=Word,!,atom_codes(Word,[F|R]),to_upper(F,U),atom_codes(WordC,[U|R]). +fix_varcase(Word,Word). % mixed case + +:- export(ok_varname_or_int/1). + +%% ok_varname_or_int( ?Name) is det. +% +% Ok Varname. +% +ok_varname_or_int(Name):- atom(Name),!,ok_var_name(Name). +ok_varname_or_int(Name):- number(Name). + +%% ok_var_name( ?Name) is det. +% +% Ok Varname. +% +ok_var_name(Name):- + notrace(( + quietly_sreader(( atom(Name),atom_codes(Name,[C|_List]),char_type(C,prolog_var_start), + notrace(catch(read_term_from_atom(Name,Term,[variable_names(Vs)]),_,fail)), + !,var(Term),Vs=[RName=RVAR],!,RVAR==Term,RName==Name)))). + +%:- export(ok_codes_in_varname/1). +%ok_codes_in_varname([]). +%ok_codes_in_varname([C|List]):-!,ok_in_varname(C),ok_codes_in_varname(List). + +%:- export(ok_in_varname/1). +%ok_in_varname(C):-sym_char(C),\+member(C,`!@#$%^&*?()`). + + + +%= + +%% atom_upper( ?A, ?U) is det. +% +% Atom Upper. +% +atom_upper(A,U):-string_upper(A,S),quietly_sreader(((atom_string(U,S)))). + + +%= + +%% lisp_read_from_input( ?Forms) is det. +% +% Lisp Read Converted From Input. +% +lisp_read_from_input(Forms):-lisp_read(current_input,Forms),!. + +readCycL(Forms):-lisp_read(current_input,Forms). + +%% lisp_read_from_stream( ?I, ?Forms) is det. +% +% Lisp Read Converted To Simple Form. +% +lisp_read_from_stream(Input,Forms):- + lisp_read(Input,Forms). + + +%% lisp_read( ?I, ?Forms) is det. +% +% Lisp Read Converted To Simple Form. +% +lisp_read(Input,Forms):- + lisp_read_typed(Input, Forms0),!, + quietly_sreader((zalwayzz(to_untyped(Forms0,Forms)))). + + + +%% lisp_read_typed( ?I, -Expr) is det. +% +% Lisp Read, Expression models DCG +% +lisp_read_typed(In,Expr):- track_stream(In,parse_sexpr(In,Expr)),!. +/* +lisp_read_typed(In,Expr):- fail, % old_stream_read + (read_line_to_codes(current_input,AsciiCodes), + (AsciiCodes==[]-> (at_end_of_stream(In) -> (Expr=end_of_file); lisp_read_typed(In,Expr)); + once(zalwayzz(parse_sexpr(AsciiCodes,Expr);lisp_read_typed(In,Expr));read_term_from_codes(AsciiCodes,Expr,[])))). +*/ + + +%= + +%% lowcase( :TermC1, :TermC2) is det. +% +% Lowcase. +% +lowcase([],[]). +lowcase([C1|T1],[C2|T2]) :- lowercase(C1,C2), lowcase(T1,T2). + + +%= + +%% lowercase( ?C1, ?C2) is det. +% +% Lowercase. +% +lowercase(C1,C2) :- C1 >= 65, C1 =< 90, !, C2 is C1+32. +lowercase(C,C). + + +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + Interpretation + -------------- + + Declaratively, execution of a Lisp form is a relation between the + (function and variable) binding environment before its execution + and the environment after its execution. A Lisp program is a + sequence of Lisp forms, and its result is the sequence of their + results. The environment is represented as a pair of association + lists Fs-Vs, associating function names with argument names and + bodies, and variables with values. DCGs are used to implicitly + thread the environment state through. +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + + + +%= + +%% codelist_to_forms( ?AsciiCodesList, ?FormsOut) is det. +% +% Codelist Converted To Forms. +% +codelist_to_forms(AsciiCodesList,FormsOut):- + parse_sexpr(AsciiCodesList, Forms0),!, + zalwayzz(def_compile_all(Forms0, FormsOut)),!. + + +/* + +:- export(baseKB:rff/0). + +baseKB:rff:-baseKB:rff(dbginfo(n(first)),dbginfo(n(retry)),dbginfo(n(success)),dbginfo(n(failure))). + +:- export(baseKB:rff/4). +baseKB:rff(OnFirst,OnRetry,OnSuccess,OnFailure) :- CU = was(never,first), + call_cleanup(( + process_rff(CU,OnFirst,OnRetry,OnSuccess,OnFailure), + (nb_setarg(1,CU,first));((nb_setarg(1,CU,second)),!,fail)), + (nb_setarg(2,CU,second),process_rff(CU,OnFirst,OnRetry,OnSuccess,OnFailure),dbginfo(cleanup(CU)))), + once(( + process_rff(CU,OnFirst,OnRetry,OnSuccess,OnFailure), + CU \= was(second, _))). + +:- export(process_rff/5). +process_rff(CU,OnFirst,OnRetry,OnSuccess,OnFailure):- + dbginfo(next(CU)), + once(((CU==was(first,first)->OnFirst;true), + (CU==was(second,first)->OnRetry;true), + (CU==was(second,second)->OnFailure;true), + (CU==was(first,second)-e>OnSuccess;true))). + + +*/ + + +/* +:- prolog_load_context(directory,Dir), + DirFor = plarkc, + (( \+ user:file_search_path(DirFor,Dir)) ->asserta(user:file_search_path(DirFor,Dir));true), + absolute_file_name('../../../../',Y,[relative_to(Dir),file_type(directory)]), + (( \+ user:file_search_path(pack,Y)) ->asserta(user:file_search_path(pack,Y));true). +:- attach_packs. +:- initialization(attach_packs). +*/ + +% [Required] Load the Logicmoo Library Utils +% = % :- ensure_loaded(logicmoo(logicmoo_utils)). + +% % :- ensure_loaded(logicmoo(plarkc/mpred_cyc_api)). + + +:- export(fixvars/4). + +%= + +%% fixvars( ?P, ?VALUE2, :TermARG3, ?P) is det. +% +% Fixvars. +% +fixvars(P,_,[],P):-!. +fixvars(P,N,[V|VARS],PO):- + quietly_sreader((atom_string(Name,V))), + svar_fixvarname(Name,NB),Var = '$VAR'(NB), + substM(P,'$VAR'(N),Var,PM0), + substM(PM0,'$VAR'(Name),Var,PM), + % (get_varname_list(Vs)->true;Vs=[]), + % append(Vs,[Name=Var],NVs), + % nput_variable_names( NVs), + N2 is N + 1, fixvars(PM,N2,VARS,PO). + + + + +non_empty_atom(A1):- atom(A1),atom_length(A1,AL),!,AL>0. + +:- meta_predicate(sexpr_sterm_to_pterm(+,?,?)). +:- meta_predicate(sexpr_sterm_to_pterm_list(+,?,?)). + +is_relation_sexpr('=>'). +is_relation_sexpr('<=>'). +is_relation_sexpr('==>'). +is_relation_sexpr('<==>'). +is_relation_sexpr('not'). +is_relation_sexpr(typeGenls). + +is_va_relation('or'). +is_va_relation('and'). +%= + + +is_exact_symbol(N,_):- \+ atom(N),!,fail. +is_exact_symbol(N,P):- nonvar(P),!,is_exact_symbol(N,PP),zalwayzz(P=PP). +is_exact_symbol(':-',':-'). +is_exact_symbol('?-','?-'). +is_exact_symbol('??',_). + +%:- baseKB:ensure_loaded(logicmoo('plarkc/logicmoo_i_cyc_rewriting')). + +maybe_var(S,Name,'$VAR'(Name)):- S=='?',atom(Name),!. + +%% sexpr_sterm_to_pterm(?VAR, ?V) is det. +% +% S-expression Sterm Converted To Pterm. +% +sexpr_sterm_to_pterm(S,P):- sexpr_sterm_to_pterm(0,S,P). + + +sexpr_sterm_to_pterm_pre_list(_,STERM,STERM):- \+ compound(STERM), !. +sexpr_sterm_to_pterm_pre_list(_,STERM,STERM):- \+ is_list(STERM), !. +% sexpr_sterm_to_pterm_pre_list(_,[S|STERM],[S|STERM]):- STERM == [], !. +sexpr_sterm_to_pterm_pre_list(TD,[S0|STERM0],[S|STERM]):- + (is_list(S0)->sexpr_sterm_to_pterm(TD,S0,S);sexpr_sterm_to_pterm_pre_list(TD,S0,S)), + sexpr_sterm_to_pterm_pre_list(TD,STERM0,STERM). + +sexpr_sterm_to_pterm(_TD,VAR,VAR):-is_ftVar(VAR),!. +sexpr_sterm_to_pterm(_TD,S,P):- is_exact_symbol(S,P),!. +sexpr_sterm_to_pterm(_TD,'#'(S),P):- is_exact_symbol(S,P),!. +sexpr_sterm_to_pterm(_TD,VAR,'$VAR'(Name)):- atom(VAR),svar(VAR,Name),!. + +% sexpr_sterm_to_pterm(TD,List,PTERM):- append(Left,[S,Name|TERM],List),maybe_var(S,Name,Var),!,append(Left,[Var|TERM],NewList), sexpr_sterm_to_pterm(TD,NewList,PTERM). +% sexpr_sterm_to_pterm(TD,[S|TERM],dot_holds(PTERM)):- \+ (is_list(TERM)),sexpr_sterm_to_pterm_list(TD,[S|TERM],PTERM),!. +%sexpr_sterm_to_pterm(TD,[S|TERM],PTERM):- \+ atom(S),sexpr_sterm_to_pterm_list(TD,[S|TERM],PTERM),!. +/* +sexpr_sterm_to_pterm(TD,[S,Vars|TERM],PTERM):- nonvar(S), + call_if_defined(common_logic_snark:is_quantifier(S)), + zalwayzz((sexpr_sterm_to_pterm_list(TD,TERM,PLIST), + PTERM=..[S,Vars|PLIST])),!. +*/ + +sexpr_sterm_to_pterm(TD,[S|STERM0],PTERM):- var(S), TD1 is TD + 1, sexpr_sterm_to_pterm_pre_list(TD1,STERM0,STERM), sexpr_sterm_to_pterm_list(TD1,STERM,PLIST),s_univ(TD,PTERM,[S|PLIST]),!. +sexpr_sterm_to_pterm(_,[S,STERM0],PTERM):- is_quoter(S),sexpr_sterm_to_pterm_pre_list(0,STERM0,STERM), !,PTERM=..[S,STERM],!. +sexpr_sterm_to_pterm(_,[S|STERM0],PTERM):- is_quoter(S),sexpr_sterm_to_pterm_pre_list(0,STERM0,STERM), !,PTERM=..[S,STERM],!. +sexpr_sterm_to_pterm(TD,[S|STERM0],PTERM):- sexpr_sterm_to_pterm_pre_list(TD,STERM0,STERM), is_list(STERM), + next_args_are_lists_unless_string(S,NonList), + length(LEFT,NonList),append(LEFT,[List|RIGHT],STERM),is_list(List), + TD1 is TD+1, + sexpr_sterm_to_pterm_list(TD1,LEFT,PLEFTLIST), + sexpr_sterm_to_pterm_list(0,RIGHT,PRIGHTLIST), + append(PLEFTLIST,[List|PRIGHTLIST],PLIST), + s_univ(TD,PTERM,[S|PLIST]),!. + +sexpr_sterm_to_pterm(TD,STERM0,PTERM):- TD1 is TD+1,sexpr_sterm_to_pterm_pre_list(TD,STERM0,STERM), + is_list(STERM),!, sexpr_sterm_to_pterm_list(TD1,STERM,PLIST),s_univ(TD,PTERM,PLIST),!. +sexpr_sterm_to_pterm(_TD,VAR,VAR). + +is_quoter('#BQ'):- is_common_lisp. +is_quoter('#COMMA'):- is_common_lisp. +is_quoter('quote'). + +next_args_are_lists_unless_string(defmacro,1). +next_args_are_lists_unless_string(defun,1). +next_args_are_lists_unless_string(let,0). +next_args_are_lists_unless_string('let*',0). + +%sexpr_sterm_to_pterm(TD,[S|TERM],PTERM):- (number(S); (atom(S),fail,atom_concat_or_rtrace(_,'Fn',S))),sexpr_sterm_to_pterm_list(TD,[S|TERM],PTERM),!. +%sexpr_sterm_to_pterm(TD,[S],O):- is_ftVar(S),sexpr_sterm_to_pterm(TD,S,Y),!,s_univ(TD,O,[Y]),!. +%sexpr_sterm_to_pterm(TD,[S],O):- nonvar(S),sexpr_sterm_to_pterm(TD,S,Y),!,s_univ(TD,O,[Y]),!. +%sexpr_sterm_to_pterm(TD,[S|TERM],PTERM):- is_ftVar(S), sexpr_sterm_to_pterm_list(TD,TERM,PLIST),s_univ(TD,PTERM,[t,S|PLIST]),!. +%sexpr_sterm_to_pterm(TD,[S|TERM],PTERM):- \+ atom(S), sexpr_sterm_to_pterm_list(TD,TERM,PLIST),s_univ(TD,PTERM,[t,S|PLIST]),!. +%sexpr_sterm_to_pterm(TD,[S|TERM],PTERM):- S==and,!,zalwayzz((maplist(sexpr_sterm_to_pterm,TERM,PLIST),list_to_conjuncts(',',PLIST,PTERM))). +% sexpr_sterm_to_pterm(TD,[S|TERM],PTERM):- is_va_relation(S),!,zalwayzz((maplist(sexpr_sterm_to_pterm,TERM,PLIST),list_to_conjuncts(S,PLIST,PTERM))). +%sexpr_sterm_to_pterm(TD,[S|TERM],PTERM):- is_relation_sexpr(S),zalwayzz((sexpr_sterm_to_pterm_list(TD,TERM,PLIST),PTERM=..[S|PLIST])),!. +%sexpr_sterm_to_pterm(TD,STERM,PTERM):- STERM=..[S|TERM],sexpr_sterm_to_pterm_list(TD,TERM,PLIST),s_univ(TD,PTERM,[S|PLIST]),!. + +s_functor(F):- \+ atom(F), !,fail. +s_functor(F):- \+ atom_concat('?',_,F). + +s_univ(1,S,S):-!. +s_univ(_TD,P,[F|ARGS]):- s_functor(F),is_list(ARGS),length(ARGS,A),l_arity(F,A),P=..[F|ARGS]. +s_univ(0,P,[F|ARGS]):- s_functor(F),is_list(ARGS),P=..[F|ARGS]. +s_univ(_TD,P,[F|ARGS]):- s_functor(F),is_list(ARGS),P=..[F|ARGS]. +s_univ(_TD,P,S):-P=S. + +l_arity(F,A):- clause_b(arity(F,A)). +l_arity(function,1). +l_arity(quote,1). +l_arity('#BQ',1):- is_common_lisp. +l_arity(F,A):-current_predicate(F/A). +l_arity(_,1). + +%% sexpr_sterm_to_pterm_list(TD, ?VAR, ?VAR) is det. +% +% S-expression Converted To Pterm List. +% + +sexpr_sterm_to_pterm_list(TD,TERM,PTERMO):- is_list(TERM),append(BEFORE,[VAR],TERM),atom(VAR), + atom_concat_or_rtrace('@',RVAR,VAR),non_empty_atom(RVAR),svar_fixvarname(RVAR,V),!,append(BEFORE,'$VAR'(V),PTERM), + sexpr_sterm_to_pterm_list0(TD,PTERM,PTERMO). +sexpr_sterm_to_pterm_list(TD,TERM,PTERM):- sexpr_sterm_to_pterm_list0(TD,TERM,PTERM). + +sexpr_sterm_to_pterm_list0(_,VAR,VAR):-is_ftVar(VAR),!. +sexpr_sterm_to_pterm_list0(_,[],[]):-!. +sexpr_sterm_to_pterm_list0(TD,[S|STERM],[P|PTERM]):-sexpr_sterm_to_pterm(TD,S,P),sexpr_sterm_to_pterm_list0(TD,STERM,PTERM),!. +sexpr_sterm_to_pterm_list0(_,VAR,VAR). + + +/*=================================================================== +% input_to_forms/3 does less consistancy checking then conv_to_sterm + +Always a S-Expression: 'WFFOut' placing variables in 'VARSOut' + +|?-input_to_forms(`(isa a b)`,Clause,Vars). +Clause = [isa,a,b] +Vars = _h70 + +| ?- input_to_forms(`(isa a (b))`,Clause,Vars). +Clause = [isa,a,[b]] +Vars = _h70 + +|?-input_to_forms(`(list a b )`,Clause,Vars) +Clause = [list,a,b] +Vars = _h70 + +?- input_to_forms_debug("(=> (isa ?NUMBER ImaginaryNumber) (exists (?REAL) (and (isa ?REAL RealNumber) (equal ?NUMBER (MultiplicationFn ?REAL (SquareRootFn -1))))))"). + +?- input_to_forms_debug("(=> (isa ?PROCESS DualObjectProcess) (exists (?OBJ1 ?OBJ2) (and (patient ?PROCESS ?OBJ1) (patient ?PROCESS ?OBJ2) (not (equal ?OBJ1 ?OBJ2)))))"). + + +| ?- input_to_forms(`(genlMt A ?B)`,Clause,Vars). +Clause = [genlMt,'A',_h998] +Vars = [=('B',_h998)|_h1101] + +| ?- input_to_forms(` + (goals Iran (not (exists (?CITIZEN) + (and (citizens Iran ?CITIZEN) (relationExistsInstance maleficiary ViolentAction ?CITIZEN)))))` + ). + +Clause = [goals,Iran,[not,[exists,[_h2866],[and,[citizens,Iran,_h2866],[relationExistsInstance,maleficiary,ViolentAction,_h2866]]]]] +Vars = [=(CITIZEN,_h2866)|_h3347] + +| ?- input_to_forms_debug(` +(queryTemplate-Reln QuestionTemplate definitionalDisplaySentence + (NLPatternList + (NLPattern-Exact "can you") + (RequireOne + (NLPattern-Word Acquaint-TheWord Verb) + (NLPattern-Word Tell-TheWord Verb)) + (RequireOne + (NLPattern-Exact "me with") + (NLPattern-Exact "me what")) + (OptionalOne + (WordSequence "the term") "a" "an") + (NLPattern-Template NPTemplate :THING) + (OptionalOne "is" ) + (OptionalOne TemplateQuestionMarkMarker)) + (definitionalDisplaySentence :THING ?SENTENCE)) ` +). + +| ?- input_to_forms_debug(` + (#$STemplate #$bioForProposal-short + (#$NLPatternList (#$NLPattern-Template #$NPTemplate :ARG1) + (#$NLPattern-Exact "short bio for use in proposals" ) (#$NLPattern-Word #$Be-TheWord #$Verb) + (#$NLPattern-Exact "") (#$NLPattern-Template #$NPTemplate :ARG2)) (#$bioForProposal-short :ARG1 :ARG2))` + ). + +input_to_forms_debug("(=> (disjointDecomposition ?CLASS @ROW) (forall (?ITEM1 ?ITEM2) (=> (and (inList ?ITEM1 (ListFn @ROW)) (inList ?ITEM2 (ListFn @ROW)) (not (equal ?ITEM1 ?ITEM2))) (disjoint ?ITEM1 ?ITEM2))))"). + + +input_to_forms_debug( +` + (#$STemplate #$bioForProposal-short + (#$NLPatternList (#$NLPattern-Template #$NPTemplate :ARG1) + (#$NLPattern-Exact "short bio for use in proposals" ) (#$NLPattern-Word #$Be-TheWord #$Verb) + (#$NLPattern-Exact "") (#$NLPattern-Template #$NPTemplate :ARG2)) (#$bioForProposal-short :ARG1 :ARG2)) ` + ). + +% txt_to_codes("(documentation Predicate EnglishLanguage \"A &%Predicate is a sentence-forming &%Relation. Each tuple in the &%Relation is a finite, ordered sequence of objects. The fact that a particular tuple is an element of a &%Predicate is denoted by '(*predicate* arg_1 arg_2 .. arg_n)', where the arg_i are the objects so related. In the case of &%BinaryPredicates, the fact can be read as `arg_1 is *predicate* arg_2' or `a *predicate* of arg_1 is arg_2'.\")",X). +input_to_forms_debug("(documentation Predicate EnglishLanguage \"A &%Predicate is a sentence-forming &%Relation. Each tuple in the &%Relation is a finite, ordered sequence of objects. The fact that a particular tuple is an element of a &%Predicate is denoted by '(*predicate* arg_1 arg_2 .. arg_n)', where the arg_i are the objects so related. In the case of &%BinaryPredicates, the fact can be read as `arg_1 is *predicate* arg_2' or `a *predicate* of arg_1 is arg_2'.\")",X,Y). + +// ==================================================================== */ +:- export(current_input_to_forms/2). + + +%% input_to_forms( ?FormsOut, ?Vars) is det. +% +% Input Converted To Forms. +% +current_input_to_forms(FormsOut,Vars):- + current_input(In), + input_to_forms(In, FormsOut,Vars). + +show_wff_debug(Wff,Vs):- nonvar(Wff),Wff=(H=B),!,show_wff_debug((H:-B),Vs). +show_wff_debug(Wff,Vs):- fmt("\n"), + must_or_rtrace(portray_clause_w_vars(Wff,Vs,[])),!. + +% input_to_forms_debug(String):- sumo_to_pdkb(String,Wff),dbginfo(Wff),!. +input_to_forms_debug(String):- + input_to_forms_debug(String,['=']). + +input_to_forms_debug(String,M:Decoders):- + setup_call_cleanup( + fmt("% ========================\n"), + (get_varnames(Was), show_wff_debug(input=String,Was), + input_to_forms(String,Wff,Vs), + b_setval('$variable_names',Vs), + show_wff_debug(to_forms=Wff,Vs), + do_decoders(Wff,Vs,M,Decoders),!, + ignore((nonvar(Vs),Vs\==[], show_wff_debug(vars=Vs,Vs)))), + fmt("\n% ========================\n")). + +do_decoders(_,_,_,[]):-!. +do_decoders(Wff,Vs,M,[Decoder|Decoders]):- !, + ((M:call(Decoder,Wff,WffO), ignore((Wff \== WffO , show_wff_debug((M:Decoder:-WffO),Vs)))) + -> do_decoders(WffO,Vs,M,Decoders) + ; + (fmt(decoder_failed(M:Decoder)), + do_decoders(Wff,Vs,M,Decoders))). +do_decoders(Wff,Vs,M,Decoder):- do_decoders(Wff,Vs,M,[Decoder]). + +:- export(input_to_forms/2). +%% input_to_forms( ?In, ?FormsOut) is det. +% +% Get Input Converted To Forms. +% +input_to_forms(Codes,FormsOut):- + input_to_forms(Codes,FormsOut,Vars) -> + add_variable_names(Vars). + +:- export(input_to_forms/3). + +%% input_to_forms( ?In, ?FormsOut, ?Vars) is det. +% +% Get Input Converted To Forms. +% +input_to_forms(Codes,FormsOut,Vars):- + push_varnames(_) -> + quietly_sreader((input_to_forms0(Codes,FormsOut,Vars))). + +is_variable_names_safe(Vars):- var(Vars),!. +is_variable_names_safe([N=V|Vars]):- !, + is_name_variable_safe(N,V) -> + is_variable_names_safe(Vars). +is_variable_names_safe([]). + +is_name_variable_safe(N,V):- + ok_var_name(N)-> var(V). + + +get_varnames(Was):- nb_current('$variable_names',Was)->true;Was=[]. + +push_varnames(New):- + (nonvar(New)-> b_setval('$variable_names',New) + ; (get_varnames(Was), Was = New, b_setval('$variable_names',Was))). + +add_variable_names(Vars):- var(Vars),!. +add_variable_names(N=V):- !, ignore(set_varname_s(N,V)). +add_variable_names([NV|Vars]):- add_variable_names(NV),!, add_variable_names(Vars). +add_variable_names([]). + +set_varname_s(N,V):- get_varnames(Was), set_varname4(Was,N,V,New),b_setval('$variable_names',New). + +set_varname4(Was,N,V,New):- member(NV,Was),NV=(NN=VV), NN==N,!, (V=VV->true;setarg(2,NV,V)), New = Was. +set_varname4(Was,N,V,New):- member(NV,Was),NV=(NN=VV), VV==V,!, (N=NN->true;setarg(1,NV,N)), New = Was. +set_varname4(Was,N,V,[N=V|Was]). + + +set_variable_names_safe(Vars):- + is_variable_names_safe(Vars)-> + b_setval('$variable_names',Vars); true. + +input_to_forms0(Codes,FormsOut,Vars):- + % is_openable(Codes),!, + parse_sexpr(Codes, Forms0),!, + once((to_untyped(Forms0, Forms1), + extract_lvars(Forms1,FormsOut,Vars))). + +input_to_forms0(Forms,FormsOut,Vars):- + (to_untyped(Forms, Forms1) -> + extract_lvars(Forms1,FormsOut,Vars)-> true),!. + + +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + Lisprolog -- Interpreter for a simple Lisp. Written in Prolog. + Written Nov. 26th, 2006 by Markus Triska (triska@gmx.at). + Public domain code. +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + +%:- style_check(-singleton). +%:- style_check(-discontiguous). +% :- style_check(-atom). +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + Parsing +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + + +tstl:- tstl('./ontologyportal_sumo/Merge.kif'), + tstl('./ontologyportal_sumo/Translations/relations-en.txt'), + tstl('./ontologyportal_sumo/english_format.kif'), + tstl('./ontologyportal_sumo/domainEnglishFormat.kif'), + tstl('./ontologyportal_sumo/Mid-level-ontology.kif'), + !. + +writeqnl(O):- writeq(O),nl. + + + +%:- fixup_exports. +%:- endif. + diff --git a/.Attic/canary_docme/metta_repl.pl b/.Attic/canary_docme/metta_repl.pl new file mode 100644 index 00000000000..20a48794b39 --- /dev/null +++ b/.Attic/canary_docme/metta_repl.pl @@ -0,0 +1,695 @@ +:- at_halt(save_history). + +history_file_location(Filename) :- expand_file_name('~/.config/metta/repl_history.txt',[Filename]). % for Linux, Windows might be different + +check_directory_exists(''). % Check all the terminating cases for the base of a directory tree. Might need more for Windows. +check_directory_exists('/'). +check_directory_exists('.'). +check_directory_exists('~'). +check_directory_exists('..'). +check_directory_exists(Dir) :- + file_directory_name(Dir,Parent), + check_directory_exists(Parent), + (exists_directory(Dir) -> true ; make_directory(Dir)). + +check_file_exists_for_append(HistoryFile) :- exists_file(HistoryFile),access_file(HistoryFile,append), !. +check_file_exists_for_append(HistoryFile) :- + file_directory_name(HistoryFile,Dir), + check_directory_exists(Dir), + open(HistoryFile,write,Stream,[create([read,write])]), !, + close(Stream). +check_file_exists_for_append(HistoryFile) :- write("Error opening history file: "),writeln(HistoryFile),halt(1). + +save_history :- + current_input(Input), + (((stream_property(Input, tty(true)))) -> ((history_file_location(HistoryFile),el_write_history(Input,HistoryFile))) ; true). + +load_and_trim_history:- + notrace(( + current_input(In), %catch(load_history,_,true), + ignore(install_readline(In)) )). + +%repl:- option_value('repl',prolog),!,prolog. +%:- ensure_loaded(metta_toplevel). + +%:- discontiguous do_metta_exec/3. + +%repl:- setup_call_cleanup(flag(repl_level,Was,Was+1),repl0, + % (flag(repl_level,_,Was),(Was==0 -> maybe_halt(7) ; true))). + +repl:- catch(repl2,end_of_input,true). + +repl1:- + with_option('doing_repl',true, + with_option(repl,true,repl2)). %catch((repeat, repl2, fail)'$aborted',true). +repl2:- + load_and_trim_history, + repeat, + %set_prolog_flag(gc,true), + reset_caches, + garbage_collect, + %set_prolog_flag(gc,false), + %with_option(not_a_reload,true,make), + ignore(catch((ignore(catch(once(repl3),restart_reading,true))), + give_up(Why),pp_m(red,gave_up(Why)))), + %set_prolog_flag(gc,true), + fail. + +write_metta_prompt:- + flush_output(current_output), + format('~Nmetta',[]), + current_read_mode(repl,Mode),write(Mode), + current_self(Self),(Self=='&self' -> true ; write(Self)), + write('>'),flush_output(current_output). + +repl3:- + with_output_to(atom(P),write_metta_prompt), + setup_call_cleanup( + notrace(prompt(Was,P)), + ((ttyflush,repl4,ttyflush)), + notrace(prompt(_,Was))). + +repl4:- + (( reset_eval_num, + write_answer_output, + %ignore(shell('stty sane ; stty echo')), + %current_input(In), + %if_trace(repl,fbug(repl_read(Mode,Expr))), + repl_read(Expr), + notrace(if_t((Expr==end_of_file;(is_win64,Expr=='')),throw(end_of_input))), + %ignore(shell('stty sane ; stty echo')), + ttyflush, + notrace(ignore(check_has_directive(Expr))), + current_self(Self), current_read_mode(repl,Mode), + nop(writeqln(repl_read(Expr))),!, + ignore(once((do_metta(repl_true,Mode,Self,Expr,O)))),!, + nop((write_src(O),nl)), + notrace(throw(restart_reading)))). + + + +check_has_directive(V):- var(V),!,fail. +check_has_directive('log.'):- switch_to_mettalog,!. +check_has_directive('rust.'):- switch_to_mettarust,!. +check_has_directive(Atom):- symbol(Atom),symbol_concat(_,'.',Atom),!. +check_has_directive(call(N=V)):- nonvar(N),!, set_directive(N,V). +check_has_directive(call(Rtrace)):- rtrace == Rtrace,!, rtrace,notrace(throw(restart_reading)). +check_has_directive(NEV):- symbol(NEV), symbolic_list_concat([N,V],'=',NEV), set_directive(N,V). +check_has_directive([AtEq,Value]):-symbol(AtEq),symbol_concat('@',Name,AtEq), set_directive(Name,Value). +check_has_directive(ModeChar):- symbol(ModeChar),metta_interp_mode(ModeChar,_Mode),!,set_directive(repl_mode,ModeChar). +check_has_directive('@'):- do_show_options_values,!,notrace(throw(restart_reading)). +check_has_directive(AtEq):-symbol(AtEq),symbol_concat('@',NEV,AtEq),option_value(NEV,Foo),fbug(NEV=Foo),!,notrace(throw(restart_reading)). +check_has_directive(_). + +set_directive(N,V):- symbol_concat('@',NN,N),!,set_directive(NN,V). +set_directive(N,V):- N=='mode',!,set_directive((repl_mode),V). +set_directive(N,V):- show_call(set_option_value_interp(N,V)),!,notrace(throw(restart_reading)). + +read_pending_white_codes(In):- + read_pending_codes(In,[10],[]),!. +read_pending_white_codes(_). + +call_for_term_variables4v(Term,[] ,as_tf(Term,TF),NamedVarsList,TF):- get_global_varnames(NamedVarsList),!. +call_for_term_variables4v(Term,[X] , Term, NamedVarsList,X):- get_global_varnames(NamedVarsList). + + + +% Check if parentheses are balanced in a list of characters +balanced_parentheses(Str):- string(Str), string_chars(Str,Chars),!,balanced_parentheses(Chars, 0). +balanced_parentheses(Chars) :- balanced_parentheses(Chars, 0). +balanced_parentheses([], 0). +balanced_parentheses(['('|T], N) :- N1 is N + 1, !, balanced_parentheses(T, N1). +balanced_parentheses([')'|T], N) :- N > 0, N1 is N - 1, !, balanced_parentheses(T, N1). +balanced_parentheses([H|T], N) :- H \= '(', H \= ')', !, balanced_parentheses(T, N). +% Recursive function to read lines until parentheses are balanced. + +repl_read(NewAccumulated, Expr):- + symbol_concat(Atom, '.', NewAccumulated), + catch_err((read_term_from_atom(Atom, Term, []), Expr=call(Term)), E, + (write('Syntax error: '), writeq(E), nl, repl_read(Expr))),!. + + +%repl_read(Str, Expr):- ((clause(t_l:s_reader_info(Expr),_,Ref),erase(Ref))). +repl_read("!", '!'):-!. +repl_read("+", '+'):-!. +repl_read(Str,Atom):- atom_string(Atom,Str),metta_interp_mode(Atom,_),!. + +repl_read(Str, Expr):- symbol_concat('@',_,Str),!,atom_string(Expr,Str). +repl_read(Str, _Expr):- symbol_concat(')',_,Str),!,fbug(repl_read_syntax(Str)),throw(restart_reading). +repl_read(NewAccumulated, Expr):- + normalize_space(string(Renew),NewAccumulated), + Renew \== NewAccumulated, !, + repl_read(Renew, Expr). +%repl_read(Str, 'add-atom'('&self',Expr)):- symbol_concat('+',W,Str),!,repl_read(W,Expr). +%repl_read(NewAccumulated,exec(Expr)):- string_concat("!",Renew,NewAccumulated), !, repl_read(Renew, Expr). +repl_read(NewAccumulated, Expr):- string_chars(NewAccumulated, Chars), + balanced_parentheses(Chars), length(Chars, Len), Len > 0, + read_metta(NewAccumulated,Expr), + normalize_space(string(Renew),NewAccumulated), + add_history_string(Renew). +repl_read(Accumulated, Expr) :- read_line_to_string(current_input, Line), repl_read(Accumulated, Line, Expr). + +repl_read(_, end_of_file, end_of_file):- writeln(""),throw(end_of_input). + +repl_read(Accumulated, "", Expr):- !, repl_read(Accumulated, Expr). +repl_read(_Accumulated, Line, Expr):- Line == end_of_file, !, Expr = Line. +repl_read(Accumulated, Line, Expr) :- symbolics_to_string([Accumulated," ",Line], NewAccumulated), !, + repl_read(NewAccumulated, Expr). + +repl_read(O2):- clause(t_l:s_reader_info(O2),_,Ref),erase(Ref). +repl_read(Expr) :- repeat, + remove_pending_buffer_codes(_,Was),text_to_string(Was,Str), + repl_read(Str, Expr), + % once(((symbol(Expr1),symbol_concat('@',_,Expr1), \+ atom_contains(Expr1,"="), repl_read(Expr2)) -> Expr=[Expr1,Expr2] ; Expr1 = Expr)), + % this cutrs the repeat/0 + ((peek_pending_codes(_,Peek),Peek==[])->!;true). + +add_history_string(Str):- current_input(Input),(((stream_property(Input, tty(true)))) -> ((notrace(ignore(el_add_history(Input,Str))))) ; true),!. + +add_history_src(Exec):- notrace(ignore((Exec\=[],with_output_to(string(H),with_indents(false,write_src(Exec))),add_history_string(H)))). + +add_history_pl(Exec):- var(Exec), !. +add_history_pl(eval(_,catch_red(PL),_)):- !,add_history_pl(PL). +add_history_pl(show_failure(PL)):-!,add_history_pl(PL). +add_history_pl(as_tf(PL,_OUT)):-!,add_history_pl(PL). +add_history_pl(Exec):- notrace(ignore((Exec\=[],with_output_to(string(H),with_indents(false,(writeq(Exec),writeln('.')))),add_history_string(H)))). + + +:- nb_setval(variable_names,[]). + + + + + %call_for_term_variables5(Term,[],as_tf(Term,TF),[],TF):- symbol(Term),!. +call_for_term_variables5(Term,[],[],[],as_tf(Term,TF),[],TF):- ground(Term),!. +call_for_term_variables5(Term,DC,[],[],call_nth(Term,TF),DC,TF):- ground(Term),!. +call_for_term_variables5(Term,_,[],[_=Var],call_nth(Term,Count),['Count'=Count],Var). +call_for_term_variables5(Term,_,[_=Var],[],call_nth(Term,Count),['Count'=Count],Var). +call_for_term_variables5(Term,_,Vars,[_=Var],Term,Vars,Var). +call_for_term_variables5(Term,_,[_=Var],Vars,Term,Vars,Var). +call_for_term_variables5(Term,_,SVars,Vars,call_nth(Term,Count),[Vars,SVars],Count). + + + +is_interactive(From):- notrace(is_interactive0(From)). +is_interactive0(From):- From==repl_true,!. +is_interactive0(From):- From==false,!,fail. +is_interactive0(From):- symbolic(From),is_stream(From),!, \+ stream_property(From,filename(_)). +is_interactive0(From):- From = true,!. + + +inside_assert(Var,Var):- \+ compound(Var),!. +inside_assert([H,IA,_],IA):- symbol(H),symbol_concat('assert',_,H),!. +inside_assert(Conz,Conz):- is_conz(Conz),!. +inside_assert(exec(I),O):- !, inside_assert(I,O). +inside_assert(Eval,O):- functor(Eval,eval_H,A), A1 is A-1, arg(A1,Eval,I),!, inside_assert(I,O). +%inside_assert(eval_H(I,C),eval_H(O,C)):- !, inside_assert(I,O). +%inside_assert(eval_H(A,B,I,C),eval_H(A,B,O,C)):- !, inside_assert(I,O). +inside_assert(call(I),O):- !, inside_assert(I,O). +inside_assert( ?-(I), O):- !, inside_assert(I,O). +inside_assert( :-(I), O):- !, inside_assert(I,O). +inside_assert(Var,Var). + +current_read_mode(repl,Mode):- ((option_value(repl_mode,Mode),Mode\==[])->true;Mode='+'),!. +current_read_mode(file,Mode):- ((nb_current(file_mode,Mode),Mode\==[])->true;Mode='+'). + + + +eval(all(Form)):- nonvar(Form), !, forall(eval(Form),true). +eval(Form):- current_self(Self), do_metta(true,exec,Self,Form,Out),write_src(Out). + +eval(Form,Out):- current_self(Self),eval(Self,Form,Out). +eval(Self,Form,Out):- eval_H(500,Self,Form,Out). + +eval_I(Self,Form,OOut):- + eval_H(500,Self,Form,Out), + trace, + xform_out(Out,OOut). + +xform_out(Out,OOut):- is_returned(Out),!,OOut=Out. +xform_out(_Out,'Empty'). + + +name_vars(P):- ignore(name_vars0(P)). +name_vars0(X=Y):- X==Y,!. +name_vars0(X='$VAR'(X)). + +reset_cache. +reset_caches:- forall(clause(reset_cache,Body),forall(rtrace_on_error(Body),true)). + +interactively_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut):- + reset_caches, + catch(interactively_do_metta_exec00(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut), + Error,write_src(error(Error,From,TermV))). + + +interactively_do_metta_exec00(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut):- + catch(interactively_do_metta_exec01(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut), + '$aborted',fbug(aborted(From,TermV))). + +% Interactively executes a mettalog command if certain conditions are met and hides results based on file settings. +interactively_do_metta_exec01(file(_), Self, _TermV, Term, X, _NamedVarsList, _Was, _Output, _FOut) :- + file_hides_results(Term), !, + eval_args(Self, Term, X). + +interactively_do_metta_exec01(From,Self,_TermV,Term,X,NamedVarsList,Was,VOutput,FOut):- + notrace(( + reset_eval_num, + Result = res(FOut), + Prev = prev_result('Empty'), + inside_assert(Term,BaseEval), + (is_compatio + -> option_else(answer,Leap,leap) + ; option_else(answer,Leap,each)), + option_else('maximum-result-count',MaxResults,inf), % infinate answers + option_else('initial-result-count',LeashResults,10), % if print the first 10 answers without stopping + Control = contrl(MaxResults,Leap), + Skipping = _, + % Initialize Control as a compound term with 'each' as its argument. + %GG = interact(['Result'=X|NamedVarsList],Term,trace_off), + (((From = file(_Filename), option_value('exec',skip), \+ always_exec(BaseEval))) + -> (GG = (skip(Term),deterministic(Complete)), + %Output = + %FOut = "Skipped", + Skipping = 1,!, + %color_g_mesg('#da70d6', (write('% SKIPPING: '), writeq(eval_H(500,Self,BaseEval,X)),writeln('.'))), + % color_g_mesg('#fa90f6', (writeln('; SKIPPING'), with_indents(true,write_src(exec(BaseEval))))), + % if_t(is_list(BaseEval),add_history_src(exec(TermV))), + true + ) + ; GG = %$ locally(set_prolog_flag(gc,false), + ( + (( (Term),deterministic(Complete), + xform_out(VOutput,Output), nb_setarg(1,Result,Output)))), + !, % metta_toplevel + flag(result_num,_,0), + PL=eval(Self,BaseEval,X), + ( % with_indents(true, + \+ \+ ( + user:maplist(name_vars,NamedVarsList), + user:name_vars('OUT'=X), + % add_history_src(exec(BaseEval)), + if_t(Skipping==1,writeln(' ; SKIPPING')), + %if_t(TermV\=BaseEval,color_g_mesg('#fa90f6', (write('; '), with_indents(false,write_src(exec(BaseEval)))))), + if_t((is_interactive(From);Skipping==1), + ( + if_t( \+ option_value(doing_repl,true), + if_t( \+ option_value(repl,true), + if_t( option_value(prolog,true), add_history_pl(PL)))), + if_t(option_value(repl,true), add_history_src(exec(BaseEval))))), + + prolog_only((color_g_mesg('#da70d6', (write('% DEBUG: '), writeq(PL),writeln('.'))))), + true))))), + + in_answer_io(format('~N[')),!, + + (forall_interactive( + From, WasInteractive,Complete, %may_rtrace + (timed_call(GG,Seconds)), + ((Complete==true->!;true), + %repeat, + set_option_value(interactive,WasInteractive), + Control = contrl(Max,DoLeap), + nb_setarg(1,Result,Output), + current_input(CI), + read_pending_codes(CI,_,[]), + flag(result_num,R,R+1), + flag(result_num,ResNum,ResNum), + reset_eval_num, + if_t(ResNum=(not_compatio(format('~NDeterministic: ', [])), !); %or Nondet + ( Complete==true -> (not_compatio(format('~NLast Result(~w): ',[ResNum])),! ); + not_compatio(format('~NNDet Result(~w): ',[ResNum]))))), + ignore((( + not_compatio(if_t( \+ symbolic(Output), nop(nl))), + %if_t(ResNum==1,in_answer_io(format('~N['))), + in_answer_io(if_t((Prev\=@=prev_result('Empty')),write(', '))), + nb_setarg(1,Prev,Output), + user_io(with_indents(is_mettalog, + color_g_mesg_ok(yellow, + \+ \+ + (maplist(maybe_assign,NamedVarsList), + not_compatio(write_asrc(Output)), + in_answer_io(write_asrc(Output)))))) ))), + + not_compatio(with_output_to(user_error,give_time('Execution',Seconds))), + %not_compatio(give_time('Execution',Seconds), + color_g_mesg(green, + ignore((NamedVarsList \=@= Was ->(not_compatio(( + reverse(NamedVarsList,NamedVarsListR), + maplist(print_var,NamedVarsListR), nop(nl)))) ; true))))), + ( + (Complete \== true, WasInteractive, DoLeap \== leap, + LeashResults > ResNum, ResNum < Max) -> + (write("~npress ';' for more solutions "),get_single_char_key(C), + not_compatio((writeq(key=C),nl)), + (C=='b' -> (once(repl),fail) ; + (C=='m' -> make ; + (C=='t' -> (nop(set_debug(eval,true)),rtrace) ; + (C=='T' -> (set_debug(eval,true)); + (C==';' -> true ; + (C==esc('[A',[27,91,65]) -> nb_setarg(2, Control, leap) ; + (C=='L' -> nb_setarg(1, Control, ResNum) ; + (C=='l' -> nb_setarg(2, Control, leap) ; + (((C=='\n');(C=='\r')) -> (!,fail); + (!,fail)))))))))))); + (Complete\==true, \+ WasInteractive, Control = contrl(Max,leap)) -> true ; + (((Complete==true ->! ; true))))) + *-> (ignore(Result = res(FOut)),ignore(Output = (FOut))) + ; (flag(result_num,ResNum,ResNum),(ResNum==0-> + (in_answer_io(nop(write('['))),not_compatio(format('~N~n~n')),!,true);true))), + in_answer_io(write(']\n')), + ignore(Result = res(FOut)). + +maybe_assign(N=V):- ignore(V='$VAR'(N)). + +mqd:- + forall(metta_atom(_KB,['query-info',E,T,Q]), + (writeln(E), + term_variables(T,TVs), + term_variables(Q,QVs), + intersection(TVs,QVs,_,_,SVs), + notrace(eval(['match','&flybase',Q,T],SVs)))). + + +get_single_char_key(O):- get_single_char(C),get_single_char_key(C,O). +get_single_char_key(27,esc(A,[27|O])):- !,current_input(Input),read_pending_codes(Input,O,[]),name(A,O). +get_single_char_key(C,A):- name(A,[C]). + +forall_interactive(file(_),false,Complete,Goal,After):- !, Goal, (Complete==true -> ( After,!) ; ( \+ After )). +forall_interactive(prolog,false,Complete,Goal,After):- !, Goal, (Complete == true -> ! ; true), quietly(After). +forall_interactive(From,WasInteractive,Complete,Goal,After):- + (is_interactive(From) -> WasInteractive = true ; WasInteractive = false),!, + Goal, (Complete==true -> ( quietly(After),!) ; ( quietly( \+ After) )). + + + +print_var(Name=Var) :- print_var(Name,Var). +write_var(V):- var(V), !, write_dvar(V),!. +write_var('$VAR'(S)):- !, write_dvar(S),!. +write_var(V):- write_dvar(V),!. +%print_var(Name,_Var) :- symbol_concat('Num',Rest,Name),atom_number(Rest,_),!. +print_var(Name,Var):- write_var(Name), write(' = '), write_bsrc(Var), nl. + +write_asrc(Var):- Var=='Empty',is_compatio,!. +write_asrc(Var):- write_bsrc(Var),!. + +write_bsrc(Var):- Var=='Empty',!,write(Var). +write_bsrc(Var):- ground(Var),!,write_src(Var). +write_bsrc(Var):- copy_term(Var,Copy,Goals),Var=Copy,write_bsrc(Var,Goals). +write_bsrc(Var,[]):- write_src(Var). +write_bsrc(Var,[G|Goals]):- write_src(Var), write(' { '),write_src(G),maplist(write_src_space,Goals),writeln(' } '). + +write_src_space(Goal):- write(' '),write_src(Goal). + + +get_term_variables(Term, DontCaresN, CSingletonsN, CNonSingletonsN) :- + term_variables(Term, AllVars), + get_global_varnames(VNs), + writeqln(term_variables(Term, AllVars)=VNs), + term_singletons(Term, Singletons), + term_dont_cares(Term, DontCares), + include(not_in_eq(Singletons), AllVars, NonSingletons), + include(not_in_eq(DontCares), NonSingletons, CNonSingletons), + include(not_in_eq(DontCares), Singletons, CSingletons), + maplist(into_named_vars,[DontCares, CSingletons, CNonSingletons], + [DontCaresN, CSingletonsN, CNonSingletonsN]), + writeqln([DontCaresN, CSingletonsN, CNonSingletonsN]). + +term_dont_cares(Term, DontCares):- + term_variables(Term, AllVars), + get_global_varnames(VNs), + include(has_sub_var(AllVars),VNs,HVNs), + include(underscore_vars,HVNs,DontCareNs), + maplist(arg(2),DontCareNs,DontCares). + +into_named_vars(Vars,L):- is_list(Vars), !, maplist(name_for_var_vn,Vars,L). +into_named_vars(Vars,L):- term_variables(Vars,VVs),!,into_named_vars(VVs,L). + +has_sub_var(AllVars,_=V):- sub_var(V,AllVars). +underscore_vars(V):- var(V),!,name_for_var(V,N),!,underscore_vars(N). +underscore_vars(N=_):- !, symbolic(N),!,underscore_vars(N). +underscore_vars(N):- symbolic(N),!,symbol_concat('_',_,N). + +get_global_varnames(VNs):- nb_current('variable_names',VNs),VNs\==[],!. +get_global_varnames(VNs):- prolog_load_context(variable_names,VNs),!. +maybe_set_var_names(List):- List==[],!. +maybe_set_var_names(List):- % fbug(maybe_set_var_names(List)), + is_list(List),!,nb_linkval(variable_names,List). +maybe_set_var_names(_). + +name_for_var_vn(V,N=V):- name_for_var(V,N). + +name_for_var(V,N):- var(V),!,get_global_varnames(VNs),member(N=VV,VNs),VV==V,!. +name_for_var(N=_,N):- !. +name_for_var(V,N):- term_to_atom(V,N),!. + + +really_trace:- once(option_value('exec',rtrace);option_value('eval',rtrace);is_debugging((exec)); + is_debugging((eval))). +% !(pragma! exec rtrace) +may_rtrace(Goal):- really_trace,!, really_rtrace(Goal). +may_rtrace(Goal):- Goal*->true;( \+ tracing, trace,really_rtrace(Goal)). +really_rtrace(Goal):- is_transpiling,!,rtrace(call(Goal)). +really_rtrace(Goal):- with_debug((e),with_debug((exec),Goal)). + +rtrace_on_existence_error(G):- !, catch_err(G,E, (fbug(E=G), \+ tracing, trace, rtrace(G))). +%rtrace_on_existence_error(G):- catch(G,error(existence_error(procedure,W),Where),rtrace(G)). + +%prolog_only(Goal):- !,Goal. +prolog_only(Goal):- if_trace(prolog,Goal). + +write_compiled_exec(Exec,Goal):- +% ignore(Res = '$VAR'('ExecRes')), + compile_for_exec(Res,Exec,Goal), + notrace((color_g_mesg('#114411',print_pl_source(answer2(Res):-Goal)))). + +verbose_unify(Term):- verbose_unify(trace,Term). +verbose_unify(What,Term):- term_variables(Term,Vars),maplist(verbose_unify0(What),Vars),!. +verbose_unify0(What,Var):- put_attr(Var,verbose_unify,What). +verbose_unify:attr_unify_hook(Attr, Value) :- + format('~N~q~n',[verbose_unify:attr_unify_hook(Attr, Value)]), + vu(Attr,Value). +vu(_Attr,Value):- is_ftVar(Value),!. +vu(fail,_Value):- !, fail. +vu(true,_Value):- !. +vu(trace,_Value):- trace. + + +% Entry point for the user to call with tracing enabled +toplevel_goal(Goal) :- + term_variables(Goal,Vars), + interact(Vars, Goal, trace_off). + +% Entry point for the user to call with tracing enabled +trace_goal(Goal) :- + trace_goal(Goal, trace_on). + +% Handle tracing +trace_goal(Goal, Tracing) :- + (Tracing == trace_on -> writeln('Entering goal:'), writeln(Goal) ; true), + term_variables(Goal, Variables), + ( call(Goal) -> + (Tracing == trace_on -> writeln('Goal succeeded with:'), writeln(Variables) ; true), + interact(Variables, Goal, Tracing) + ; (Tracing == trace_on -> writeln('Goal failed.') ; true), + false + ). + +% Interaction with the user +interact(Variables, Goal, Tracing) :- + call(Goal),write('Solution: '), write_src(Variables), + write(' [;next]?'), + get_single_char(Code), + (command(Code, Command) -> + handle_command(Command, Variables, Goal, Tracing) + ; writeln('Unknown command.'), interact(Variables, Goal, Tracing) % handle unknown commands + ). + + +:- dynamic(is_installed_readline_editline/1). +:- volatile(is_installed_readline_editline/1). +install_readline_editline:- current_input(Input), install_readline(Input),!. + +% Write our own el_wrap rather than using the default one as do not want all the prolog completions. +% Can add mettalog completions later using add_prolog_commands/1 of swi_prolog:packages/libedit/editline.pl as template +el_wrap_metta(Input) :- + el_wrapped(Input), + !. +el_wrap_metta(Input) :- + stream_property(Input, tty(true)), !, + editline:el_wrap(swipl, Input, user_output, user_error), + add_metta_commands(Input), + forall(editline:el_setup(Input), true). +el_wrap_metta(_NoTTY). % For non-tty(true) clients over SWISH/Http/Rest server + +add_metta_commands(Input) :- + % TODO: It be nice for completion on file names but not prolog atoms + %editline:el_addfn(Input,complete,'Complete atoms and files',editline:complete), + %editline:el_addfn(Input,show_completions,'List completions',editline:show_completions), + editline:el_addfn(Input, electric, 'Indicate matching bracket', editline:electric), + editline:el_addfn(Input, isearch_history, 'Incremental search in history', editline:isearch_history), + %editline:el_bind(Input,["^I",complete]), + %editline:el_bind(Input,["^[?",show_completions]), + editline:el_bind(Input, ["^R", isearch_history]), + editline:bind_electric(Input), + editline:el_source(Input, _). + +install_readline(Input):- is_installed_readline_editline(Input),!. +%install_readline(_):- is_compatio,!. +install_readline(Input):- stream_property(Input,tty(true)), + assert(is_installed_readline_editline(Input)), + install_readline_editline1, + %use_module(library(readline)), + use_module(library(editline)), + %nop(catch(load_history,_,true)), + ignore(el_unwrap(Input)), % unwrap the prolog wrapper so we can use our own. + ignore(el_wrap_metta(Input)), + history_file_location(HistoryFile), + check_file_exists_for_append(HistoryFile), + el_read_history(Input,HistoryFile), + %add_history_string("!(load-flybase-full)"), + %add_history_string("!(pfb3)"), + %add_history_string("!(obo-alt-id $X BS:00063)"), + %add_history_string("!(and (total-rows $T TR$) (unique-values $T2 $Col $TR))"), + !. +install_readline(_NoTTY). % For non-tty(true) clients over SWISH/Http/Rest server + +:- dynamic setup_done/0. +:- volatile setup_done/0. + +install_readline_editline1 :- + setup_done, + !. +install_readline_editline1 :- + asserta(setup_done). +% Most all of these were overkill +% '$toplevel':( +% '$clean_history', +% apple_setup_app, +% '$run_initialization', +% '$load_system_init_file', +% set_toplevel, +% '$set_file_search_paths', +% init_debug_flags, +% start_pldoc, +% opt_attach_packs, +% load_init_file, +% catch(setup_backtrace, E1, print_message(warning, E1)), +% %catch(setup_readline, E2, print_message(warning, E2)), +% %catch(setup_history, E3, print_message(warning, E3)), +% catch(setup_colors, E4, print_message(warning, E4))), +% install_readline(Input). + + +% Command descriptions +command(59, retry). % ';' to retry +command(115, skip). % 's' to skip to the next solution +command(108, leap). % 'l' to leap (end the debugging session) +command(103, goals). % 'g' to show current goals +command(102, fail). % 'f' to force fail +command(116, trace). % 't' to toggle tracing +command(117, up). % 'u' to continue without interruption +command(101, exit). % 'e' to exit the debugger +command(97, abort). % 'a' to abort +command(98, break). % 'b' to set a breakpoint +command(99, creep). % 'c' to proceed step by step +command(104, help). % 'h' for help +command(65, alternatives). % 'A' for alternatives +command(109, make). % 'm' for make (recompile) +command(67, compile). % 'C' for Compile (compile new executable) + +:- style_check(-singleton). + +% Command implementations +handle_command(make, Variables, Goal, Tracing) :- + writeln('Recompiling...'), + % Insert the logic to recompile the code. + % This might involve calling `make/0` or similar. + make, % This is assuming your Prolog environment has a `make` predicate. + fail. % interact(Variables, Goal, Tracing). + +handle_command(compile, Variables, Goal, Tracing) :- + writeln('Compiling new executable...'), + % Insert the logic to compile a new executable. + % This will depend on how you compile Prolog programs in your environment. + % For example, you might use `qsave_program/2` to create an executable. + % Pseudocode: compile_executable(ExecutableName) + fail. % interact(Variables, Goal, Tracing). +handle_command(alternatives, Variables, Goal, Tracing) :- + writeln('Showing alternatives...'), + % Here you would include the logic for displaying the alternatives. + % For example, showing other clauses that could be tried for the current goal. + writeln('Alternatives for current goal:'), + writeln(Goal), + % Pseudocode: find_alternatives(Goal, Alternatives) + % Pseudocode: print_alternatives(Alternatives) + fail. % interact(Variables, Goal, Tracing). +% Extend the command handling with the 'help' command implementation +handle_command(help, Variables, Goal, Tracing) :- + print_help, + fail. % interact(Variables, Goal, Tracing). +handle_command(abort, _, _, _) :- + writeln('Aborting...'), abort. +handle_command(break, Variables, Goal, Tracing) :- + writeln('Breakpoint set.'), % Here you should define what 'setting a breakpoint' means in your context + fail. % interact(Variables, Goal, Tracing). +handle_command(creep, Variables, Goal, Tracing) :- + writeln('Creeping...'), % Here you should define how to 'creep' (step by step execution) through the code + trace. % interact(Variables, Goal, Tracing). +handle_command(retry, Variables, Goal, Tracing) :- + writeln('Continuing...'),!. + %trace_goal(Goal, Tracing). +handle_command(skip, Variables, Goal, Tracing) :- + writeln('Skipping...'). +handle_command(leap, _, _, _) :- + writeln('Leaping...'), nontrace. % Cut to ensure we stop the debugger +handle_command(goals, Variables, Goal, Tracing) :- + writeln('Current goal:'), writeln(Goal), + writeln('Current variables:'), writeln(Variables), + bt,fail. % interact(Variables, Goal, Tracing). +handle_command(fail, _, _, _) :- + writeln('Forcing failure...'), fail. +handle_command(trace, Variables, Goal, Tracing) :- + (Tracing == trace_on -> + NewTracing = trace_off, writeln('Tracing disabled.') + ; NewTracing = trace_on, writeln('Tracing enabled.') + ), + interact(Variables, Goal, NewTracing). +handle_command(up, Variables, Goal, Tracing) :- + writeln('Continuing up...'), + repeat, + ( trace_goal(Goal, Tracing) -> true ; !, fail ). +handle_command(exit, _, _, _) :- + writeln('Exiting debugger...'), !. % Cut to ensure we exit the debugger + +:- style_check(+singleton). + + +% Help description +print_help :- + writeln('Debugger commands:'), + writeln('(;) next - Retry with next solution.'), + writeln('(g) goal - Show the current goal.'), + writeln('(u) up - Finish this goal without interruption.'), + writeln('(s) skip - Skip to the next solution.'), + writeln('(c) creep or - Proceed step by step.'), + writeln('(l) leap - Leap over (the debugging).'), + writeln('(f) fail - Force the current goal to fail.'), + writeln('(B) back - Go back to the previous step.'), + writeln('(t) trace - Toggle tracing on or off.'), + writeln('(e) exit - Exit the debugger.'), + writeln('(a) abort - Abort the current operation.'), + writeln('(b) break - Break to a new sub-REPL.'), + writeln('(h) help - Display this help message.'), + writeln('(A) alternatives - Show alternative solutions.'), + writeln('(m) make - Recompile/Update the current running code.'), + writeln('(C) compile - Compile a fresh executable (based on the running state).'), + writeln('(E) error msg - Show the latest error messages.'), + writeln('(r) retry - Retry the previous command.'), + writeln('(I) info - Show information about the current state.'), + !. + + + + diff --git a/.Attic/canary_docme/metta_server.pl b/.Attic/canary_docme/metta_server.pl new file mode 100644 index 00000000000..bfa1233315b --- /dev/null +++ b/.Attic/canary_docme/metta_server.pl @@ -0,0 +1,536 @@ +/* + * 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. + */ +% Load the socket and thread libraries for networking and concurrency +:- use_module(library(socket)). % Provides predicates for socket operations +:- use_module(library(thread)). % Provides predicates for multi-threading + +% Predicate to execute a goal and determine if it was deterministic +%! call_wdet(+Goal, -WasDet) is semidet. +% +% Calls the given Goal and checks if it was deterministic. +% +% @arg Goal is the goal to execute. +% @arg WasDet is true if the Goal was deterministic, false otherwise. +call_wdet(Goal,WasDet):- + % Execute the provided Goal + call(Goal), + % Check if the goal was deterministic and unify the result with WasDet + deterministic(WasDet). + +% Helper to parse Server and Port from Peer, using a DefaultPort if needed +%! parse_service_port(+Peer, +DefaultPort, -Server, -Port) is det. +% +% Parses the service and port from Peer input. Defaults to localhost +% and DefaultPort if not specified. +% +% @arg Peer is the input that could be in the form of Server:Port or just a Port. +% @arg DefaultPort is the port to use if Peer does not specify it. +% @arg Server is the output server address. +% @arg Port is the output port number. +parse_service_port(Peer,DefaultPort, Server, Port) :- + % Check if Peer is in the form Server:Port + ( Peer = Server:Port -> true + ; % If Peer is an integer, assume it's a port with localhost as the server + integer(Peer) -> Server = localhost, Port = Peer + ; % Otherwise, use Peer as the server and DefaultPort as the port + Server = Peer, Port = DefaultPort + ). + +% Predicate to check if a service is running under a specific alias +%! service_running(+Alias) is semidet. +% +% Checks if a thread with the given Alias is currently running. +% +% @arg Alias is the alias of the thread to check. +service_running(Alias):- + % Get the properties of the thread VSS and check if its status is running + thread_property(VSS,TS), + VSS = Alias, + TS = status(running), + !. + +% Start the interpreter service using the current self (MSpace) +%! start_vspace_service(+Port) is det. +% +% Starts the VSpace service on the specified Port, using the current self as MSpace. +% +% @arg Port is the port number on which the service will be started. +start_vspace_service(Port):- +%Getthecurrentself(MSpace) + current_self(MSpace), + % Start the VSpace service with the current MSpace and specified Port + start_vspace_service(MSpace,Port). + +% Start the VSpace service with a specific alias, MSpace, and Port +%! start_vspace_service(+Alias, +MSpace, +Port) is det. +% +% Starts the VSpace service with a specified Alias, MSpace, and Port. +% +% @arg Alias is the alias to assign to the service thread. +% @arg MSpace is the memory space in which the service will operate. +% @arg Port is the port number on which the service will be started. +start_vspace_service(MSpace,Port):- + % Concatenate 'vspace_service', MSpace, and Port into an Alias string + symbolic_list_concat([vspace_service,MSpace,Port],'_',Alias), + % Start the VSpace service with the generated Alias, MSpace, and Port + start_vspace_service(Alias,MSpace,Port). + +% Skip starting the service if it is already running +%! start_vspace_service(+Alias, +_Space, +_Port) is det. +% +% Starts the VSpace service only if it is not already running under the given Alias. +% +% @arg Alias is the alias to check for an existing service. +start_vspace_service(Alias,_Space,_Port):- + % If the service is already running under Alias, do nothing + service_running(Alias), + !. + +% Create a new thread to run the VSpace service if not already running +start_vspace_service(Alias,MSpace,Port):- + % Create a new thread to run the VSpace service with the given MSpace and Port + thread_create(run_vspace_service(MSpace,Port),_,[detached(true),alias(Alias)]). + +% Predicate to handle the situation when a port is already in use +%! handle_port_in_use(+MSpace, +Port) is det. +% +% Handles the error when the specified Port is already in use by trying another port. +% +% @arg MSpace is the memory space in which the service operates. +% @arg Port is the port number that is in use. +handle_port_in_use(MSpace,Port):- + % Record that the port was in use for MSpace + assert(was_vspace_port_in_use(MSpace,Port)), + % Try starting the service on Port + 100 + Port100 is Port +100, + run_vspace_service(MSpace,Port100). + + +% Run the VSpace service, handling the case where the port is already in use +%! run_vspace_service(+MSpace, +Port) is det. +% +% Runs the VSpace service on the specified Port, retrying on a different port if necessary. +% +% @arg MSpace is the memory space in which the service operates. +% @arg Port is the port number on which the service will be started. +run_vspace_service(MSpace,Port):- + % Attempt to run the service, catching the error if the port is in use + catch( + run_vspace_service_unsafe(MSpace,Port), + error(socket_error(eaddrinuse,_),_), + % If the port is in use, handle the situation + handle_port_in_use(MSpace, Port) + ). + +% Unsafe version of running the VSpace service that doesn't handle errors +%! run_vspace_service_unsafe(+MSpace, +Port) is det. +% +% Unsafe version of running the VSpace service on the specified Port. +% This version does not handle errors related to the port being in use. +% +% @arg MSpace is the memory space in which the service operates. +% @arg Port is the port number on which the service will be started. +run_vspace_service_unsafe(MSpace,Port) :- + % Create a TCP socket + tcp_socket(Socket), + % Bind the socket to the specified port + tcp_bind(Socket, Port), + % Listen on the socket with a backlog of 5 connections + tcp_listen(Socket, 5), + % Open the socket for listening + tcp_open_socket(Socket, ListenFd), + % Perform any compatibility checks (not_compatio is assumed to be a custom predicate) + not_compatio(fbugio(run_vspace_service(MSpace,Port))), + % Remove any existing vspace_port facts + retractall(vspace_port(_)), + % Assert the current port as the vspace_port + assert(vspace_port(Port)), + % Start accepting connections on the listening socket + accept_vspace_connections(MSpace,ListenFd). + +% Accept connections to the VSpace service and create a thread for each connection +%! accept_vspace_connections(+MSpace, +ListenFd) is det. +% +% Accepts incoming connections to the VSpace service and creates a thread for each connection. +% +% @arg MSpace is the memory space in which the service operates. +% @arg ListenFd is the file descriptor for the listening socket. +accept_vspace_connections(MSpace,ListenFd) :- + % Accept an incoming connection, returning a file descriptor and remote address + tcp_accept(ListenFd, RemoteFd, RemoteAddr), + % Set the current memory space for the thread + nb_setval(self_space,MSpace), + % Create a unique thread alias based on the remote address and file descriptor + format(atom(ThreadAlias0), 'peer_~w_~w_~w_', [RemoteAddr,RemoteFd,MSpace]), + % Generate a unique symbol for the thread alias + gensym(ThreadAlias0,ThreadAlias), + % Create a new thread to handle the connection + thread_create( + setup_call_cleanup( + % Open the socket as a stream + tcp_open_socket(RemoteFd, Stream), + % Handle the connection by processing incoming goals + ignore(handle_vspace_peer(Stream)), + % Ensure the stream is closed when done + catch(close(Stream),_,true) + ), + _, + [detached(true), alias(ThreadAlias)] + ), + % Continue accepting more connections + accept_vspace_connections(MSpace,ListenFd). + +% Handle a peer connection by receiving and processing goals +%! handle_vspace_peer(+Stream) is det. +% +% Handles a peer connection by receiving and executing goals sent over the Stream. +% +% @arg Stream is the input/output stream connected to the peer. +handle_vspace_peer(Stream) :- + % Receive a Prolog term (goal) from the stream + recv_term(Stream, Goal), + % If the received term is not the end of file + ( Goal \= end_of_file + -> ( catch(call_wdet(Goal,WasDet), Error, true) + *-> ( var(Error) -> send_term(Stream, success(Goal,WasDet)) ; send_term(Stream,error(Error))) + ;send_term(Stream, 'failed'))), + handle_vspace_peer(Stream). + +any_to_i(A,I):- integer(A),I=A. +any_to_i(A,I):- format(atom(Ay),'~w',[A]),atom_number(Ay,I). +% Start the service automatically on a default port or a specified port +:- dynamic vspace_port/1. +get_vspace_port(Port):- current_prolog_flag('argv',L),member(AA,L),atom_concat('--service=',P,AA),atom_number(P,Port),!,set_prolog_flag('port',Port). +get_vspace_port(Port):- current_prolog_flag('port',P),any_to_i(P,Port),!. +get_vspace_port(Port):- vspace_port(Port),!. +get_vspace_port(Port):- Port = 3023. +start_vspace_service:- is_compiling,!. +start_vspace_service:- get_vspace_port(Port), start_vspace_service(Port),!. + + + + + + +% Helper to establish a connection to the VSpace service +%! connect_to_service(+HostPort, -Stream) is det. +% +% Connects to the VSpace service on the specified Host and Port and returns the Stream. +% +% @arg HostPort is the Host:Port combination or just a port number. +% @arg Stream is the output stream connected to the service. +connect_to_service(HostPort, Stream) :- + % Parse the Host and Port from the input HostPort + parse_service_port(HostPort, 3023, Host, Port), + % Create a TCP socket + tcp_socket(Socket), + % Connect the socket to the specified Host and Port + tcp_connect(Socket, Host:Port), + % Open the socket as a stream for communication + tcp_open_socket(Socket, Stream). + +% Helper to send a Prolog term and receive a response +%! send_term(+Stream, +MeTTa) is det. +% +% Sends a Prolog term (MeTTa) over the Stream. +% +% @arg Stream is the output stream to send the term through. +% @arg MeTTa is the Prolog term to send. +send_term(Stream, MeTTa) :- + % Write the term in canonical form to the stream + write_canonical(Stream, MeTTa), + % Write a period to indicate the end of the term + writeln(Stream, '.'), + % Flush the output to ensure the term is sent immediately + flush_output(Stream). + +recv_term(Stream, MeTTa) :- read_term(Stream, MeTTa, []). + + +% Read and process the service's response +read_response(Stream,Goal) :- + flush_output(Stream), + repeat, recv_term(Stream,Response), + (Response == failed -> (!,fail) ; + (Response = error(Throw) -> throw(Throw) ; + ((Response = success(Goal,WasDet)), + (WasDet==true-> (!, true) ; true)))). + +% Connects to the service and sends the goal +% ?- remote_call('localhost', member(X, [1,2,3])). +remote_call(Peer, Goal) :- + setup_call_cleanup( + (connect_to_service(Peer, Stream),send_term(Stream, Goal)), + read_response(Stream,Goal), + close(Stream)). + +remote_eval(Peer, MeTTa, Result) :- + remote_call(Peer, eval(MeTTa,Result)). + +/* +;; Example usage (from MeTTa) + +metta> !(remote-eval! localhost (add-atom &self (A b b))) +metta> !(remote-eval! localhost (add-atom &self (A b c))) +metta> !(remote-eval! localhost (match &self $Code $Code)) + +*/ + +% Declare remote_code/4 as a dynamic predicate to allow runtime modification +:- dynamic remote_code/4. % Maps MeTTa-Space and function to Service address + +% Get the current address of the service (Host:Port) +%! our_address(-HostPort) is det. +% +% Retrieves the current Host and Port of this service instance. +% +% @arg HostPort is the output in the form Host:Port. +our_address(Host:Port):- + % Get the hostname of the current machine + gethostname(Host), + % Retrieve the port number currently in use by this service + vspace_port(Port). + +% Check if this service instance exists at a given address +%! we_exist(+Addr) is det. +% +% Determines if the current service instance exists at the specified Addr. +% +% @arg Addr is the address to check (Host:Port). +we_exist(Addr):- + % Get the current address and unify it with Addr + our_address(Addr). + +% Check if another service exists at the specified address +%! they_exist(+Addr) is det. +% +% Determines if another service exists at the specified Addr. +% +% @arg Addr is the address to check (Host:Port). +they_exist(Addr):- + % Get the current service address + our_address(Ours), + % Ensure Addr is different from the current service address + diff(Addr,Ours), + execute_goal(we_exist(Addr)), \+ our_address(Addr). + +% tell the services that took our place about us. +register_ready:- + our_address(Ours), + forall(was_vspace_port_in_use(MSpace,Port), + remote_call(Port,register_remote_code(MSpace,we_exist(_),true,Ours))). + +% before we terminate we should call this +:- at_halt(register_gone). +register_gone:- \+ service_running(_),!. +register_gone:- + ignore(( + fail, + our_address(Ours), + forall(they_exist(Addr), + remote_call(Addr,unregister_peer(Ours))))). + +unregister_peer(Who):- + forall(remote_code(MSpace,EntryPoint, _, Who), + unregister_remote_code(MSpace,EntryPoint,Who)). + +% Registers a predicate to a service +register_remote_code(MSpace,EntryPoint, NonDet, Server) :- + unregister_remote_code(MSpace,EntryPoint, Server), + assertz(remote_code(MSpace,EntryPoint, NonDet, Server)). +unregister_remote_code(MSpace,EntryPoint, Server) :- + retractall(remote_code(MSpace,EntryPoint, _, Server)). + +% Execute a goal in the current memory space +%! execute_goal(+Goal) is det. +% +% Executes the specified goal in the current memory space. +% +% @arg Goal is the goal to execute. +execute_goal(Goal):- + % Get the current memory space (MSpace) + current_self(MSpace), + % Execute the goal in the current memory space and determine if it was deterministic + execute_goal(MSpace,Goal, IsDet), + % If the goal was deterministic, cut to prevent backtracking + (was_t(IsDet) -> ! ; true). + +% Always succeed if the goal is 'true' +execute_goal(_Self,true, _) :- !. +% Meta-interpreter with cut handling +%! execute_goal(+MSpace, +Goal, -IsDet) is det. +% +% Executes the specified goal within the given memory space, handling cuts and determinism. +% +% @arg MSpace is the memory space in which the goal will be executed. +% @arg Goal is the goal to execute. +% @arg IsDet is true if the goal was deterministic. +execute_goal(MSpace,Goal, IsDet) :- + remote_code(MSpace,Goal, NonDet, Peer), + % If the goal is registered for a service, call remotely + (was_t(NonDet) -> true ; !), + remote_call(Peer, execute_goal(MSpace,Goal,IsDet)). + +execute_goal(_Self,!, IsDet) :- !, IsDet = true. % Handle cuts +execute_goal(_Self,fail, IsDet) :- !, + (was_t(IsDet)->throw(cut_fail); fail). +execute_goal(MSpace,Goal, _) :- + predicate_property(Goal,number_of_clauses(_)),!, + clause(Goal, Body), % Retrieve the clause body for the goal + catch(execute_goal(MSpace,Body, IsDet),cut_fail,(!,fail)), + (was_t(IsDet)-> !; true). +execute_goal(MSpace,call(Cond), _ ) :- !, execute_goal(MSpace,Cond, IsDet), (was_t(IsDet)->!;true). +execute_goal(MSpace,(Cond, Then), IsDet) :- !, execute_goal(MSpace,Cond, IsDet), execute_goal(MSpace,Then, IsDet). +execute_goal(MSpace,(Cond; Else), IsDet) :- !, (execute_goal(MSpace,Cond, IsDet); execute_goal(MSpace,Else, IsDet)). +execute_goal(MSpace,(Cond *-> Then; Else), IsDet) :- !, (execute_goal(MSpace,Cond, IsDet) *-> execute_goal(MSpace,Then, IsDet) ; execute_goal(MSpace,Else, IsDet)). +execute_goal(MSpace,(Cond *-> Then), IsDet) :- !, (execute_goal(MSpace,Cond, IsDet) *-> execute_goal(MSpace,Then, IsDet)). +execute_goal(MSpace,(Cond -> Then; Else), IsDet) :- !, (execute_goal(MSpace,Cond, IsDet) -> execute_goal(MSpace,Then, IsDet) ; execute_goal(MSpace,Else, IsDet)). +execute_goal(MSpace,(Cond -> Then), IsDet) :- !, (execute_goal(MSpace,Cond, IsDet) -> execute_goal(MSpace,Then, IsDet)). +execute_goal(MSpace,catch(X, E, Z), IsDet) :- !, catch(execute_goal(MSpace,X, IsDet) , E, execute_goal(MSpace,Z, _)). +execute_goal(MSpace,findall(X, Y, Z), _) :- !, findall(X, execute_goal(MSpace,Y, _), Z). +execute_goal(MSpace,forall(X, Y), _) :- !, forall(execute_goal(MSpace,X, _), execute_goal(MSpace,Y, _)). +execute_goal(_Self,SubGoal, _IsCut) :- call_wdet(SubGoal, WasDet), (was_t(WasDet)->!;true). + +was_t(T):- T == true. + + +ccml_nth:attr_unify_hook(_Nth,_Var). + +metta_hyperpose_v0(P2, InList, OutList) :- + current_prolog_flag(cpu_count,Count), + length(InList,Len), length(OutList,Len), + max_min(Count,Len,_,Procs), + findall(thread(Goal, OutputVar), + (nth1(N, InList, InputVar), Goal = call(P2, InputVar, OutputVar), put_attr(OutputVar,ccml_nth,N)), + GoalsWithOutputs), + separate_goals_and_outputs(GoalsWithOutputs, Goals, OutList), + concurrent(Procs, Goals, []). + +separate_goals_and_outputs([], [], []). +separate_goals_and_outputs([thread(Goal, OutputVar)|GoalsWithOutputs], [Goal|Goals], [OutputVar|Outputs]) :- + separate_goals_and_outputs(GoalsWithOutputs, Goals, Outputs). + + + + + +%:- use_module(library(concurrent)). + +% Meta predicate that combines concurrent processing and result gathering +metta_concurrent_maplist(P2, InList, OutList) :- InList=[_,_|_],!, % only use extra threads iof 2 or more + setup_call_cleanup( + concurrent_assert_result(P2, InList, Tag), + gather_results_in_order(Tag, InList, OutList), + cleanup_results(Tag)). +metta_concurrent_maplist(P2, InList, OutList):- maplist(P2, InList, OutList). + +% Meta predicate that combines concurrent processing and result gathering +metta_hyperpose(Eq,RetType,Depth,MSpace,InList,Res) :- fail, InList=[_,_|_],!, % only use extra threads iof 2 or more + setup_call_cleanup( + concurrent_assert_result(eval_20(Eq,RetType,Depth,MSpace), InList, Tag), + each_result_in_order(Tag, InList, Res), + cleanup_results(Tag)). +metta_hyperpose(Eq,RetType,Depth,MSpace,ArgL,Res):- eval_20(Eq,RetType,Depth,MSpace,['superpose',ArgL],Res). + + +% Concurrently applies P2 to each element of InList, results are tagged with a unique identifier +concurrent_assert_result(P2, InList, Tag) :- + current_prolog_flag(cpu_count,Count), + length(InList,Len), max_min(Count,Len,_,Procs), + gensym(counter, Tag), % Generate a unique identifier + concurrent_forall( nth1(Index, InList, InputVar),assert_result_after_computation(P2, Tag, Index, InputVar), [threads(Procs)]). + %findall(assert_result_after_computation(P2, Tag, Index, InputVar), nth1(Index, InList, InputVar), Goals), + %concurrent(Procs, Goals, []). + +% Asserts the output of applying P2 to Input +assert_result_after_computation(P2, Tag, Index, Input) :- + catch( + (call(P2, Input, Output)*-> assert(result(Tag, Index, Input, Output)) ; assert(result(Tag, Index, Input, failed(Tag)))), + E, (assert(result(Tag, Index, Input, error(E))))). + + +% Gathers results in order, matching them with the corresponding inputs +gather_results_in_order(Tag, InList, OrderedResults) :- + gather_results_in_order(Tag, InList, 0, OrderedResults). + +use_result( IInput, RResult, Input, Result):- var(RResult),!,IInput=Input,Result=RResult. +use_result( IInput, error(E), Input, _Result):- ignore(IInput=Input),!, throw(E). +use_result( IInput, failed(_), Input, _Result):- ignore(IInput=Input),!,fail. +use_result( IInput, RResult, Input, Result):- IInput=Input,Result=RResult. + +gather_results_in_order(_, [], _, []). +gather_results_in_order(Tag, [Input|RestInputs], Index, [Result|OrderedResults]) :- + ( result(Tag, Index, IInput, RResult) + *-> (use_result( IInput, RResult, Input, Result),NextIndex is Index + 1,gather_results_in_order(Tag, RestInputs, NextIndex, OrderedResults)) + ; % Wait for 75 milliseconds before retrying + ( sleep(0.075), gather_results_in_order(Tag, [Input|RestInputs], Index, [Result|OrderedResults]))). + + +each_result_in_order(Tag, InList, OrderedResults) :- + each_result_in_order(Tag, InList, 0, OrderedResults). +each_result_in_order(_, [], _,_):-!,fail. +each_result_in_order(Tag, [Input|RestInputs], Index,Result) :- + ( result(Tag, Index, IInput, RResult) + *-> (use_result( IInput, RResult, Input, Result); + (NextIndex is Index + 1,each_result_in_order(Tag, RestInputs, NextIndex, Result))) + ; % Wait for 75 milliseconds before retrying + ( sleep(0.075), each_result_in_order(Tag, [Input|RestInputs], Index,Result))). + + +% Cleanup predicate to remove asserted results from the database +cleanup_results(Tag) :- + retractall(result(Tag, _, _, _)). + + +% :- initialization(start_vspace_service). + diff --git a/.Attic/canary_docme/metta_space.pl b/.Attic/canary_docme/metta_space.pl new file mode 100644 index 00000000000..fc96c1a295b --- /dev/null +++ b/.Attic/canary_docme/metta_space.pl @@ -0,0 +1,669 @@ +/* + * 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. + */ + + + +:- encoding(iso_latin_1). +:- flush_output. +:- setenv('RUST_BACKTRACE',full). +:- ensure_loaded(metta_compiler). +%:- ensure_loaded(metta_compiler). +% TODO move non flybase specific code between here and the compiler +%:- ensure_loaded(flybase_main). + +:- multifile(is_pre_statistic/2). +:- dynamic(is_pre_statistic/2). +save_pre_statistic(Name):- is_pre_statistic(Name,_)-> true; (statistics(Name,AS),term_number(AS,FN), + pfcAdd_Now(is_pre_statistic(Name,FN))). +pre_statistic(N,V):- is_pre_statistic(N,V)-> true ; V = 0. +post_statistic(N,V):- statistics(N,VV),term_number(VV,FV),pre_statistic(N,WV), V0 is FV-WV, (V0<0 -> V = 0 ; V0=V). +term_number(T,N):- sub_term(N,T),number(N). + + +call_match([G]):-!, call(G). +call_match([G|GG]):- !, call(G), call_match(GG). +call_match(G):- call(G). + +'save-space!'(Space,File):- + setup_call_cleanup( + open(File,write,Out,[]), + with_output_to(Out, + forall(get_atoms(Space,Atom), + write_src(Atom))), + close(Out)). + + +:- dynamic(repeats/1). +:- dynamic(not_repeats/1). +assert_new(P):- notrace(catch(call(P),_,fail)),!, + assert_new1(repeats(P)). +assert_new(P):- pfcAdd_Now(P), flag(assert_new,TA,TA+1),assert_new1(not_repeats(P)),!. + +retract1(P):- \+ call(P),!. +retract1(P):- ignore(\+ retract(P)). + +assert_new1(P):- \+ \+ call(P),!. +assert_new1(P):- pfcAdd_Now(P). + + +:- dynamic(fb_pred/3). +:- dynamic(mod_f_a/3). +decl_m_fb_pred(Mod,Fn,A):- var(Mod),!,mod_f_a(Mod,Fn,A). +decl_m_fb_pred(Mod,Fn,A):- mod_f_a(Mod,Fn,A)->true; + (dynamic(Mod:Fn/A), + pfcAdd_Now(mod_f_a(Mod,Fn,A))). +:- dynamic(fb_pred_file/3). +decl_fb_pred(Fn,A):- + (fb_pred(Fn,A)-> true; (dynamic(Fn/A),pfcAdd_Now(fb_pred(Fn,A)))), + ignore((nb_current(loading_file,File), + (fb_pred_file(Fn,A,File)-> true; pfcAdd_Now(fb_pred_file(Fn,A,File))))). +% Import necessary libraries +:- use_module(library(readutil)). + + +skip(_). + +% =============================== +% MeTTa Python incoming interface +% =============================== + +% ============================ +% %%%% Atom Manipulations +% ============================ + +% Clear all atoms from a space +'clear-atoms'(SpaceNameOrInstance) :- + dout(space,['clear-atoms',SpaceNameOrInstance]), + space_type_method(Type,clear_space,Method), call(Type,SpaceNameOrInstance),!, + dout(space,['type-method',Type,Method]), + call(Method,SpaceNameOrInstance). + +% Add an atom to the space +'add-atom'(SpaceNameOrInstance, Atom) :- % dout(space,['add-atom',SpaceNameOrInstance, Atom]), + (( space_type_method(Type,add_atom,Method), call(Type,SpaceNameOrInstance),!, + if_t((SpaceNameOrInstance\=='&self' ; Type\=='is_asserted_space'), + dout(space,['type-method',Type,Method,SpaceNameOrInstance,Atom])), + call(Method,SpaceNameOrInstance,Atom))). +% Add Atom +'add-atom'(Environment, AtomDeclaration, Result):- + eval_args(['add-atom', Environment, AtomDeclaration], Result). + +% remove an atom from the space +'remove-atom'(SpaceNameOrInstance, Atom) :- + dout(space,['remove-atom',SpaceNameOrInstance, Atom]), + space_type_method(Type,remove_atom,Method), call(Type,SpaceNameOrInstance),!, + dout(space,['type-method',Type,Method]), + call(Method,SpaceNameOrInstance,Atom). +% Remove Atom +'remove-atom'(Environment, AtomDeclaration, Result):- eval_args(['remove-atom', Environment, AtomDeclaration], Result). + +% Add an atom to the space +'replace-atom'(SpaceNameOrInstance, Atom, New) :- + dout(space,['replace-atom',SpaceNameOrInstance, Atom, New]), + space_type_method(Type,replace_atom,Method), call(Type,SpaceNameOrInstance),!, + dout(space,['type-method',Type,Method]), + call(Method,SpaceNameOrInstance,Atom, New). +% Replace Atom +'atom-replace'(Environment, OldAtom, NewAtom, Result):- eval_args(['atom-replace', Environment, OldAtom, NewAtom], Result). + +% Count atoms in a space +'atom-count'(SpaceNameOrInstance, Count) :- + dout(space,['atom-count',SpaceNameOrInstance]), + space_type_method(Type,atom_count,Method), call(Type,SpaceNameOrInstance),!, + call(Method,SpaceNameOrInstance,Count), + dout(space,['type-method-result',Type,Method,Count]). +% Count Atoms +'atom-count'(Environment, Count):- eval_args(['atom-count', Environment], Count). + +% Fetch all atoms from a space +'get-atoms'(SpaceNameOrInstance, AtomsL) :- + dout(space,['get-atoms',SpaceNameOrInstance]), + space_type_method(Type,get_atoms,Method), call(Type,SpaceNameOrInstance),!, + call(Method,SpaceNameOrInstance, AtomsL), + %dout(space,['type-method-result',Type,Method,Count]). + %length(AtomsL,Count), + true. +% Get Atoms +'get-atoms'(Environment, Atoms):- eval_args(['get-atoms', Environment], Atoms). + +% Iterate all atoms from a space +'atoms_iter'(SpaceNameOrInstance, Iter) :- + dout(space,['atoms_iter',SpaceNameOrInstance]), + space_type_method(Type,atoms_iter,Method), call(Type,SpaceNameOrInstance),!, + call(Method,SpaceNameOrInstance, Iter), + dout(space,['type-method-result',Type,Method,Iter]). + +% Match all atoms from a space +'atoms_match'(SpaceNameOrInstance, Atoms, Template, Else) :- + space_type_method(Type,atoms_match,Method), call(Type,SpaceNameOrInstance),!, + call(Method,SpaceNameOrInstance, Atoms, Template, Else), + dout(space,['type-method-result',Type,Method,Atoms, Template, Else]). + + +% Query all atoms from a space +'space_query'(SpaceNameOrInstance, QueryAtom, Result) :- + space_type_method(Type,query,Method), call(Type,SpaceNameOrInstance),!, + call(Method,SpaceNameOrInstance, QueryAtom, Result), + dout(space,['type-method-result',Type,Method,Result]). + + +subst_pattern_template(SpaceNameOrInstance, Pattern, Template) :- + dout(space,[subst_pattern_template,SpaceNameOrInstance, Pattern, Template]), + 'atoms_match'(SpaceNameOrInstance, Pattern, Template, []). + +/* +space_query_vars(SpaceNameOrInstance, Query, Vars) :- is_as_nb_space(SpaceNameOrInstance),!, + fetch_or_create_space(SpaceNameOrInstance, Space), + call_metta(Space,Query,Vars). +*/ :- dynamic(was_asserted_space/1). + +was_asserted_space('&self'). +was_asserted_space('&stdlib'). +was_asserted_space('&corelib'). +was_asserted_space('&flybase'). +/* +was_asserted_space('&attentional_focus'). +was_asserted_space('&belief_events'). +was_asserted_space('&goal_events'). +was_asserted_space('&tempset'). +was_asserted_space('&concepts'). +was_asserted_space('&belief_events'). +*/ +is_asserted_space(X):- was_asserted_space(X). +is_asserted_space(X):- \+ is_as_nb_space(X), \+ py_named_space(X),!. + +is_python_space_not_prolog(X):- \+ is_as_nb_space(X), \+ is_asserted_space(X). + +:- dynamic(is_python_space/1). + +:- dynamic(py_named_space/1). + +%py_named_space('&self'). +%py_named_space('&vspace'). +% Function to check if an atom is registered as a space name +:- dynamic is_registered_space_name/1. +is_as_nb_space('&nb'). +is_as_nb_space(G):- is_valid_nb_space(G) -> true ; + is_registered_space_name(G),nb_current(G,S),is_valid_nb_space(S). + +is_nb_space(G):- nonvar(G), is_as_nb_space(G). +% ============================ +% %%%% Pattern Matching +% ============================ +% Pattern Matching with an else branch +%'match'(Environment, Pattern, Template, ElseBranch, Result):- +% eval_args(['match', Environment, Pattern, Template, ElseBranch], Result). +% Pattern Matching without an else branch +'match'(Environment, Pattern, Template, Result):- + eval_args(['match', Environment, Pattern, Template], Result). +%'match'(_Environment, Pattern, Template, Result):- callable(Pattern),!, call(Pattern),Result=Template. +%'match'(_Environment, Pattern, Template, Result):- !, is_True(Pattern),Result=Template. + + +'new-space'(Space):- gensym('hyperon::space::DynSpace@_',Name), + fetch_or_create_space(Name, Space). + +:- dynamic(is_python_space/1). +% =============================== +% MeTTa Python incoming interface +% =============================== + +:- multifile(space_type_method/3). +:- dynamic(space_type_method/3). +space_type_method(is_as_nb_space,new_space,init_space). +space_type_method(is_as_nb_space,clear_space,clear_nb_atoms). +space_type_method(is_as_nb_space,add_atom,add_nb_atom). +space_type_method(is_as_nb_space,remove_atom,remove_nb_atom). +space_type_method(is_as_nb_space,replace_atom,replace_nb_atom). +space_type_method(is_as_nb_space,atom_count,atom_nb_count). +space_type_method(is_as_nb_space,get_atoms,get_nb_atoms). +%space_type_method(is_as_nb_space,get_atoms,arg(1)). +space_type_method(is_as_nb_space,atom_iter,atom_nb_iter). +%space_type_method(is_as_nb_space,query,space_nb_query). + +% Clear all atoms from a space +clear_nb_atoms(SpaceNameOrInstance) :- + fetch_or_create_space(SpaceNameOrInstance, Space), + nb_setarg(1, Space, []). + +% Add an atom to the space +add_nb_atom(SpaceNameOrInstance, Atom) :- + fetch_or_create_space(SpaceNameOrInstance, Space), + arg(1, Space, Atoms), + NewAtoms = [Atom | Atoms], + nb_setarg(1, Space, NewAtoms). + +% Count atoms in a space +atom_nb_count(SpaceNameOrInstance, Count) :- + fetch_or_create_space(SpaceNameOrInstance, Space), + arg(1, Space, Atoms), + length(Atoms, Count). + +% Remove an atom from a space +remove_nb_atom(SpaceNameOrInstance, Atom) :- + fetch_or_create_space(SpaceNameOrInstance, Space), + arg(1, Space, Atoms), + select(Atom, Atoms, UpdatedAtoms), + nb_setarg(1, Space, UpdatedAtoms). + +% Fetch all atoms from a space +get_nb_atoms(SpaceNameOrInstance, Atoms) :- + fetch_or_create_space(SpaceNameOrInstance, Space), + arg(1, Space, Atoms). + +% Replace an atom in the space +replace_nb_atom(SpaceNameOrInstance, OldAtom, NewAtom) :- + fetch_or_create_space(SpaceNameOrInstance, Space), + arg(1, Space, Atoms), + ( (select(Found, Atoms, TempAtoms),OldAtom=@=Found) + -> NewAtoms = [NewAtom | TempAtoms], + nb_setarg(1, Space, NewAtoms) + ; false + ). + + + +% Function to confirm if a term represents a space +is_valid_nb_space(Space):- compound(Space),functor(Space,'Space',_). + +% Find the original name of a given space +space_original_name(Space, Name) :- + is_registered_space_name(Name), + nb_current(Name, Space). + +% Register and initialize a new space +init_space(Name) :- + Space = 'Space'([]), + asserta(is_registered_space_name(Name)), + nb_setval(Name, Space). + +fetch_or_create_space(Name):- fetch_or_create_space(Name,_). +% Fetch an existing space or create a new one +fetch_or_create_space(NameOrInstance, Space) :- + ( atom(NameOrInstance) + -> (is_registered_space_name(NameOrInstance) + -> nb_current(NameOrInstance, Space) + ; init_space(NameOrInstance), + nb_current(NameOrInstance, Space)) + ; is_valid_nb_space(NameOrInstance) + -> Space = NameOrInstance + ; writeln('Error: Invalid input.') + ), + is_valid_nb_space(Space). + + +% Match Pattern in Space and produce Template +'match'(Space, Pattern, Template) :- + 'get-atoms'(Space, Atoms), + 'match-pattern'(Atoms, Pattern, Template). + +% Simple pattern match +'match-pattern'([], _, []). +'match-pattern'([H |_T], H, H) :- !. +'match-pattern'([_H| T], Pattern, Template) :- 'match-pattern'(T, Pattern, Template). + +%is_python_space(X):- python_object(X). + +ensure_space(X,Y):- catch(ensure_space_py(X,Y),_,fail),!. +ensure_space(_N,_V):- fail. + +% =============================== +% Clause Database interface +% =============================== +%dout(space,Call):- skip(Call). +if_metta_debug(Goal):- getenv('VSPACE_VERBOSE','2'),!,ignore(call(Goal)). +if_metta_debug(_):-!. +if_metta_debug(Goal):- !,ignore(call(Goal)). +dout(_,_):-!. +dout(W,Term):- notrace(if_metta_debug((format('~N; ~w ~@~n',[W,write_src(Term)])))). + +:- multifile(space_type_method/3). +:- dynamic(space_type_method/3). +space_type_method(is_asserted_space,new_space,init_space). +space_type_method(is_asserted_space,clear_space,clear_nb_atoms). +space_type_method(is_asserted_space,add_atom,metta_assertdb_add). +space_type_method(is_asserted_space,remove_atom,metta_assertdb_rem). +space_type_method(is_asserted_space,replace_atom,metta_assertdb_replace). +space_type_method(is_asserted_space,atom_count,metta_assertdb_count). +space_type_method(is_asserted_space,get_atoms,metta_assertdb_get_atoms). +space_type_method(is_asserted_space,atom_iter,metta_assertdb_iter). +%space_type_method(is_asserted_space,query,space_nb_query). + +%:- dynamic(for_metta/2). +%for_metta(_,T):- fb_pred(F,A),functor(T,F,A),call(T). +metta_assertdb_ls(KB):- + AMA = metta_atom_asserted, + decl_m_fb_pred(user,AMA,2), + MP =.. [AMA,KB,_], + listing(MP). + +metta_assertdb_add(KB,AtomIn):- + must_det_ll((subst_vars(AtomIn,Atom), + AMA = metta_atom_asserted, + decl_m_fb_pred(user,AMA,2), + MP =.. [AMA,KB,Atom], + assert_new(MP))). +metta_assertdb_rem(KB,Old):- metta_assertdb_del(KB,Old). +metta_assertdb_del(KB,Atom):- subst_vars(Atom,Old), + decl_m_fb_pred(user,metta_atom_asserted,2), + MP = metta_atom(KB,Old), + copy_term(MP,Copy), clause(MP,true,Ref), MP=@= Copy, !, erase(Ref). % ,metta_assertdb('DEL',Old). +metta_assertdb_replace(KB,Old,New):- metta_assertdb_del(KB,Old), metta_assertdb_add(KB,New). + + + +atom_count_provider(Self,Count):- + user:loaded_into_kb(Self,Filename), + once(user:asserted_metta_pred(Mangle,Filename)), + mangle_iz(Mangle,Iz), + member(P,[Mangle,Iz]), + between(2,8,Arity), + functor(Data,P,Arity), + predicate_property(Data,number_of_clauses(CC)), + predicate_property(Data,number_of_rules(RC)), + Count is CC - RC. + +atom_count_provider(KB,Count):- + must_det_ll(( + AMA = metta_atom_asserted, + decl_m_fb_pred(user,AMA,2), + MP =.. [AMA,KB,_], + predicate_property(MP,number_of_clauses(SL2)), + predicate_property(MP,number_of_rules(SL3)), + %metta_assertdb_ls(KB), + full_atom_count(SL1), + Count is SL1 + SL2 - SL3)),!. + +metta_assertdb_count(KB,Count):- + findall(C,atom_count_provider(KB,C),CL), + sumlist(CL,Count). + + + +%metta_assertdb_count(KB,Count):- writeln(metta_assertdb_count_in(KB,Count)), findall(Atom,for_metta(KB,Atom),AtomsL),length(AtomsL,Count),writeln(metta_assertdb_count_out(KB,Count)). +metta_assertdb_iter(KB,Atoms):- + MP =.. [metta_atom,KB,Atoms], + call(MP). + + + +metta_iter_bind(KB,Query,Vars,VarNames):- + term_variables(Query,QVars), + align_varnames(VarNames,Vars), + TV = dout(space,['match',KB,Query,QVars,Vars,VarNames]), +% \+ \+ (numbervars(TV,0,_,[]),print(tv=TV),nl), + ignore(QVars=Vars), +% \+ \+ (numbervars(TV,0,_,[]),print(qv=TV),nl), + \+ \+ (%numbervars(TV,0,_,[]), + writeq(av=TV),nl), + space_query_vars(KB,Query,TF),TF\=='False'. + + +% Query from hyperon.base.GroundingSpace +space_query_vars(KB,Query,Vars):- is_asserted_space(KB),!, + decl_m_fb_pred(user,metta_atom_asserted,2), + call_metta(KB,Query,Vars), + dout('RES',space_query_vars(KB,Query,Vars)). + + +metta_assertdb_get_atoms(KB,Atom):- metta_atom(KB,Atom). +/* + +%metta_assertdb_iter_bind(KB,Query,Template,AtomsL):- +decl_m_fb_pred(user,metta_atom_asserted,2), findall(Template,metta_atom(KB,Query),AtomsL). +metta_assertdb_iter_bind(KB,Query,Vars):- + ignore(term_variables(Query,Vars)), + print(metta_assertdb(['match',KB,Query,Vars])),nl, + AMA = metta_atom_asserted, + decl_m_fb_pred(user,AMA,2), + MP =.. [AMA,KB,Query], + + (MP*->true;call_metta_assertdb(KB,Query,Vars)), + metta_assertdb('RES',metta_assertdb_iter_bind(KB,Query,Vars)). +%metta_assertdb_iter_bind(KB,Atom,Template):- metta_assertdb_stats, findall(Template,metta_assertdb_iter(KB,Atom),VarList). + +metta_assertdb_iter_bind(KB,Atoms,Vars):- + metta_assertdb_stats, + term_variables(Atoms,AVars), + metta_assertdb_iter(KB,Atoms), ignore(AVars = Vars). +*/ + + +align_varnames(VarNames,Vars):- + list_to_set(VarNames,NameSet), + merge_named_vars(NameSet,VarNames,Vars). + +merge_named_vars([],_VarNames,_Vars):-!. +merge_named_vars([N|NameSet],VarNames,Vars):- + merge_named(N,_V,VarNames,Vars), + merge_named_vars(NameSet,VarNames,Vars). +%merge_named_vars(_,_,_). + +merge_named(_,_,[],[]):-!. +merge_named(N,V,[N|VarNames],[V|Vars]):- + merge_named(N,V,VarNames,Vars). + + +call_metta( KB,Query,_Vars):- metta_atom(KB,Query). +call_metta(_KB,Query,_Vars):- metta_to_pyswip([],Query,Call),!, + %print(user:Call),nl, + user:call(Call). + +metta_to_pyswip(_PS,Query,Call):- var(Query),!,Call=Query. +metta_to_pyswip(_PS,Query,Call):- \+ compound(Query),!,Call=Query,!. +metta_to_pyswip(PS,Query,Call):- is_list(Query),Query=[Q|Uery],!,cmpd_to_pyswip(PS,Q,Uery,Call). +metta_to_pyswip(PS,Query,Call):- Query=..[Q|Uery], cmpd_to_pyswip(PS,Q,Uery,Call). + +cmpd_to_pyswip(PS,Q,Uery,Call):- atom(Q),maplist(metta_to_pyswip([Q|PS]),Uery,Cery),Call=..[Q|Cery]. +cmpd_to_pyswip(PS,"and",Uery,Call):- maplist(metta_to_pyswip(PS),Uery,Args),list_to_conjuncts(Args,Call). + + +'show-metta-def'(Pred, []):- + 'get-metta-src'(Pred,[_|SrcL]), + maplist(write_src_nl,SrcL). + +write_src_nl(Src):- format('~N'),write_src(Src),format('~N'). + +%'get-metta-src'(Pred,[Len|SrcL]):- findall(['AtomDef',Src],'get-metta-src1'(Pred,Src),SrcL), length(SrcL,Len). +'get-metta-src'(Pred,[Len|SrcL]):- findall(Src,'get-metta-src1'(Pred,Src),SrcL), length(SrcL,Len). +'get-metta-src1'(Pred,Src):- + current_self(Space), + metta_atom(Space,F,A,List), + once((sub_var(Pred,A)->Src = [F,A,List];sub_var(Pred,F)->Src = [F,A|List])). + +% is a quine +'AtomDef'(X,['AtomDef',X]). + + +sort_on(C,R,A,B):- (A==B-> R= (=) ; must_det_ll((call(C,A,AA),call(C,B,BB),!,compare(R,AA+A,BB+B)))),!. +tokens(X,VL):- unaccent_atom(X,A),!, findall(E,(is_tokenizer(T),call(T,A,E)),L),predsort(sort_on(length_fw_len),L,S),last(S,VL). + +length_fw_len([W|List],L+WL):- length(List,L),atom_length(W,WL). + +print_token_args:- make, + fb_arg(X),tokens(X,A0), + exclude(is_dash,A0,A),tterm(A,AT),writeq(X),write(' '),writeq(AT),write(' '),write_src(A),nl,fail. +is_dash('_'). +is_dash('-'). +tterm([A],A):-!. +tterm([A,':',B|M],BA):- atom(A),!,BA=..[A,B|M]. +tterm([A,B|M],BA):- atom(B),!,BA=..[B,A|M]. +tterm([A|B],BA):- atom(A),!,BA=..[B|A]. +tterm(A,A). + +is_tokenizer(into_list). +is_tokenizer(to_case_break_atoms). +is_tokenizer(atom_to_stem_list). +is_tokenizer(tokenize_atom). +%is_tokenizer(double_metaphone). + + + +is_an_arg_type(S,T):- flybase_identifier(S,T),!. +has_type(S,Type):- sub_atom(S,0,4,Aft,FB),flybase_identifier(FB,Type),!,Aft>0. + + +call_sexpr(S):- once_writeq_ln(call_sexpr(S)). +%call_sexpr(Space,Expr,Result):- + +:- dynamic(fb_pred/2). + +full_atom_count(SL):- flag(total_loaded_atoms,SL,SL),SL>1,!. +full_atom_count(SL):- findall(NC,(fb_pred(F,A),metta_stats(F,A,NC)),Each), sumlist(Each,SL). + +heartbeat :- + % Get the current time and the last printed time + get_time(CurrentTime), + % Check if the global variable is set + ( nb_current(last_printed_time, _) + -> true + ; nb_setval(last_printed_time, CurrentTime) + ), + + nb_getval(last_printed_time, LastPrintedTime), + + % Calculate the difference + Diff is CurrentTime - LastPrintedTime, + + % If the difference is greater than or equal to 60 seconds (1 minute) + ( Diff >= 60 + -> % Print the heartbeat message and update the last printed time + metta_stats + ; % Otherwise, do nothing + true + ). + +metta_stats:- gc_now, + writeln('\n\n\n\n\n\n;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'), + writeln(';~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'), + full_atom_count(SL), + format("~N~n; Total\t\tAtoms (Atomspace size): ~`.t ~D~108|~n",[SL]), + get_time(CurrentTime), nb_setval(last_printed_time, CurrentTime), + post_statistic(memory,Mem), + post_statistic(atom_space,AS), + post_statistic(cputime,TotalSeconds), + post_statistic(atoms,Concepts), + flag(assert_new,CTs,CTs), + post_statistic(stack,StackMem), + + + PM is Mem + StackMem, + RM is Mem-AS, + PA is RM//(SL+1), + APS is 60*floor(SL/(TotalSeconds+1)), + ACS is AS//(Concepts+1), + + pl_stats('SymbolAtoms',Concepts), + pl_stats('Random samples',CTs), + skip((pl_stats('Bytes Per Atom (Average)',PA), pl_stats('Bytes Per ConceptNode (Average)',ACS))), + skip((pl_stats('Relational Memory',RM), pl_stats('ConceptNode Memory',AS))), + %pl_stats('Queryspace Memory',StackMem), + %CPU is CPUTime-57600, + format_time(TotalSeconds, Formatted), + skip((pl_stats('Atoms per minute',APS))), + pl_stats('Total Memory Used',PM), + pl_stats('Runtime (days:hh:mm:ss)',Formatted), + nl,nl,!. +metta_stats(F):- for_all(fb_pred(F,A),metta_stats(F,A)). +metta_stats(F,A):- metta_stats(F,A,NC), pl_stats(F/A,NC). +metta_stats(F,A,NC):- functor(P,F,A),predicate_property(P,number_of_clauses(NC)). +pl_stats(Stat):- statistics(Stat,Value),pl_stats(Stat,Value). +pl_stats(Stat,[Value|_]):- nonvar(Value),!, pl_stats(Stat,Value). +pl_stats(Stat,Value):- format("~N;\t\t~@: ~`.t ~@~100|",[format_value(Stat),format_value(Value)]),!. + + +% AsPred to print the formatted result. +format_value(Value) :- float(Value),!,format("~2f",[Value]),!. +format_value(Bytes) :- integer(Bytes),format_bytes(Bytes, Formatted), write(Formatted). +format_value(Term) :- format("~w",[Term]). +% Base case: If the number is 1G or more, show it in gigabytes (G). +format_bytes(Bytes, Formatted) :- Bytes >= 1073741824, GB is Bytes / 1073741824, format(string(Formatted), '~2fG', [GB]). +% If the number is less than 1G, show it in megabytes (M). +format_bytes(Bytes, Formatted) :- Bytes >= 104857600, Bytes < 1073741824, !, MB is Bytes / 1048576, D is floor(MB), format(string(Formatted), '~DM', [D]). +% If the number is less than 1K, show it in bytes (B). +format_bytes(Bytes, Formatted) :- format(string(Formatted), '~D', [Bytes]). +% % If the number is less than 1M, show it in kilobytes (K). +%format_bytes(Bytes, Formatted) :- Bytes >= 1024, Bytes < 1048576, !, KB is Bytes / 1024, format(string(Formatted), '~0fK', [KB]). + +% Convert total seconds to days, hours, minutes, seconds, and milliseconds. +format_time(TotalSeconds, Formatted) :- + Seconds is floor(TotalSeconds), + % Get days, remaining seconds + Days is div(Seconds, 86400), + Remain1 is mod(Seconds, 86400)-57600, + format_time(string(Out),'%T',Remain1), + % Format the result + format(string(Formatted), '~w:~w', [Days, Out]). + +% AsPred to print the formatted time. +print_formatted_time(TotalSeconds) :- + format_time(TotalSeconds, Formatted), + writeln(Formatted). + + +metta_final:- + save_pre_statistic(memory), + save_pre_statistic(atoms), + save_pre_statistic(atom_space). +/* +symbol(X):- atom(X). +symbol_number(S,N):- atom_number(S,N). +symbol_string(S,N):- atom_string(S,N). +symbol_chars(S,N):- atom_chars(S,N). +symbol_length(S,N):- atom_length(S,N). +symbol_concat(A,B,C):- atom_concat(A,B,C). +symbolic_list_concat(A,B,C):- atomic_list_concat(A,B,C). +symbolic_list_concat(A,B):- atomic_list_concat(A,B). +symbol_contains(T,TT):- atom_contains(T,TT). +*/ + diff --git a/.Attic/canary_docme/metta_subst.pl b/.Attic/canary_docme/metta_subst.pl new file mode 100644 index 00000000000..64c6cfc504f --- /dev/null +++ b/.Attic/canary_docme/metta_subst.pl @@ -0,0 +1,932 @@ +/* + * 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. + */ + +%self_subst(X):- var(X),!. +%self_subst(X):- string(X),!. +%self_subst(X):- number(X),!. +%self_subst([]). +self_subst(X):- \+ callable(X),!. +self_subst(X):- !, self_eval(X),!. +self_subst(X):- is_valid_nb_state(X),!. +self_subst(X):- is_list(X),!,fail. +%self_subst(X):- compound(X),!. +%self_subst(X):- is_ref(X),!,fail. +self_subst(X):- atom(X),!, \+ nb_bound(X,_),!. +self_subst('True'). self_subst('False'). self_subst('F'). %' + + +:- nb_setval(self_space, '&self'). % ' +substs_to(XX,Y):- Y==XX,!. +substs_to(XX,Y):- Y=='True',!, is_True(XX),!. %' + +%current_self(Space):- nb_bound(self_space,Space). +/* +subst_args(Eq,RetType,A,AA):- + current_self(Space), + subst_args(Eq,RetType,11,Space,A,AA). + +%subst_args(Eq,RetType,Depth,_Self,X,_Y):- forall(between(6,Depth,_),write(' ')),writeqln(subst_args(Eq,RetType,X)),fail. +*/ + +subst_args(Eq,RetType,Depth,Self,X,Y):- atom(Eq), ( Eq \== ('=')), ( Eq \== ('match')) ,!, + call(Eq,'=',RetType,Depth,Self,X,Y). % ' + + :- style_check(-singleton). + + + +%subst_args(Eq,RetType,_Dpth,_Slf,X,Y):- nonvar(Y),X=Y,!. +%subst_args(Eq,RetType,Depth,Self,X,Y):- nonvar(Y),!,subst_args(Eq,RetType,Depth,Self,X,XX),substs_to(XX,Y). +subst_args(Eq,RetType,_Dpth,_Slf,X,Y):- self_subst(X),!,Y=X. +subst_args(Eq,RetType,_Dpth,_Slf,[X|T],Y):- + % !, fail, + T==[], \+ callable(X),!,Y=[X]. + +subst_args(Eq,RetType,Depth,Self,[F|X],Y):- + % (F=='superpose' ; ( option_value(no_repeats,false))), %' + notrace((D1 is Depth-1)),!, + subst_args0(Eq,RetType,D1,Self,[F|X],Y). + +subst_args(Eq,RetType,Depth,Self,X,Y):- subst_args0(Eq,RetType,Depth,Self,X,Y). +/* +subst_args(Eq,RetType,Depth,Self,X,Y):- + mnotrace((no_repeats_var(YY), + D1 is Depth-1)), + subst_args0(Eq,RetType,D1,Self,X,Y), + mnotrace(( \+ (Y\=YY))). +*/ + +subst_args(X,Y):- subst_args('&self',X,Y). %' +subst_args(Space,X,Y):- subst_args(100,Space,X,Y). + +subst_args(Depth,Space,X,Y):-subst_args('=',_RetType, + Depth,Space,X,Y). + +:- nodebug(metta(eval)). + + +%subst_args0(Eq,RetType,Depth,_Slf,X,Y):- Depth<1,!,X=Y, (\+ trace_on_overflow-> true; reset_eval_num,debug(metta(eval))). +subst_args0(Eq,RetType,_Dpth,_Slf,X,Y):- self_subst(X),!,Y=X. +subst_args0(Eq,RetType,Depth,Self,X,Y):- + Depth2 is Depth-1, + trace_eval(subst_args1(Eq,RetType),(false,(e2;e)),Depth,Self,X,M), + (M\=@=X ->subst_args0(Eq,RetType,Depth2,Self,M,Y);Y=X). + +:- discontiguous subst_args1/6. +:- discontiguous subst_args2/6. + +subst_args1(Eq,RetType,Depth,Self,X,Y):- + var(Eq) -> (!,subst_args1('=',RetType,Depth,Self,X,Y)); + (atom(Eq), ( Eq \== ('='), Eq \== ('match')) ,!, call(Eq,'=',RetType,Depth,Self,X,Y)). + +subst_args1(Eq,RetType,_Dpth,_Slf,Name,Value):- atom(Name), nb_bound(Name,Value),!. + +subst_args1(Eq,RetType,Depth,Self,[V|VI],VVO):- \+ is_list(VI),!, + subst_args(Eq,RetType,Depth,Self,VI,VM), + ( VM\==VI -> subst_args(Eq,RetType,Depth,Self,[V|VM],VVO) ; + (subst_args(Eq,RetType,Depth,Self,V,VV), (V\==VV -> subst_args(Eq,RetType,Depth,Self,[VV|VI],VVO) ; VVO = [V|VI]))). + +subst_args1(Eq,RetType,_Dpth,_Slf,X,Y):- \+ is_list(X),!,Y=X. + +subst_args1(Eq,RetType,Depth,Self,[V|VI],[V|VO]):- var(V),is_list(VI),!,maplist(subst_args(Eq,RetType,Depth,Self),VI,VO). + +subst_args1(Eq,RetType,Depth,Self,['let',A,A5,AA],OO):- !, + %(var(A)->true;trace), + ((subst_args(Eq,RetType,Depth,Self,A5,AE), AE=A)), + subst_args(Eq,RetType,Depth,Self,AA,OO). +%subst_args1(Eq,RetType,Depth,Self,['let',A,A5,AA],AAO):- !,subst_args(Eq,RetType,Depth,Self,A5,A),subst_args(Eq,RetType,Depth,Self,AA,AAO). +subst_args1(Eq,RetType,Depth,Self,['let*',[],Body],RetVal):- !, subst_args(Eq,RetType,Depth,Self,Body,RetVal). +subst_args1(Eq,RetType,Depth,Self,['let*',[[Var,Val]|LetRest],Body],RetVal):- !, + subst_args1(Eq,RetType,Depth,Self,['let',Var,Val,['let*',LetRest,Body]],RetVal). + + is_sl_op('>'). is_sl_op('<'). % is_sl_op('>'). + is_sl_op('\\=@='). + +subst_args1(Eq,RetType,Depth,Self,[OP,N1,N2],TF):- + fail, + is_sl_op(OP), !, + ((subst_args(Eq,RetType,Depth,Self,N1,N1Res),subst_args(Eq,RetType,Depth,Self,N2,N2Res), + ((N1,N2)\=@=(N1Res,N2Res)),subst_args1(Eq,RetType,Depth,Self,[OP,N1Res,N2Res],TF)) + *->true; + subst_selfless([OP,N1,N2],TF)). + +%subst_args1(Eq,RetType,Depth,Self,O,O):-!. + +subst_args1(Eq,RetType,_Dpth,_Slf,['repl!'],'True'):- !, repl. +subst_args1(Eq,RetType,Depth,Self,['!',Cond],Res):- !, call(subst_args(Eq,RetType,Depth,Self,Cond,Res)). +subst_args1(Eq,RetType,Depth,Self,['rtrace',Cond],Res):- !, rtrace(subst_args(Eq,RetType,Depth,Self,Cond,Res)). +subst_args1(Eq,RetType,Depth,Self,['time',Cond],Res):- !, time(subst_args(Eq,RetType,Depth,Self,Cond,Res)). +%subst_args1(Eq,RetType,Depth,Self,['print',Cond],Res):- !, subst_args(Eq,RetType,Depth,Self,Cond,Res),format('~N'),print(Res),format('~N'). +% !(println! $1) +subst_args1(Eq,RetType,Depth,Self,['println!',Cond],[]):- !, subst_args(Eq,RetType,Depth,Self,Cond,Res),format('~N'),print(Res),format('~N'). + +subst_args1(Eq,RetType,_Dpth,_Slf,List,Y):- is_list(List),maplist(self_subst,List),List=[H|_], \+ atom(H), !,Y=List. + +subst_args1(Eq,RetType,Depth,Self,['assertTrue', X],TF):- !, subst_args(Eq,RetType,Depth,Self,['assertEqual',X,'True'],TF). +subst_args1(Eq,RetType,Depth,Self,['assertFalse',X],TF):- !, subst_args(Eq,RetType,Depth,Self,['assertEqual',X,'False'],TF). + +subst_args1(Eq,RetType,Depth,Self,['assertEqual',X0,Y0],RetVal):- !, + subst_vars(X0,X),subst_vars(Y0,Y), + l1t_loonit_assert_source_tf( + ['assertEqual',X0,Y0], + (bagof_subst(Depth,Self,X,XX), + bagof_subst(Depth,Self,Y,YY)), + equal_enough_for_test(XX,YY), TF), + (TF=='True'->make_nop(RetVal);RetVal=[got,XX,expected,YY]). + +subst_args1(Eq,RetType,Depth,Self,['assertNotEqual',X0,Y0],RetVal):- !, + subst_vars(X0,X),subst_vars(Y0,Y), + l1t_loonit_assert_source_tf( + ['assertNotEqual',X0,Y0], + (setof_subst(Depth,Self,X,XX), setof_subst(Depth,Self,Y,YY)), + \+ equal_enough(XX,YY), TF), + (TF=='True'->make_nop(RetVal);RetVal=[got,XX,expected,not,YY]). + +subst_args1(Eq,RetType,Depth,Self,['assertEqualToResult',X0,Y0],RetVal):- !, + subst_vars(X0,X),subst_vars(Y0,Y), + l1t_loonit_assert_source_tf( + ['assertEqualToResult',X0,Y0], + (bagof_subst(Depth,Self,X,XX), =(Y,YY)), + equal_enough_for_test(XX,YY), TF), + (TF=='True'->make_nop(RetVal);RetVal=[got,XX,expected,YY]),!. + + +l1t_loonit_assert_source_tf(Src,Goal,Check,TF):- + copy_term(Goal,OrigGoal), + l1t_loonit_asserts(Src, time_eval('\n; EVAL TEST\n;',Goal), Check), + as_tf(Check,TF),!, + ignore(( + once((TF='True', is_debugging(pass));(TF='False', is_debugging(fail))), + with_debug((eval),time_eval('Trace',OrigGoal)))). + +l1t_loonit_asserts(Src,Goal,Check):- + loonit_asserts(Src,Goal,Check). + + +/* +sort_result(Res,Res):- \+ compound(Res),!. +sort_result([And|Res1],Res):- is_and(And),!,sort_result(Res1,Res). +sort_result([T,And|Res1],Res):- is_and(And),!,sort_result([T|Res1],Res). +sort_result([H|T],[HH|TT]):- !, sort_result(H,HH),sort_result(T,TT). +sort_result(Res,Res). + +unify_enough(L,L):-!. +unify_enough(L,C):- is_list(L),into_list_args(C,CC),!,unify_lists(CC,L). +unify_enough(C,L):- is_list(L),into_list_args(C,CC),!,unify_lists(CC,L). +unify_enough(C,L):- \+ compound(C),!,L=C. +unify_enough(L,C):- \+ compound(C),!,L=C. +unify_enough(L,C):- into_list_args(L,LL),into_list_args(C,CC),!,unify_lists(CC,LL). + +unify_lists(C,L):- \+ compound(C),!,L=C. +unify_lists(L,C):- \+ compound(C),!,L=C. +unify_lists([C|CC],[L|LL]):- unify_enough(L,C),!,unify_lists(CC,LL). + +equal_enough(R,V):- is_list(R),is_list(V),sort(R,RR),sort(V,VV),!,equal_enouf(RR,VV),!. +equal_enough(R,V):- copy_term(R,RR),copy_term(V,VV),equal_enouf(R,V),!,R=@=RR,V=@=VV. + +equal_enough_for_test(X,Y):- must_det_ll((subst_vars(X,XX),subst_vars(Y,YY))),!,equal_enough(XX,YY),!. + +equal_enouf(R,V):- R=@=V, !. +equal_enouf(_,V):- V=@='...',!. +equal_enouf(L,C):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). +equal_enouf(C,L):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). +%equal_enouf(R,V):- (var(R),var(V)),!, R=V. +equal_enouf(R,V):- (var(R);var(V)),!, R==V. +equal_enouf(R,V):- number(R),number(V),!, RV is abs(R-V), RV < 0.03 . +equal_enouf(R,V):- atom(R),!,atom(V), has_unicode(R),has_unicode(V). +equal_enouf(R,V):- (\+ compound(R) ; \+ compound(V)),!, R==V. +equal_enouf(L,C):- into_list_args(L,LL),into_list_args(C,CC),!,equal_enouf_l(CC,LL). + +equal_enouf_l(C,L):- \+ compound(C),!,L=@=C. +equal_enouf_l(L,C):- \+ compound(C),!,L=@=C. +equal_enouf_l([C|CC],[L|LL]):- !, equal_enouf(L,C),!,equal_enouf_l(CC,LL). + + +has_unicode(A):- atom_codes(A,Cs),member(N,Cs),N>127,!. +set_last_error(_). + +*/ +subst_args1(Eq,RetType,Depth, Self, [OP|ARGS], Template):- + is_space_op(OP), !, + subst_args_as(Depth, Self, [OP|ARGS], Template). + +% Definition of uses_op to validate operations +is_space_op('match'). +is_space_op('get-atoms'). +is_space_op('add-atom'). +is_space_op('remove-atom'). +%is_space_op('replace-atom'). +is_space_op('atom-count'). +is_space_op('atom-replace'). + +subst_args_as(Depth, Self, [OP|ARGS], Template):- !, eval_20('=',_,Depth, Self, [OP|ARGS], Template). + +subst_args_as(Depth,Self,['match',Other,Goal,Template],Template):- into_space(Self,Other,Space),!, metta_atom_iter_l1t(Eq,Depth,Space,Goal). +subst_args_as(Depth,Self,['match',Other,Goal,Template,Else],Template):- + (subst_args_as(Depth,Self,['match',Other,Goal,Template],Template)*->true;Template=Else). +subst_args_as(Depth,Self,['get-atoms',Other],PredDecl):- !,into_space(Self,Other,Space), metta_atom_iter_l1t(Eq,Depth,Space,PredDecl). +subst_args_as(_Dpth,Self,['add-atom',Other,PredDecl],TF):- !, into_space(Self,Other,Space), as_tf(do_metta(Space,load,PredDecl),TF). +subst_args_as(_Dpth,Self,['remove-atom',Other,PredDecl],TF):- !, into_space(Self,Other,Space), as_tf(do_metta(Space,unload,PredDecl),TF). +subst_args_as(_Dpth,Self,['atom-count',Other],Count):- !, into_space(Self,Other,Space), findall(_,metta_eq_def(Eq,Other,_,_),L_as),length(L_as,C_as),findall(_,get_metta_atom(Eq,Space,_),L2),length(L2,C2),Count is C_as+C2. +subst_args_as(_Dpth,Self,['atom-replace',Other,Rem,Add],TF):- !, into_space(Self,Other,Space), copy_term(Rem,RCopy), + as_tf((metta_atom_iter_l1t_ref(Space,RCopy,Ref), RCopy=@=Rem,erase(Ref), do_metta(Other,load,Add)),TF). + +subst_args1(Eq,RetType,Depth,Self,X,Res):- + X= [CaseSym|_],CaseSym == 'case', !, eval_20('=',_,Depth, Self, X,Res). + +% Macro: case +subst_args1_hide(Depth,Self,X,Res):- + X= [CaseSym,A,CL],CaseSym == 'case', !, + into_case_l1t_list(CL,CASES), + findall(Key-Value, + (nth0(Nth,CASES,Case0), + (is_case_l1t(Key,Case0,Value), + if_trace((case),(format('~N'), + writeqln(c(Nth,Key)=Value))))),KVs),!, + ((subst_args(Eq,RetType,Depth,Self,A,AA), if_trace((case),writeqln(switch=AA)), + (select_case_l1t(Depth,Self,AA,KVs,Value)->true;(member(Void -Value,KVs),Void=='%void%'))) + *->true;(member(Void -Value,KVs),Void=='%void%')), + subst_args(Eq,RetType,Depth,Self,Value,Res). + + select_case_l1t(Depth,Self,AA,Cases,Value):- + (best_key_l1t(AA,Cases,Value) -> true ; + (maybe_special_key_l1ts(Depth,Self,Cases,CasES), + (best_key_l1t(AA,CasES,Value) -> true ; + (member(Void -Value,CasES),Void=='%void%')))). + + best_key_l1t(AA,Cases,Value):- + ((member(Match-Value,Cases),unify_enough(AA,Match))->true; + ((member(Match-Value,Cases),AA ==Match)->true; + ((member(Match-Value,Cases),AA=@=Match)->true; + (member(Match-Value,Cases),AA = Match)))). + + %into_case_l1t_list([[C|ASES0]],CASES):- is_list(C),!, into_case_l1t_list([C|ASES0],CASES),!. + into_case_l1t_list(CASES,CASES):- is_list(CASES),!. + is_case_l1t(AA,[AA,Value],Value):-!. + is_case_l1t(AA,[AA|Value],Value). + + maybe_special_key_l1ts(Depth,Self,[K-V|KVI],[AK-V|KVO]):- + subst_args(Eq,RetType,Depth,Self,K,AK), K\=@=AK,!, + maybe_special_key_l1ts(Depth,Self,KVI,KVO). + maybe_special_key_l1ts(Depth,Self,[_|KVI],KVO):- + maybe_special_key_l1ts(Depth,Self,KVI,KVO). + maybe_special_key_l1ts(_Depth,_Self,[],[]). + + +%[collapse,[1,2,3]] +subst_args1(Eq,RetType,Depth,Self,['collapse',List],Res):-!, bagof_subst(Depth,Self,List,Res). +%[superpose,[1,2,3]] +subst_args1(Eq,RetType,Depth,Self,['superpose',List],Res):- !, member(E,List),subst_args(Eq,RetType,Depth,Self,E,Res). + +get_l1t_sa_p1(P3,E,Cmpd,SA):- compound(Cmpd), get_l1t_sa_p2(P3,E,Cmpd,SA). +get_l1t_sa_p2(P3,E,Cmpd,call(P3,N1,Cmpd)):- arg(N1,Cmpd,E). +get_l1t_sa_p2(P3,E,Cmpd,SA):- arg(_,Cmpd,Arg),get_l1t_sa_p1(P3,E,Arg,SA). +subst_args1(Eq,RetType,Depth,Self, Term, Res):- fail, + mnotrace(( get_l1t_sa_p1(setarg,ST,Term,P1), % ST\==Term, + compound(ST), ST = [F,List],F=='superpose',nonvar(List), %maplist(atomic,List), + call(P1,Var))), !, + %max_counting(F,20), + member(Var,List), + subst_args(Eq,RetType,Depth,Self, Term, Res). + +/* + +sub_sterm(Sub,Sub). +sub_sterm(Sub,Term):- sub_sterm1(Sub,Term). +sub_sterm1(_ ,List):- \+ compound(List),!,fail. +sub_sterm1(Sub,List):- is_list(List),!,member(SL,List),sub_sterm(Sub,SL). +sub_sterm1(_ ,[_|_]):-!,fail. +sub_sterm1(Sub,Term):- arg(_,Term,SL),sub_sterm(Sub,SL). +*/ +% ================================================================= +% ================================================================= +% ================================================================= +% NOP/EQUALITU/DO +% ================================================================= +% ================================================================= +% ================================================================ +subst_args1(Eq,RetType,_Depth,_Self,['nop'], _ ):- !, fail. +subst_args1(Eq,RetType,Depth,Self,['nop',Expr], Empty):- !, + ignore(subst_args(Eq,RetType,Depth,Self,Expr,_)), + make_nop([], Empty). + +subst_args1(Eq,RetType,Depth,Self,['do',Expr], Empty):- !, + forall(subst_args(Eq,RetType,Depth,Self,Expr,_),true), + make_nop([],Empty). + +subst_args1(Eq,RetType,_Depth,_Self,['call',S], TF):- !, eval_call(S,TF). + +% ================================================================= +% ================================================================= +% ================================================================= +% if/If +% ================================================================= +% ================================================================= +% ================================================================= + + +subst_args1(Eq,RetType,Depth,Self,PredDecl,Res):- + Do_more_defs = do_more_defs(true), + clause(eval_21(subst_args,RetType,Depth,Self,PredDecl,Res),Body), + Do_more_defs == do_more_defs(true), + (call(Body), nb_setarg(1,Do_more_defs,false), + deterministic(TF), (TF==true -> ! ; true)). + + +subst_args1(Eq,RetType,Depth,Self,['if',Cond,Then,Else],Res):- !, + subst_args(Eq,'Bool',Depth,Self,Cond,TF), + (is_True(TF) + -> subst_args(Eq,RetType,Depth,Self,Then,Res) + ; subst_args(Eq,RetType,Depth,Self,Else,Res)). + +subst_args1(Eq,RetType,Depth,Self,['If',Cond,Then,Else],Res):- !, + subst_args(Eq,'Bool',Depth,Self,Cond,TF), + (is_True(TF) + -> subst_args(Eq,RetType,Depth,Self,Then,Res) + ; subst_args(Eq,RetType,Depth,Self,Else,Res)). + +subst_args1(Eq,RetType,Depth,Self,['If',Cond,Then],Res):- !, + subst_args(Eq,'Bool',Depth,Self,Cond,TF), + (is_True(TF) -> subst_args(Eq,RetType,Depth,Self,Then,Res) ; + (!, fail,Res = [],!)). + +subst_args1(Eq,RetType,Depth,Self,['if',Cond,Then],Res):- !, + subst_args(Eq,'Bool',Depth,Self,Cond,TF), + (is_True(TF) -> subst_args(Eq,RetType,Depth,Self,Then,Res) ; + (!, fail,Res = [],!)). + + +subst_args1(Eq,RetType,_Dpth,_Slf,[_,Nothing],NothingO):- + 'Nothing'==Nothing,!,do_expander(Eq,RetType,Nothing,NothingO). + + + +subst_args1(Eq,RetType,Depth,Self, Term, Res):- fail, + mnotrace(( get_l1t_sa_p1(setarg,ST,Term,P1), + compound(ST), ST = [F,List],F=='collapse',nonvar(List), %maplist(atomic,List), + call(P1,Var))), !, setof_subst(Depth,Self,List,Var), + subst_args(Eq,RetType,Depth,Self, Term, Res). + + +%max_counting(F,Max):- flag(F,X,X+1), X true; (flag(F,_,10),!,fail). + + +subst_args1(Eq,RetType,_Dpth,_Slf,[_,Nothing],Nothing):- 'Nothing'==Nothing,!. + + + +subst_args1(Eq,RetType,Depth,Self,['colapse'|List], Flat):- !, maplist(subst_args(Eq,RetType,Depth,Self),List,Res),flatten(Res,Flat). +subst_args1(Eq,RetType,_Dpth,_Slf,['car-atom',Atom],CAR):- !, Atom=[CAR|_],!. +subst_args1(Eq,RetType,_Dpth,_Slf,['cdr-atom',Atom],CDR):- !, Atom=[_|CDR],!. + +subst_args1(Eq,RetType,Depth,Self,['Cons', A, B ],['Cons', AA, BB]):- no_cons_reduce, !, + subst_args(Eq,RetType,Depth,Self,A,AA), subst_args(Eq,RetType,Depth,Self,B,BB). + +subst_args1(Eq,RetType,Depth,Self,['Cons', A, B ],[AA|BB]):- \+ no_cons_reduce, !, + subst_args(Eq,RetType,Depth,Self,A,AA), subst_args(Eq,RetType,Depth,Self,B,BB). + + +subst_args1(Eq,RetType,Depth,Self,['change-state!',StateExpr, UpdatedValue], Ret):- !, subst_args(Eq,RetType,Depth,Self,StateExpr,StateMonad), + subst_args(Eq,RetType,Depth,Self,UpdatedValue,Value), 'change-state!'(Depth,Self,StateMonad, Value, Ret). +subst_args1(Eq,RetType,Depth,Self,['new-state',UpdatedValue],StateMonad):- !, + subst_args(Eq,RetType,Depth,Self,UpdatedValue,Value), 'new-state'(Depth,Self,Value,StateMonad). +subst_args1(Eq,RetType,Depth,Self,['get-state',StateExpr],Value):- !, + subst_args(Eq,RetType,Depth,Self,StateExpr,StateMonad), 'get-state'(StateMonad,Value). + + + +% subst_args1(Eq,RetType,Depth,Self,['get-state',Expr],Value):- !, subst_args(Eq,RetType,Depth,Self,Expr,State), arg(1,State,Value). + + + +% check_type:- option_else(typecheck,TF,'False'), TF=='True'. + +:- dynamic is_registered_state/1. +:- flush_output. +:- setenv('RUST_BACKTRACE',full). + +/* +% Function to check if an value is registered as a state name +:- dynamic(is_registered_state/1). + +is_nb_state(G):- is_valid_nb_state(G) -> true ; + is_registered_state(G),nb_bound(G,S),is_valid_nb_state(S). + + +:- multifile(state_type_method/3). +:- dynamic(state_type_method/3). +space_type_method(is_nb_state,new_space,init_state). +space_type_method(is_nb_state,clear_space,clear_nb_values). +space_type_method(is_nb_state,add_atom,add_nb_value). +space_type_method(is_nb_state,remove_atom,'change-state!'). +space_type_method(is_nb_state,replace_atom,replace_nb_value). +space_type_method(is_nb_state,atom_count,value_nb_count). +space_type_method(is_nb_state,get_atoms,'get-state'). +space_type_method(is_nb_state,atom_iter,value_nb_iter). + +state_type_method(is_nb_state,new_state,init_state). +state_type_method(is_nb_state,clear_state,clear_nb_values). +state_type_method(is_nb_state,add_value,add_nb_value). +state_type_method(is_nb_state,remove_value,'change-state!'). +state_type_method(is_nb_state,replace_value,replace_nb_value). +state_type_method(is_nb_state,value_count,value_nb_count). +state_type_method(is_nb_state,'get-state','get-state'). +state_type_method(is_nb_state,value_iter,value_nb_iter). +%state_type_method(is_nb_state,query,state_nb_query). + +% Clear all values from a state +clear_nb_values(StateNameOrInstance) :- + fetch_or_create_state(StateNameOrInstance, State), + nb_setarg(1, State, []). + + + +% Function to confirm if a term represents a state +is_valid_nb_state(State):- compound(State),functor(State,'State',_). + +% Find the original name of a given state +state_original_name(State, Name) :- + is_registered_state(Name), + nb_bound(Name, State). + +% Register and initialize a new state +init_state(Name) :- + State = 'State'(_,_), + asserta(is_registered_state(Name)), + nb_setval(Name, State). + +% Change a value in a state +'change-state!'(Depth,Self,StateNameOrInstance, UpdatedValue, Out) :- + fetch_or_create_state(StateNameOrInstance, State), + arg(2, State, Type), + ( (check_type,\+ get_type_l1t(Depth,Self,UpdatedValue,Type)) + -> (Out = ['Error', UpdatedValue, 'BadType']) + ; (nb_setarg(1, State, UpdatedValue), Out = State) ). + +% Fetch all values from a state +'get-state'(StateNameOrInstance, Values) :- + fetch_or_create_state(StateNameOrInstance, State), + arg(1, State, Values). + +'new-state'(Depth,Self,Init,'State'(Init, Type)):- check_type->get_type_l1t(Depth,Self,Init,Type);true. + +'new-state'(Init,'State'(Init, Type)):- check_type->get_type_l1t(10,'&self',Init,Type);true. + +fetch_or_create_state(Name):- fetch_or_create_state(Name,_). +% Fetch an existing state or create a new one + +fetch_or_create_state(State, State) :- is_valid_nb_state(State),!. +fetch_or_create_state(NameOrInstance, State) :- + ( atom(NameOrInstance) + -> (is_registered_state(NameOrInstance) + -> nb_bound(NameOrInstance, State) + ; init_state(NameOrInstance), + nb_bound(NameOrInstance, State)) + ; is_valid_nb_state(NameOrInstance) + -> State = NameOrInstance + ; writeln('Error: Invalid input.') + ), + is_valid_nb_state(State). + +*/ + +subst_args1(Eq,RetType,Depth,Self,['get-type',Val],Type):- !, get_type_l1t(Depth,Self,Val,Type),ground(Type),Type\==[], Type\==Val,!. + +% mnotrace(G):- once(G). +/* +is_decl_type(ST):- metta_type(_,_,Type),sub_term(T,Type),T=@=ST, \+ nontype(ST). +is_type(Type):- nontype(Type),!,fail. +is_type(Type):- is_decl_type(Type). +is_type(Type):- atom(Type). + +nontype(Type):- var(Type),!. +nontype('->'). +nontype(N):- number(N). + +*/ + +needs_subst(EvalMe):- is_list(EvalMe),!. + + +get_type_l1t(_Dpth,_Slf,Var,'%Undefined%'):- var(Var),!. +get_type_l1t(_Dpth,_Slf,Val,'Number'):- number(Val),!. +get_type_l1t(_Dpth,_Slf,Val,'String'):- string(Val),!. +get_type_l1t(Depth,Self,Expr,['StateMonad',Type]):- is_valid_nb_state(Expr),'get-state'(Expr,Val),!, + get_type_l1t(Depth,Self,Val,Type). + + +get_type_l1t(Depth,Self,EvalMe,Type):- needs_subst(EvalMe),subst_args(Eq,RetType,Depth,Self,EvalMe,Val), \+ needs_subst(Val),!, + get_type_l1t(Depth,Self,Val,Type). + +get_type_l1t(_Dpth,Self,[Fn|_],Type):- symbol(Fn),metta_type(Self,Fn,List),last_element(List,Type), nonvar(Type), + is_type(Type). +get_type_l1t(_Dpth,Self,List,Type):- is_list(List),metta_type(Self,List,LType),last_element(LType,Type), nonvar(Type), + is_type(Type). + +get_type_l1t(Depth,_Slf,Type,Type):- Depth<1,!. +get_type_l1t(_Dpth,Self,List,Type):- is_list(List),metta_type(Self,Type,['->'|List]). +get_type_l1t(Depth,Self,List,Types):- List\==[], is_list(List),Depth2 is Depth-1,maplist(get_type_l1t(Depth2,Self),List,Types). +get_type_l1t(_Dpth,Self,Fn,Type):- symbol(Fn),metta_type(Self,Fn,Type),!. +%get_type_l1t(Depth,Self,Fn,Type):- nonvar(Fn),metta_type(Self,Fn,Type2),Depth2 is Depth-1,get_type_l1t(Depth2,Self,Type2,Type). +%get_type_l1t(Depth,Self,Fn,Type):- Depth>0,nonvar(Fn),metta_type(Self,Type,Fn),!. %,!,last_element(List,Type). + +get_type_l1t(Depth,Self,Expr,Type):-Depth2 is Depth-1, subst_args(Eq,RetType,Depth2,Self,Expr,Val),Expr\=@=Val,get_type_l1t(Depth2,Self,Val,Type). + + +get_type_l1t(_Dpth,_Slf,Val,'String'):- string(Val),!. +get_type_l1t(_Dpth,_Slf,Val,Type):- is_decl_type(Val),Type=Val. +get_type_l1t(_Dpth,_Slf,Val,'Bool'):- (Val=='False';Val=='True'),!. +get_type_l1t(_Dpth,_Slf,Val,'Symbol'):- symbol(Val). +%get_type_l1t(Depth,Self,[T|List],['List',Type]):- Depth2 is Depth-1, is_list(List),get_type_l1t(Depth2,Self,T,Type),!, +% forall((member(Ele,List),nonvar(Ele)),get_type_l1t(Depth2,Self,Ele,Type)),!. +%get_type_l1t(Depth,_Slf,Cmpd,Type):- compound(Cmpd), functor(Cmpd,Type,1),!. +get_type_l1t(_Dpth,_Slf,Cmpd,Type):- \+ ground(Cmpd),!,Type=[]. +get_type_l1t(_Dpth,_Slf,_,'%Undefined%'):- fail. + + +subst_args1(Eq,RetType,Depth,Self,['length',L],Res):- !, subst_args(Eq,RetType,Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). +subst_args1(Eq,RetType,Depth,Self,['CountElement',L],Res):- !, subst_args(Eq,RetType,Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). + +/* + +is_feo_f('Cons'). + +is_seo_f('{...}'). +is_seo_f('[...]'). +is_seo_f('{}'). +is_seo_f('[]'). +is_seo_f('StateMonad'). +is_seo_f('State'). +is_seo_f('Event'). +is_seo_f('Concept'). +is_seo_f(N):- number(N),!. + +*/ + +/* +subst_args1(Eq,RetType,Depth,Self,[F,A|Args],Res):- + \+ self_subst(A), + subst_args(Eq,RetType,Depth,Self,A,AA),AA\==A, + subst_args(Eq,RetType,Depth,Self,[F,AA|Args],Res). + + +subst_args1(Eq,RetType,Depth,Self,[F,A1|AArgs],Res):- fail, member(F,['+']), + cwdl(40,(( + append(L,[A|R],AArgs), + \+ self_subst(A), + subst_args(Eq,RetType,Depth,Self,A,AA),AA\==A,!, + append(L,[AA|R],NewArgs), subst_args(Eq,RetType,Depth,Self,[F,A1|NewArgs],Res)))). +*/ + +/* %% + +% !(assertEqualToResult ((inc) 2) (3)) +subst_args1(Eq,RetType,Depth,Self,[F|Args],Res):- is_list(F), + metta_atom_iter_l1t(Eq,Depth,Self,['=',F,R]), subst_args(Eq,RetType,Depth,Self,[R|Args],Res). + +subst_args1(Eq,RetType,Depth,Self,[F|Args],Res):- is_list(F), Args\==[], + append(F,Args,FArgs),!,subst_args(Eq,RetType,Depth,Self,FArgs,Res). +*/ +subst_args1(Eq,RetType,_Dpth,Self,['import!',Other,File],RetVal):- into_space(Self,Other,Space),!, include_metta(Space,File),!,make_nop(Space,RetVal). %RetVal=[]. +subst_args1(Eq,RetType,Depth,Self,['bind!',Other,Expr],RetVal):- + into_name(Self,Other,Name),!,subst_args(Eq,RetType,Depth,Self,Expr,Value),nb_setval(Name,Value), make_nop(Value,RetVal). +subst_args1(Eq,RetType,Depth,Self,['pragma!',Other,Expr],RetVal):- + into_name(Self,Other,Name),!,subst_args(Eq,RetType,Depth,Self,Expr,Value),set_option_value(Name,Value), make_nop(Value,RetVal). +subst_args1(Eq,RetType,_Dpth,Self,['transfer!',File],RetVal):- !, include_metta(Self,File), make_nop(Self,RetVal). + + + +%l_l1t_args1(Depth,Self,['nop',Expr],Empty):- !, subst_args(Eq,RetType,Depth,Self,Expr,_), make_nop([],Empty). + +/* +is_True(T):- T\=='False',T\=='F',T\==[]. + +is_and(S):- \+ atom(S),!,fail. +is_and('#COMMA'). is_and(','). is_and('and'). is_and('And'). +*/ +subst_args1(Eq,RetType,_Dpth,_Slf,[And],'True'):- is_and(And),!. +subst_args1(Eq,RetType,Depth,Self,['and',X,Y],TF):- !, as_tf((subst_args(Eq,RetType,Depth,Self,X,'True'),subst_args(Eq,RetType,Depth,Self,Y,'True')),TF). +subst_args1(Eq,RetType,Depth,Self,[And,X|Y],TF):- is_and(And),!,subst_args(Eq,RetType,Depth,Self,X,TF1), + is_True(TF1),subst_args1(Eq,RetType,Depth,Self,[And|Y],TF). +%subst_args2(Eq,Depth,Self,[H|T],_):- \+ is_list(T),!,fail. +subst_args1(Eq,RetType,Depth,Self,['or',X,Y],TF):- !, as_tf((subst_args(Eq,RetType,Depth,Self,X,'True');subst_args(Eq,RetType,Depth,Self,Y,'True')),TF). + + + + +subst_args1(Eq,RetType,Depth,Self,['+',N1,N2],N):- number(N1),!, + subst_args(Eq,RetType,Depth,Self,N2,N2Res), catch_err(N is N1+N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail)). +subst_args1(Eq,RetType,Depth,Self,['-',N1,N2],N):- number(N1),!, + subst_args(Eq,RetType,Depth,Self,N2,N2Res), catch_err(N is N1-N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail)). + +subst_args1(Eq,RetType,Depth,Self,[V|VI],[V|VO]):- nonvar(V), fail, is_metta_data_functor(Eq,V),is_list(VI),!,maplist(subst_args(Eq,RetType,Depth,Self),VI,VO). + +subst_args1(Eq,RetType,Depth,Self,X,Y):- + (subst_args2(Eq,Depth,Self,X,Y)*->true; + (subst_args2_failed(Depth,Self,X,Y)*->true;X=Y)). + + +subst_args2_failed(_Dpth,_Slf,T,TT):- T==[],!,TT=[]. +subst_args2_failed(_Dpth,_Slf,T,TT):- var(T),!,TT=T. +subst_args2_failed(_Dpth,_Slf,[F|LESS],Res):- once(subst_selfless([F|LESS],Res)),mnotrace([F|LESS]\==Res),!. +%subst_args2_failed(Depth,Self,[V|Nil],[O]):- Nil==[], once(subst_args(Eq,RetType,Depth,Self,V,O)),V\=@=O,!. +subst_args2_failed(Depth,Self,[H|T],[HH|TT]):- !, + subst_args(Eq,RetType,Depth,Self,H,HH), + subst_args2_failed(Depth,Self,T,TT). +subst_args2_failed(Depth,Self,T,T):-!. +%subst_args2_failed(Depth,Self,T,TT):- subst_args(Eq,RetType,Depth,Self,T,TT). + + %subst_args(Eq,RetType,Depth,Self,X,Y):- subst_args1(Eq,RetType,Depth,Self,X,Y)*->true;Y=[]. + +%subst_args1(Eq,RetType,Depth,_,_,_):- Depth<1,!,fail. +%subst_args1(Eq,RetType,Depth,_,X,Y):- Depth<3, !, ground(X), (Y=X). +%subst_args1(Eq,RetType,_Dpth,_Slf,X,Y):- self_subst(X),!,Y=X. + +% Kills zero arity functions subst_args1(Eq,RetType,Depth,Self,[X|Nil],[Y]):- Nil ==[],!,subst_args(Eq,RetType,Depth,Self,X,Y). + + +/* +into_values(List,Many):- List==[],!,Many=[]. +into_values([X|List],Many):- List==[],is_list(X),!,Many=X. +into_values(Many,Many). +subst_args2(Eq,_Dpth,_Slf,Name,Value):- atom(Name), nb_bound(Name,Value),!. +*/ +% Macro Functions +%subst_args1(Eq,RetType,Depth,_,_,_):- Depth<1,!,fail. +subst_args2(Eq,Depth,_,X,Y):- Depth<3, !, fail, ground(X), (Y=X). +subst_args2(Eq,Depth,Self,[F|PredDecl],Res):- fail, + Depth>1, + mnotrace((sub_sterm1(SSub,PredDecl), ground(SSub),SSub=[_|Sub], is_list(Sub), maplist(atomic,SSub))), + subst_args(Eq,RetType,Depth,Self,SSub,Repl), + mnotrace((SSub\=Repl, subst(PredDecl,SSub,Repl,Temp))), + subst_args(Eq,RetType,Depth,Self,[F|Temp],Res). + + + +% user defined function +subst_args2(Eq,Depth,Self,[H|PredDecl],Res):- mnotrace(is_user_defined_head(Eq,Self,H)),!, + subst_args30(Eq,Depth,Self,[H|PredDecl],Res). + +% function inherited by system +subst_args2(Eq,Depth,Self,PredDecl,Res):- subst_args40(Eq,Depth,Self,PredDecl,Res). + +/* +last_element(T,E):- \+ compound(T),!,E=T. +last_element(T,E):- is_list(T),last(T,L),last_element(L,E),!. +last_element(T,E):- compound_name_arguments(T,_,List),last_element(List,E),!. + + + + +%catch_warn(G):- notrace(catch_err(G,E,(wdmsg(catch_warn(G)-->E),fail))). +%catch_nowarn(G):- notrace(catch_err(G,error(_,_),fail)). + +%as_tf(G,TF):- catch_nowarn((call(G)*->TF='True';TF='False')). +*/ +subst_selfless([O|_],_):- var(O),!,fail. +subst_selfless(['==',X,Y],TF):- as_tf(X=:=Y,TF),!. +subst_selfless(['==',X,Y],TF):- as_tf(X=Y,TF),!. +subst_selfless(X,Y):- !,eval_selfless(_,_,_,_,X,Y). +/*subst_selfless(['=',X,Y],TF):-!,as_tf(X=Y,TF). +subst_selfless(['>',X,Y],TF):-!,as_tf(X>Y,TF). +subst_selfless(['<',X,Y],TF):-!,as_tf(X',X,Y],TF):-!,as_tf(X>=Y,TF). +subst_selfless(['<=',X,Y],TF):-!,as_tf(X= Bool Atom Atom)) +(= (ift True $then) $then) + +; For anything that is green, assert it is Green in &kb22 +!(ift (green $x) + (add-atom &kb22 (Green $x))) + +; Retrieve the inferred Green things: Fritz and Sam. +!(assertEqualToResult + (match &kb22 (Green $x) $x) + (Fritz Sam)) +*/ +:- discontiguous subst_args3/4. +%subst_args2(Eq,Depth,Self,PredDecl,Res):- subst_args3(Depth,Self,PredDecl,Res). + +%subst_args2(Eq,_Dpth,_Slf,L1,Res):- is_list(L1),maplist(self_subst,L1),!,Res=L1. +%subst_args2(Eq,_Depth,_Self,X,X). + +/* +is_user_defined_head(Eq,Other,H):- mnotrace(is_user_defined_head0(Eq,Other,H)). +is_user_defined_head0(Eq,Other,[H|_]):- !, nonvar(H),!, is_user_defined_head_f(Eq,Other,H). +is_user_defined_head0(Eq,Other,H):- callable(H),!,functor(H,F,_), is_user_defined_head_f(Eq,Other,F). +is_user_defined_head0(Eq,Other,H):- is_user_defined_head_f(Eq,Other,H). + +is_user_defined_head_f(Eq,Other,H):- is_user_defined_head_f1(Eq,Other,H). +is_user_defined_head_f(Eq,Other,H):- is_user_defined_head_f1(Eq,Other,[H|_]). + +%is_user_defined_head_f1(Eq,Other,H):- metta_type(Other,H,_). +is_user_defined_head_f1(Eq,Other,H):- get_metta_atom(Eq,Other,[H|_]). +is_user_defined_head_f1(Eq,Other,H):- metta_eq_def(Eq,Other,[H|_],_). +%is_user_defined_head_f(Eq,_,H):- is_metta_builtin(H). + + +is_special_op(F):- \+ atom(F), \+ var(F), !, fail. +is_special_op('case'). +is_special_op(':'). +is_special_op('='). +is_special_op('->'). +is_special_op('let'). +is_special_op('let*'). +is_special_op('if'). +is_special_op('rtrace'). +is_special_op('or'). +is_special_op('and'). +is_special_op('not'). +is_special_op('match'). +is_special_op('call'). +is_special_op('let'). +is_special_op('let*'). +is_special_op('nop'). +is_special_op('assertEqual'). +is_special_op('assertEqualToResult'). + +is_metta_builtin(Special):- is_special_op(Special). +is_metta_builtin('=='). +is_metta_builtin(F):- once(atom(F);var(F)), current_op(_,yfx,F). +is_metta_builtin('println!'). +is_metta_builtin('transfer!'). +is_metta_builtin('collapse'). +is_metta_builtin('superpose'). +is_metta_builtin('+'). +is_metta_builtin('-'). +is_metta_builtin('*'). +is_metta_builtin('/'). +is_metta_builtin('%'). +is_metta_builtin('=='). +is_metta_builtin('<'). +is_metta_builtin('>'). +is_metta_builtin('all'). +is_metta_builtin('import!'). +is_metta_builtin('pragma!'). +*/ + + +subst_args30(Eq,Depth,Self,H,B):- (subst_args34(Depth,Self,H,B)*->true;subst_args37(Eq,Depth,Self,H,B)). + +subst_args34(_Dpth,Self,H,B):- (metta_eq_def(Eq,Self,H,B);(get_metta_atom(Eq,Self,H),B=H)). + +% Has argument that is headed by the same function +subst_args37(Eq,Depth,Self,[H1|Args],Res):- + mnotrace((append(Left,[[H2|H2Args]|Rest],Args), H2==H1)),!, + subst_args(Eq,RetType,Depth,Self,[H2|H2Args],ArgRes), + mnotrace((ArgRes\==[H2|H2Args], append(Left,[ArgRes|Rest],NewArgs))), + subst_args30(Eq,Depth,Self,[H1|NewArgs],Res). + +subst_args37(Eq,Depth,Self,[[H|Start]|T1],Y):- + mnotrace((is_user_defined_head_f(Eq,Self,H),is_list(Start))), + metta_eq_def(Eq,Self,[H|Start],Left), + subst_args(Eq,RetType,Depth,Self,[Left|T1],Y). + +% Has subterm to subst +subst_args37(Eq,Depth,Self,[F|PredDecl],Res):- + Depth>1, fail, + quietly(sub_sterm1(SSub,PredDecl)), + mnotrace((ground(SSub),SSub=[_|Sub], is_list(Sub),maplist(atomic,SSub))), + subst_args(Eq,RetType,Depth,Self,SSub,Repl), + mnotrace((SSub\=Repl,subst(PredDecl,SSub,Repl,Temp))), + subst_args30(Eq,Depth,Self,[F|Temp],Res). + +%subst_args37(Eq,Depth,Self,X,Y):- (subst_args38(Eq,Depth,Self,X,Y)*->true;metta_atom_iter_l1t(Eq,Depth,Self,[=,X,Y])). + +subst_args37(Eq,Depth,Self,PredDecl,Res):- fail, + ((term_variables(PredDecl,Vars), + (get_metta_atom(Eq,Self,PredDecl) *-> (Vars ==[]->Res='True';Vars=Res); + (subst_args(Eq,RetType,Depth,Self,PredDecl,Res),ignore(Vars ==[]->Res='True';Vars=Res))))), + PredDecl\=@=Res. + +subst_args38(Eq,_Dpth,Self,[H|_],_):- mnotrace( \+ is_user_defined_head_f(Eq,Self,H) ), !,fail. +subst_args38(Eq,_Dpth,Self,[H|T1],Y):- metta_eq_def(Eq,Self,[H|T1],Y). +subst_args38(Eq,_Dpth,Self,[H|T1],'True'):- get_metta_atom(Eq,Self,[H|T1]). +subst_args38(Eq,_Dpth,Self,CALL,Y):- fail,append(Left,[Y],CALL),metta_eq_def(Eq,Self,Left,Y). + + +%subst_args3(Depth,Self,['ift',CR,Then],RO):- fail, !, %fail, % trace, +% metta_eq_def(Eq,Self,['ift',R,Then],Become),subst_args(Eq,RetType,Depth,Self,CR,R),subst_args(Eq,RetType,Depth,Self,Then,_True),subst_args(Eq,RetType,Depth,Self,Become,RO). + +metta_atom_iter_l1t(Eq,_Dpth,Other,[Equal,H,B]):- Eq == Equal,!, + (metta_eq_def(Eq,Other,H,B)*->true;(get_metta_atom(Eq,Other,H),B=H)). + +metta_atom_iter_l1t(Eq,Depth,_,_):- Depth<3,!,fail. +metta_atom_iter_l1t(Eq,_Dpth,_Slf,[]):-!. +metta_atom_iter_l1t(Eq,_Dpth,Other,H):- get_metta_atom(Eq,Other,H). +metta_atom_iter_l1t(Eq,Depth,Other,H):- D2 is Depth -1, metta_eq_def(Eq,Other,H,B),metta_atom_iter_l1t(Eq,D2,Other,B). +metta_atom_iter_l1t(Eq,_Dpth,_Slf,[And]):- is_and(And),!. +metta_atom_iter_l1t(Eq,Depth,Self,[And,X|Y]):- is_and(And),!,D2 is Depth -1, metta_atom_iter_l1t(Eq,D2,Self,X),metta_atom_iter_l1t(Eq,D2,Self,[And|Y]). +/* +metta_atom_iter_l1t2(_,Self,[=,X,Y]):- metta_eq_def(Eq,Self,X,Y). +metta_atom_iter_l1t2(_Dpth,Other,[Equal,H,B]):- '=' == Equal,!, metta_eq_def(Eq,Other,H,B). +metta_atom_iter_l1t2(_Dpth,Self,X,Y):- metta_eq_def(Eq,Self,X,Y). %, Y\=='True'. +metta_atom_iter_l1t2(_Dpth,Self,X,Y):- get_metta_atom(Eq,Self,[=,X,Y]). %, Y\=='True'. + +*/ +metta_atom_iter_l1t_ref(Other,['=',H,B],Ref):-clause(metta_eq_def(Eq,Other,H,B),true,Ref). +metta_atom_iter_l1t_ref(Other,H,Ref):-clause(get_metta_atom(Eq,Other,H),true,Ref). + +%not_compound(Term):- \+ is_list(Term),!. +%subst_args2(Eq,Depth,Self,Term,Res):- maplist(not_compound,Term),!,subst_args345(Depth,Self,Term,Res). + + +% function inherited by system +subst_args40(Eq,Depth,Self,[F|X],FY):- is_function(F), \+ is_special_op(F), is_list(X), + maplist(subst_args(Eq,RetType,Depth,Self),X,Y),!,subst_args5(Depth,Self,[F|Y],FY). +subst_args40(Eq,Depth,Self,FX,FY):- subst_args5(Depth,Self,FX,FY). + +%subst_args5(_Dpth,_Slf,[F|LESS],Res):- once(subst_selfless([F|LESS],Res)),mnotrace(([F|LESS]\==Res)),!. +subst_args5(Depth,Self,[AE|More],TF):- eval_selfless(_,_,Depth,Self,[AE|More],TF),!. +subst_args5(Depth,Self,[AE|More],TF):- is_system_pred(AE), length(More,Len), + (is_syspred(AE,Len,Pred),catch_warn(as_tf(apply(Pred,More),TF)))*->true; + subst_args6(Depth,Self,[AE|More],TF). +subst_args6(_Dpth,_Slf,[AE|More],TF):- is_system_pred(AE),length([AE|More],Len), + is_syspred(AE,Len,Pred),append(More,[TF],Args),!,catch_warn(apply(Pred,Args)). + +%subst_args40(Eq,Depth,Self,[X1|[F2|X2]],[Y1|Y2]):- is_function(F2),!,subst_args(Eq,RetType,Depth,Self,[F2|X2],Y2),subst_args(Eq,RetType,Depth,Self,X1,Y1). + + +%cwdl(DL,Goal):- call_with_depth_limit(Goal,DL,R), (R==depth_limit_exceeded->(!,fail);true). +bagof_subst(Depth,Self,X,L):- !,findall(E,subst_args(Eq,RetType,Depth,Self,X,E),L). +setof_subst(Depth,Self,X,S):- !,findall(E,subst_args(Eq,RetType,Depth,Self,X,E),L),sort(L,S). +%setof_subst(Depth,Self,X,S):- setof(E,subst_args(Eq,RetType,Depth,Self,X,E),S)*->true;S=[]. + + diff --git a/.Attic/canary_docme/metta_testing.pl b/.Attic/canary_docme/metta_testing.pl new file mode 100644 index 00000000000..ea78063dda2 --- /dev/null +++ b/.Attic/canary_docme/metta_testing.pl @@ -0,0 +1,1244 @@ +/* + this is part of (H)MUARC https://logicmoo.org/xwiki/bin/view/Main/ARC/ + + This work may not be copied and used by anyone other than the author Douglas Miles + unless permission or license is granted (contact at business@logicmoo.org) +*/ +%:- encoding(iso_latin_1). + +:- ensure_loaded(library(occurs)). +:- ensure_loaded(metta_utils). + +% Reset loonit counters +loonit_reset :- + flush_output, + loonit_report, + flush_output, + flag(loonit_failure, _, 0), + flag(loonit_success, _, 0). + +has_loonit_results :- loonit_number(FS),FS>1. + +loonit_number(FS) :- flag(loonit_test_number,FS,FS),FS>0,!. +loonit_number(FS) :- + flag(loonit_success, Successes, Successes), + flag(loonit_failure, Failures, Failures), + FS is Successes+Failures+1. + + +string_replace(Original, Search, Replace, Replaced) :- + symbolic_list_concat(Split, Search, Original), + symbolic_list_concat(Split, Replace, Replaced),!. + +get_test_name(Number,TestName) :- + ((nb_current(loading_file,FilePath),FilePath\==[])->true; FilePath='SOME/UNIT-TEST'), + make_test_name(FilePath, Number, TestName). + +ensure_basename(FilePath,FilePath):- \+ directory_file_path(('.'), _, FilePath),!. +ensure_basename(FilePath0,FilePath):- + absolute_file_name(FilePath0,FilePath),!. +ensure_basename(FilePath,FilePath). + +make_test_name(FilePath0, Number, TestName) :- + % Extract the file name and its parent directory from the file path + ensure_basename(FilePath0,FilePath), + file_base_name(FilePath, FileName), + directory_file_path(ParentDir, FileName, FilePath), + file_base_name(ParentDir, ParentDirBase), + % Remove file extension + file_name_extension(Base, _, FileName), + % Convert to uppercase + string_upper(ParentDirBase, UpperParentDirBase), + string_upper(Base, UpperBase), + % Replace "_" with "-" + string_replace(UpperBase, "_", "-", NoUnderscore), + string_replace(UpperParentDirBase, "_", "-", NoUnderscoreParent), + % Format the test name + wots(NS,format('~`0t~d~2|',[Number])), + format(string(TestName), "~w.~w.~w", [NoUnderscoreParent, NoUnderscore, NS]). + + +%color_g_mesg(_,_):- is_compatio,!. +%color_g_mesg(_,_):- silent_loading,!. +color_g_mesg(C,G):- + notrace((nop(check_silent_loading), + color_g_mesg_ok(C,G))). +color_g_mesg_ok(_,G):- is_compatio,!,call(G). +color_g_mesg_ok(C,G):- + quietly(( + wots(S,must_det_ll(user:G)), + (S == "" -> true ; our_ansi_format(C, '~w~n', [S])))),!. + +our_ansi_format(C, Fmt,Args):- \+ atom(C), % set_stream(current_output,encoding(utf8)), + ansi_format(C, Fmt,Args). +our_ansi_format(C, Fmt,Args):- our_ansi_format([fg(C)], Fmt,Args). + +print_current_test:- + loonit_number(Number), + get_test_name(Number,TestName),format('~N~n;

;; ~w

~n',[TestName,TestName]). + +% Increment loonit counters based on goal evaluation + +ensure_increments(Goal):- + setup_call_cleanup( + get_pass_fail(_,_,TotalStart), + Goal, + ((get_pass_fail(_,_,TotalEnd), + if_t(TotalEnd==TotalStart, + flag(loonit_failure,Failures,Failures+1))))). + +get_pass_fail(Successes,Failures,Total):- + flag(loonit_success,Successes,Successes), + flag(loonit_failure,Failures,Failures),!, + Total is Successes+Failures. + + +loonit_asserts(S,Pre,G):- + ensure_increments(loonit_asserts0(S,Pre,G)). + +loonit_asserts0(S,Pre,G):- + flag(loonit_test_number,X,X+1), + copy_term(Pre,Pro), + print_current_test, + once(Pre),!, + ((nb_current(exec_src,Exec),Exec\==[])->true;S=Exec), + write_src(exec(Exec)),nl,nl, + % wots(S,((((nb_current(exec_src,WS),WS\==[])->writeln(WS);write_src(exec(TestSrc)))))), + once(loonit_asserts1(Exec,Pro,G)). + +give_pass_credit(TestSrc,_Pre,_G):- fail, + inside_assert(TestSrc,BaseEval), + always_exec(BaseEval),!. +give_pass_credit(TestSrc,_Pre,G):- + write_pass_fail(TestSrc,'PASS',G), + flag(loonit_success, X, X+1),!, + color_g_mesg(cyan,write_src(loonit_success(G))),!. + +write_pass_fail([P,C,_],PASS_FAIL,G):- + must_det_ll(( + loonit_number(Number), + get_test_name(Number,TestName), + arg(1,G,G1),arg(2,G,G2), write_pass_fail(TestName,P,C,PASS_FAIL,G1,G2))). + +write_pass_fail(TestName,P,C,PASS_FAIL,G1,G2):- + ignore((( + (nb_current(loading_file,FilePath),FilePath\==[])->true; FilePath='SOME/UNIT-TEST.metta'), + symbolic_list_concat([_,R],'tests/',FilePath), + file_name_extension(Base, _, R))), + nop(format('

;; ~w

',[TestName,TestName])), + must_det_ll(( + (tee_file(TEE_FILE)->true;'TEE.ansi'=TEE_FILE), + (( %atom_concat(TEE_FILE,'.UNITS',UNITS), + shared_units(UNITS), + open(UNITS, append, Stream,[encoding(utf8)]), + once(getenv('HTML_FILE',HTML_OUT);sformat(HTML_OUT,'~w.metta.html',[Base])), + compute_html_out_per_test(HTML_OUT,TEE_FILE,TestName,HTML_OUT_PerTest), + get_last_call_duration(Duration), + format(Stream,'| ~w | ~w |[~w](https://logicmoo.org/public/metta/~w#~w) | ~@ | ~@ | ~@ | ~w | ~w |~n', + [TestName,PASS_FAIL,TestName,HTML_OUT,TestName, + trim_gstring_bar_I(write_src_woi([P,C]),400), + trim_gstring_bar_I(write_src_woi(G1),200), + trim_gstring_bar_I(write_src_woi(G2),200), + Duration, + HTML_OUT_PerTest]),!, + close(Stream))))). + +% Needs not to be absolute and not relative to CWD (since tests like all .metta files change their local CWD at least while "loading") +output_directory(OUTPUT_DIR):- getenv('METTALOG_OUTPUT',OUTPUT_DIR),!. +output_directory(OUTPUT_DIR):- getenv('OUTPUT_DIR',OUTPUT_DIR),!. + +shared_units(UNITS):- getenv('SHARED_UNITS',UNITS),!. % Needs not to be relative to CWD +shared_units(UNITS):- output_directory(OUTPUT_DIR),!,directory_file_path(OUTPUT_DIR,'SHARED.UNITS',UNITS). +shared_units(UNITS):- UNITS = '/tmp/SHARED.UNITS'. + +% currently in a shared file per TestCase class.. +% but we might make each test dump its stuffg to its own html file for easier spotting why test failed +compute_html_out_per_test(HTML_OUT,_TEE_FILE,_TestName,HTML_OUT_PerTest):- + HTML_OUT=HTML_OUT_PerTest. + +% Executes Goal and records the execution duration in '$last_call_duration'. +% The duration is recorded regardless of whether Goal succeeds or fails. +record_call_duration(Goal) :- + nb_setval('$last_call_duration', 120), + statistics(cputime, Start), % Get the start CPU time + ( call(Goal) % Call the Goal + *-> EndResult = true % If Goal succeeds, proceed + ; EndResult = false % If Goal fails, record it but proceed + ), + statistics(cputime, End), % Get the end CPU time + Duration is End - Start, % Calculate the CPU duration + nb_setval('$last_call_duration', Duration), % Set the global variable non-backtrackably + EndResult. % Preserve the result of the Goal + +% Helper to retrieve the last call duration stored in the global variable. +get_last_call_duration(Duration) :- + nb_getval('$last_call_duration', Duration),!. + + +trim_gstring_bar_I(Goal, MaxLen) :- + wots(String0,Goal), + string_replace(String0,'|','I',String1), + string_replace(String1,'\n','\\n',String), + atom_length(String, Len), + ( Len =< MaxLen + -> Trimmed = String + ; SubLen is MaxLen, + sub_atom(String, 0, SubLen, _, SubStr), + string_concat(SubStr, "...", Trimmed) + ), + write(Trimmed). + +loonit_asserts1(TestSrc,Pre,G) :- _=nop(Pre),record_call_duration(call(G)), + give_pass_credit(TestSrc,Pre,G),!. + +/* +loonit_asserts1(TestSrc,Pre,G) :- fail, + sub_var('BadType',TestSrc), \+ check_type,!, + write('\n!check_type (not considering this a failure)\n'), + color_g_mesg('#D8BFD8',write_src(loonit_failureR(G))),!, + ignore((( + option_value('on-fail','trace'), + setup_call_cleanup(debug(metta(eval)),call((Pre,G)),nodebug(metta(eval)))))). +*/ + +loonit_asserts1(TestSrc,Pre,G) :- + must_det_ll(( + color_g_mesg(red,write_src(loonit_failureR(G))), + write_pass_fail(TestSrc,'FAIL',G), + flag(loonit_failure, X, X+1), + %itrace, G. + if_t(option_value('on-fail','repl'),repl), + if_t(option_value('on-fail','trace'), + setup_call_cleanup(debug(metta(eval)),call((Pre,G)),nodebug(metta(eval)))))). + %(thread_self(main)->trace;sleep(0.3)) + +% Generate loonit report with colorized output +:- dynamic(gave_loonit_report/0). +loonit_report:- gave_loonit_report,!. +loonit_report :- + assert(gave_loonit_report), + flag(loonit_success, Successes, Successes), + flag(loonit_failure, Failures, Failures), + loonit_report(Successes,Failures), + if_t((Successes==0;Failures>0), + if_t(option_value(repl,failures);option_value(frepl,true),repl)). + +:- at_halt(loonit_report). + + +loonit_report(0,0):-!. % ansi_format([fg(yellow)], 'Nothing to report~n', []). +loonit_report(Successes,Failures):- + ansi_format([bold], 'LoonIt Report~n',[]), + format('------------~n'), + ansi_format([fg(green)], 'Successes: ~w~n', [Successes]), + ((integer(Failures),Failures>0) -> ansi_format([fg(red)], 'Failures: ~w~n', [Failures]);ansi_format([fg(green)], 'Failures: ~w~n', [Failures])). + +% Resets loonit counters, consults the given file, and prints the status report. +loon_metta(File) :- + flag(loonit_success, WasSuccesses, 0), + flag(loonit_failure, WasFailures, 0), + load_metta(File), + loonit_report, + flag(loonit_success, _, WasSuccesses), + flag(loonit_failure, _, WasFailures),!. + + +:- dynamic(file_answers/3). +:- dynamic(file_exec_num/2). + +% set_exec_num/2 +% Update or assert the execution number for the given file. + +set_exec_num(SFileName, Val) :- + absolute_file_name(SFileName,FileName), + ( retract(file_exec_num(FileName, _)) % If an entry exists, retract it + -> true + ; true % Otherwise, do nothing + ), + asserta(file_exec_num(FileName, Val)). % Assert the new value + +% get_exec_num/2 +% Retrieve the execution number for the given file. If none exists, it returns 0. +get_exec_num(Val):- + current_exec_file_abs(FileName), + file_exec_num(FileName, Val),!. +get_exec_num(FileName, Val) :- + ( file_exec_num(FileName, CurrentVal) + -> Val = CurrentVal + ; Val = 0 + ). + + current_exec_file_abs(FileName):- + current_exec_file(SFileName), + absolute_file_name(SFileName,FileName),!. + + +get_expected_result(Ans):- + ignore(( + current_exec_file_abs(FileName), + file_exec_num(FileName, Nth), + file_answers(FileName, Nth, Ans))),!. + + + +got_exec_result(Val):- + ignore(( + current_exec_file_abs(FileName), + file_exec_num(FileName, Nth), + file_answers(FileName, Nth, Ans), + got_exec_result(Val,Ans))). + + +got_exec_result(Val,Ans):- + must_det_ll(( + current_exec_file_abs(FileName), + file_exec_num(FileName, Nth), + Nth100 is Nth+100, + get_test_name(Nth100,TestName), + nb_current(exec_src,Exec), + (equal_enough_for_test(Val,Ans) + -> write_pass_fail_result(TestName,exec,Exec,'PASS',Ans,Val) + ; write_pass_fail_result(TestName,exec,Exec,'FAIL',Ans,Val)))). + +write_pass_fail_result(TestName,exec,Exec,PASS_FAIL,Ans,Val):- + nl,writeq(write_pass_fail_result(TestName,exec,Exec,PASS_FAIL,Ans,Val)),nl, + write_pass_fail(TestName,exec,Exec,PASS_FAIL,Ans,Val). + + +current_exec_file(FileName):- nb_current(loading_file,FileName). + +% inc_exec_num/1 +% Increment the execution number for the given file. If no entry exists, initialize it to 1. +inc_exec_num :- current_exec_file_abs(FileName),!,inc_exec_num(FileName). +inc_exec_num(FileName) :- + ( retract(file_exec_num(FileName, CurrentVal)) + -> NewVal is CurrentVal + 1 + ; NewVal = 1 + ), + asserta(file_exec_num(FileName, NewVal)). + + +load_answer_file(File):- ( \+ atom(File); \+ is_absolute_file_name(File); \+ exists_file(File)), + absolute_file_name(File,AbsFile), File\=@=AbsFile, load_answer_file_now(AbsFile),!. +load_answer_file(File):- load_answer_file_now(File),!. +load_answer_file_now(File) :- + ignore(( + ensure_extension(File, answers, AnsFile), + remove_specific_extension(AnsFile, answers, StoredAs), + set_exec_num(StoredAs,1), + fbug(load_answer_file(AnsFile,StoredAs)), + load_answer_file(AnsFile,StoredAs))). + +load_answer_file(AnsFile,StoredAs):- + ( file_answers(StoredAs,_, _) -> true + ; ( \+ exists_file(AnsFile) -> true + ; (setup_call_cleanup( + open(AnsFile, read, Stream, [encoding(utf8)]), + (load_answer_stream(1,StoredAs, Stream)), + close(Stream))))), + set_exec_num(StoredAs,1),!. + +:- debug(metta(answers)). +load_answer_stream(_Nth, StoredAs, Stream):- at_end_of_stream(Stream),!, + if_trace((answers), + prolog_only(listing(file_answers(StoredAs,_,_)))). +load_answer_stream(Nth, StoredAs, Stream):- + read_line_to_string(Stream, String), + load_answer_stream(Nth, StoredAs, String, Stream). +/* +load_answer_stream(Nth, StoredAs, String, Stream) :- fail, + atom_chars(String,Chars), + count_brackets(Chars, 0, 0, Balance), + ( Balance =< 0 + -> StoredAs = String + ; read_line_to_string(Stream, NextString), + string_concat(String, "\n", StringWithNewLine), + string_concat(StringWithNewLine, NextString, CombinedString), + load_answer_stream(Nth, StoredAs, CombinedString, Stream) + ). +*/ +load_answer_stream(Nth, StoredAs, String, Stream):- % string_concat("[",_,String),!, + fbug(Nth = String), + parse_answer_string(String,Metta),!, + %if_t(sub_var(',',Metta),rtrace(parse_answer_string(String,_Metta2))), + pfcAdd_Now(file_answers(StoredAs,Nth,Metta)), + skip(must_det_ll(\+ sub_var(',',Metta))), + Nth2 is Nth+1,load_answer_stream(Nth2, StoredAs, Stream). + +load_answer_stream(Nth, StoredAs, _, Stream):- load_answer_stream(Nth, StoredAs, Stream). +/* +count_brackets([], Open, Close, Balance) :- !, + Balance is Open - Close. +count_brackets([Char|Rest], Open, Close, Balance) :- + (((( Char == '[' + -> NewOpen is Open + 1 + ; (Char == ']' + -> NewClose is Close + 1 + ; (NewOpen = Open, + NewClose = Close)))))), + count_brackets(Rest, NewOpen, NewClose, Balance). +*/ +parse_answer_string("[]",[]):- !. +%parse_answer_string(String,Metta):- string_concat("(",_,String),!,parse_sexpr_metta(String,Metta),!. +parse_answer_string(String,_Metta):- string_concat("[(Error (assert",_,String),!,fail. +parse_answer_string(String,_Metta):- string_concat("Expected: [",Mid,String),string_concat(_Expected_Inner,"]",Mid),!,fail. +parse_answer_string(String,Metta):- string_concat("Got: [",Mid,String),string_concat(Got_Inner,"]",Mid),!,parse_answer_inner(Got_Inner,Metta). +parse_answer_string(String,Metta):- string_concat("[",Mid,String),string_concat(Inner0,"]",Mid),!,parse_answer_inner(Inner0,Metta). + + +parse_answer_inner(Inner0,Metta):- must_det_ll(( replace_in_string([', '=' , '],Inner0,Inner), parse_answer_str(Inner,Metta), + skip((\+ sub_var(',',rc(Metta)))))). + +parse_answer_str(Inner,[C|Metta]):- + atomics_to_string(["(",Inner,")"],Str), + parse_sexpr_metta(Str,CMettaC), CMettaC=[C|MettaC], + ((remove_m_commas(MettaC,Metta), + \+ sub_var(',',rc(Metta)))). +parse_answer_str(Inner0,Metta):- symbolic_list_concat(InnerL,' , ',Inner0), maplist(atom_string,InnerL,Inner), maplist(parse_sexpr_metta,Inner,Metta),skip((must_det_ll(( \+ sub_var(',',rc2(Metta)))))),!. +parse_answer_str(Inner0,Metta):- + (( replace_in_string([' , '=' '],Inner0,Inner), + atomics_to_string(["(",Inner,")"],Str),!, + parse_sexpr_metta(Str,Metta),!, + skip((must_det_ll(\+ sub_var(',',rc3(Metta))))), + skip((\+ sub_var(',',rc(Metta)))))). + +%parse_answer_string(String,Metta):- String=Metta,!,fail. + +remove_m_commas(Metta,Metta):- \+ sub_var(',',Metta),!. +remove_m_commas([C,H|T],[H|TT]):- C=='and', !, remove_m_commas(T,TT). +remove_m_commas([C,H|T],[H|TT]):- C==',', !, remove_m_commas(T,TT). +remove_m_commas([H|T],[H|TT]):- !, remove_m_commas(T,TT). + + +% Example usage: +% ?- change_extension('path/to/myfile.txt', 'pdf', NewFileName). +% NewFileName = 'path/to/myfile.pdf'. +change_extension(OriginalFileName, NewExtension, NewBaseName) :- + %file_base_name(OriginalFileName, BaseName), % Extract base name + file_name_extension(BaseWithoutExt, _, OriginalFileName), % Split extension + file_name_extension(BaseWithoutExt, NewExtension, NewBaseName),!. % Create new base name with new extension + %directory_file_path(Directory, NewBaseName, NewFileName). % Join with directory path +% Example usage: +% ?- ensure_extension('path/to/myfile.txt', 'txt', NewFileName). +% NewFileName = 'path/to/myfile.txt'. +ensure_extension(OriginalFileName, Extension, NewFileName) :- + file_name_extension(_, CurrentExt, OriginalFileName), + ( CurrentExt = Extension + -> NewFileName = OriginalFileName + ; atom_concat(OriginalFileName, '.', TempFileName), + atom_concat(TempFileName, Extension, NewFileName) + ). +% Example usage: +% ?- remove_specific_extension('path/to/myfile.txt', 'txt', NewFileName). +% NewFileName = 'path/to/myfile'. + +% ?- remove_specific_extension('path/to/myfile.txt', 'pdf', NewFileName). +% NewFileName = 'path/to/myfile.txt'. +remove_specific_extension(OriginalFileName, Extension, FileNameWithoutExtension) :- + file_name_extension(FileNameWithoutExtension, Ext, OriginalFileName), + ( Ext = Extension -> true ; FileNameWithoutExtension = OriginalFileName ). + + +quick_test:- + %set_prolog_flag(encoding,iso_latin_1), + forall(quick_test(Test), + forall(open_string(Test,Stream), + load_metta_stream('&self',Stream))). + +/* + tests for term expander + + +*/ +% :- debug(term_expansion). +:- if(( false, debugging(term_expansion))). +:- enable_arc_expansion. +:- style_check(-singleton). +dte:- set(_X.local) = val. +dte:- gset(_X.global) = gval. +dte:- must_det_ll((set(_X.a) = b)). +dte:- must_det_ll(locally(nb_setval(e,X.locally),dte([foo|set(X.tail)]))). +dte:- member(set(V.element),set(V.list)). +dte(set(E.v)):- set(E.that)=v. +:- style_check(+singleton). +:- disable_arc_expansion. +:- listing(dte). +:- endif. + + + +% 1. Recursive Approach +factorial_recursive(0, 1). +factorial_recursive(N, Result) :- + N > 0, + N1 is N - 1, + factorial_recursive(N1, Result1), + Result is N * Result1. + +% 2. Tail Recursive Approach +factorial_tail_recursive(N, Result) :- factorial_tail_helper(N, 1, Result). + +factorial_tail_helper(0, Acc, Acc). +factorial_tail_helper(N, Acc, Result) :- + N > 0, + NewAcc is Acc * N, + N1 is N - 1, + factorial_tail_helper(N1, NewAcc, Result). + +% 3. Accumulator Approach +factorial_accumulator(N, Result) :- factorial_acc(N, 1, Result). + +factorial_acc(0, Result, Result). +factorial_acc(N, Acc, Result) :- + N > 0, + NewAcc is Acc * N, + N1 is N - 1, + factorial_acc(N1, NewAcc, Result). + +% You can test each one by querying, for example: +% ?- factorial_recursive(5, X + + + + + + +% Example-usage +example_usages :- + fetch_or_create_space(newSpace,Space), % Assuming fetch_or_create_space/1 is defined to initialize a space + 'add-atom'(Space, a), + 'add-atom'(Space, b), + 'add-atom'(Space, c), + 'match'(Space, a, Template), + write('Matched template: '), writeln(Template), + + + write('Initial space: '), writeln(Space), + + 'add-atom'(Space, a), + write('Space after adding "a": '), writeln(Space), + + 'add-atom'(Space, b), + write('Space after adding "b": '), writeln(Space), + + 'replace-atom'(Space, a, c), + write('Space after replacing "a" with "c": '), writeln(Space), + + 'get-atoms'(Space, Atoms), + write('Atoms in space: '), writeln(Atoms), + + 'atom-count'(Space, Count), + write('Number of atoms in space: '), writeln(Count). + +% Test case for clearing a space +test_clear_space :- + writeln('Test: Clearing a space'), + init_space('&kb1'), + 'add-atom'('&kb1', a), + 'add-atom'('&kb1', b), + writeln('Expected Count Before Clearing: 2'), + 'atom-count'('&kb1', CountBefore), writeln('Actual Count:'), writeln(CountBefore), + writeln('Expected Atoms Before Clearing: [b, a]'), + 'get-atoms'('&kb1', AtomsBefore), writeln('Actual Atoms:'), writeln(AtomsBefore), + 'clear-atoms'('&kb1'), + writeln('Expected Count After Clearing: 0'), + 'atom-count'('&kb1', CountAfter), writeln('Actual Count:'), writeln(CountAfter), + writeln('Expected Atoms After Clearing: []'), + 'get-atoms'('&kb1', AtomsAfter), writeln('Actual Atoms:'), writeln(AtomsAfter). + +% Test case for various operations on a space +test_operations :- + writeln('Test: Various Operations on a Space'), + init_space('&kb2'), + 'add-atom'('&kb2', a), + 'add-atom'('&kb2', b), + writeln('Expected Count After Adding: 2'), + 'atom-count'('&kb2', Count1), writeln('Actual Count:'), writeln(Count1), + writeln('Expected Atoms After Adding: [b, a]'), + 'get-atoms'('&kb2', Atoms1), writeln('Actual Atoms:'), writeln(Atoms1), + 'remove-atom'('&kb2', a), + writeln('Expected Atoms After Removing a: [b]'), + 'get-atoms'('&kb2', Atoms2), writeln('Actual Atoms:'), writeln(Atoms2), + 'replace-atom'('&kb2', b, c), + writeln('Expected Atoms After Replacing b with c: [c]'), + 'get-atoms'('&kb2', Atoms3), writeln('Actual Atoms:'), writeln(Atoms3). + +% Run the test cases +run_tests :- + writeln('Running test_clear_space:'), + test_clear_space, + writeln('---'), + writeln('Running test_operations:'), + test_operations. + + +% Test case for various operations on a space +test_my_space :- + fetch_or_create_space('&KB', InstanceOfKB), + 'clear-atoms'('&KB'), + 'add-atom'(InstanceOfKB, a), + 'add-atom'(InstanceOfKB, b), + 'atom-count'(InstanceOfKB, Count1), + writeln('Should print 2: ' : Count1), + + 'get-atoms'(InstanceOfKB, Atoms1), + writeln('Should print [b, a]: ' : Atoms1), + + 'remove-atom'(InstanceOfKB, a), + 'get-atoms'(InstanceOfKB, Atoms2), + writeln('Should print [b]: ' : Atoms2), + + 'replace-atom'(InstanceOfKB, b, c), + 'get-atoms'(InstanceOfKB, Atoms3), + writeln('Should print [c]: ' : Atoms3), + + space_original_name(InstanceOfKB, OriginalName), + writeln('Should print &KB':OriginalName), + + fetch_or_create_space('&KB'), + 'add-atom'('&KB', x), + 'add-atom'('&KB', y), + 'atom-count'('&KB', Count2), + writeln('Should print 3: ' : Count2), + + 'get-atoms'('&KB', Atoms4), + writeln('Should print [c, y, x]: ' : Atoms4), + + 'remove-atom'('&KB', x), + 'get-atoms'('&KB', Atoms5), + writeln('Should print [c,y]: ' : Atoms5), + + 'replace-atom'('&KB', y, z), + 'get-atoms'(InstanceOfKB, Atoms6), + writeln('Should print [c,z]: ' : Atoms6). + + +% Test the code +test_clr_my_kb22 :- + fetch_or_create_space('&kb22'), + 'add-atom'('&kb22', a), + 'add-atom'('&kb22', b), + 'atom-count'('&kb22', Count1), writeln(Count1), + 'get-atoms'('&kb22', Atoms1), writeln(Atoms1), + 'clear-atoms'('&kb22'), + 'atom-count'('&kb22', Count2), writeln(Count2), + 'get-atoms'('&kb22', Atoms2), writeln(Atoms2). + + %a:- !, be(B), (iF(A,B) -> tHEN(A) ). + %a:- !, be(B), (iF(A,B) *-> tHEN(A) ; eLSE(B) ). + + +% Test the code +test_my_kb2:- + fetch_or_create_space('&kb1', InstanceOfKB), + \+ \+ ('add-atom'('&kb1', a, Out), writeln(Out)), + \+ \+ ('add-atom'('&kb1', b, Out), writeln(Out)), + \+ \+ ('atom-count'('&kb1', Count), writeln(Count)), + \+ \+ ('get-atoms'('&kb1', Atoms), writeln(Atoms)), + \+ \+ ('remove-atom'(InstanceOfKB, a, Out), writeln(Out)), + \+ \+ ('get-atoms'('&kb1', NewAtoms), writeln(NewAtoms)), + \+ \+ ('replace-atom'('&kb1', b, c, Out), writeln(Out)), + \+ \+ ('get-atoms'('&kb1', FinalAtoms), writeln(FinalAtoms)), + \+ \+ (space_original_name(InstanceOfKB, OriginalName), writeln(OriginalName)), + \+ \+ (fetch_or_create_space('&kb2',_)), % Creating a new space with a different name + \+ \+ ('add-atom'('&kb2', a, Out), writeln(Out)), + \+ \+ ('add-atom'('&kb2', b, Out), writeln(Out)), + \+ \+ ('atom-count'('&kb2', Count), writeln(Count)), + \+ \+ ('get-atoms'('&kb2', Atoms), writeln(Atoms)), + \+ \+ ('remove-atom'('&kb2', a, Out), writeln(Out)), + \+ \+ ('get-atoms'('&kb2', NewAtoms), writeln(NewAtoms)), + \+ \+ ('replace-atom'('&kb2', b, c, Out), writeln(Out)), + \+ \+ ('get-atoms'('&kb2', FinalAtoms), writeln(FinalAtoms)). + + + + +end_of_file. % comment this out once to get these files in your readline history +mf('./1-VSpaceTest.metta'). +mf('./2-VSpaceTest.metta'). +mf('./3-Learn-Rules.metta'). +mf('./4-VSpaceTest.metta'). +mf('./5-Learn-Flybase.metta'). +mf('./6-Learn-Flybase-Full.metta'). +mf('./8-VSpaceTest.metta'). +mf('./autoexec.metta'). +mf('./data/OBO-Metta/export/Alliance_of_Genome_Resources.metta'). +mf('./data/OBO-Metta/export/biosapiens.metta'). +mf('./data/OBO-Metta/export/chebi_fb_2023_04.metta'). +mf('./data/OBO-Metta/export/DBVAR.metta'). +mf('./data/OBO-Metta/export/doid.metta'). +mf('./data/OBO-Metta/export/flybase_controlled_vocabulary.metta'). +mf('./data/OBO-Metta/export/flybase_stock_vocabulary.metta'). +mf('./data/OBO-Metta/export/fly_anatomy.metta'). +mf('./data/OBO-Metta/export/fly_development.metta'). +mf('./data/OBO-Metta/export/gene_group_FB2023_04.metta'). +mf('./data/OBO-Metta/export/go-basic.metta'). +mf('./data/OBO-Metta/export/image.metta'). +mf('./data/OBO-Metta/export/psi-mi.metta'). +mf('./data/OBO-Metta/export/slice.chebi.metta'). +mf('./data/OBO-Metta/export/so-simple.metta'). +mf('./data/OBO-Metta/export/so.metta'). +mf('./data/OBO-Metta/export/SOFA.metta'). +mf('./examples/compat/common/BelieveMe.metta'). +mf('./examples/compat/common/EqualityType.metta'). +mf('./examples/compat/common/EqualityTypeTest.metta'). +mf('./examples/compat/common/formula/DeductionFormula.metta'). +mf('./examples/compat/common/formula/DeductionFormulaTest.metta'). +mf('./examples/compat/common/formula/ImplicationDirectIntroductionFormula.metta'). +mf('./examples/compat/common/formula/ModusPonensFormula.metta'). +mf('./examples/compat/common/In.metta'). +mf('./examples/compat/common/InTest.metta'). +mf('./examples/compat/common/List.metta'). +mf('./examples/compat/common/ListTest.metta'). +mf('./examples/compat/common/Maybe.metta'). +mf('./examples/compat/common/MaybeTest.metta'). +mf('./examples/compat/common/Num.metta'). +mf('./examples/compat/common/NumTest.metta'). +mf('./examples/compat/common/OrderedSet.metta'). +mf('./examples/compat/common/OrderedSetTest.metta'). +mf('./examples/compat/common/Record.metta'). +mf('./examples/compat/common/truthvalue/EvidentialTruthValue.metta'). +mf('./examples/compat/common/truthvalue/EvidentialTruthValueTest.metta'). +mf('./examples/compat/common/truthvalue/MeasEq.metta'). +mf('./examples/compat/common/truthvalue/TemporalTruthValue.metta'). +mf('./examples/compat/common/truthvalue/TruthValue.metta'). +mf('./examples/compat/common/truthvalue/TruthValueTest.metta'). +mf('./examples/compat/dependent-types/DeductionDTL.metta'). +mf('./examples/compat/dependent-types/DeductionDTLTest.metta'). +mf('./examples/compat/dependent-types/DeductionImplicationDirectIntroductionDTLTest.metta'). +mf('./examples/compat/dependent-types/ImplicationDirectIntroductionDTL.metta'). +mf('./examples/compat/dependent-types/ImplicationDirectIntroductionDTLTest.metta'). +mf('./examples/compat/dependent-types/ModusPonensDTL.metta'). +mf('./examples/compat/dependent-types/ModusPonensDTLTest.metta'). +mf('./examples/compat/entail/DeductionEntail.metta'). +mf('./examples/compat/entail/DeductionEntailTest.metta'). +mf('./examples/compat/entail/ImplicationDirectIntroductionEntail.metta'). +mf('./examples/compat/entail/ImplicationDirectIntroductionEntailTest.metta'). +mf('./examples/compat/equal/DeductionEqual.metta'). +mf('./examples/compat/equal/DeductionEqualTest.metta'). +mf('./examples/compat/equal/ImplicationDirectIntroductionEqual.metta'). +mf('./examples/compat/equal/ImplicationDirectIntroductionEqualTest.metta'). +mf('./examples/compat/match/DeductionImplicationDirectIntroductionMatchTest.metta'). +mf('./examples/compat/match/DeductionMatch.metta'). +mf('./examples/compat/match/DeductionMatchTest.metta'). +mf('./examples/compat/match/ImplicationDirectIntroductionMatch.metta'). +mf('./examples/compat/match/ImplicationDirectIntroductionMatchTest.metta'). +mf('./examples/compat/prob-dep-types/inf_order_probs.metta'). +mf('./examples/compat/prob-dep-types/prob_dep_types.metta'). +mf('./examples/compat/recursion-schemes/src/base.metta'). +mf('./examples/compat/recursion-schemes/src/examples/benchmark.metta'). +mf('./examples/compat/recursion-schemes/src/examples/expression.metta'). +mf('./examples/compat/recursion-schemes/src/schemes.metta'). +mf('./examples/compat/synthesis/experiments/non-determinism.metta'). +mf('./examples/compat/synthesis/experiments/self-contained-synthesize.metta'). +mf('./examples/compat/synthesis/experiments/synthesize-via-case-test.metta'). +mf('./examples/compat/synthesis/experiments/synthesize-via-case.metta'). +mf('./examples/compat/synthesis/experiments/synthesize-via-let-test.metta'). +mf('./examples/compat/synthesis/experiments/synthesize-via-let.metta'). +mf('./examples/compat/synthesis/experiments/synthesize-via-superpose.metta'). +mf('./examples/compat/synthesis/experiments/synthesize-via-type-checking.metta'). +mf('./examples/compat/synthesis/experiments/synthesize-via-unify-test.metta'). +mf('./examples/compat/synthesis/experiments/synthesize-via-unify.metta'). +mf('./examples/compat/synthesis/experiments/unify-via-case.metta'). +mf('./examples/compat/synthesis/experiments/unify-via-let.metta'). +mf('./examples/compat/synthesis/Synthesize.metta'). +mf('./examples/compat/synthesis/SynthesizeTest.metta'). +mf('./examples/compat/synthesis/Unify.metta'). +mf('./examples/compat/synthesis/UnifyTest.metta'). +mf('./examples/compat/test_scripts/a1_symbols.metta'). +mf('./examples/compat/test_scripts/a2_opencoggy.metta'). +mf('./examples/compat/test_scripts/a3_twoside.metta'). +mf('./examples/compat/test_scripts/b0_chaining_prelim.metta'). +mf('./examples/compat/test_scripts/b1_equal_chain.metta'). +mf('./examples/compat/test_scripts/b2_backchain.metta'). +mf('./examples/compat/test_scripts/b3_direct.metta'). +mf('./examples/compat/test_scripts/b4_nondeterm.metta'). +mf('./examples/compat/test_scripts/b5_types_prelim.metta'). +mf('./examples/compat/test_scripts/c1_grounded_basic.metta'). +mf('./examples/compat/test_scripts/c2_spaces.metta'). +mf('./examples/compat/test_scripts/c2_spaces_kb.metta'). +mf('./examples/compat/test_scripts/c3_pln_stv.metta'). +mf('./examples/compat/test_scripts/d1_gadt.metta'). +mf('./examples/compat/test_scripts/d2_higherfunc.metta'). +mf('./examples/compat/test_scripts/d3_deptypes.metta'). +mf('./examples/compat/test_scripts/d4_type_prop.metta'). +mf('./examples/compat/test_scripts/d5_auto_types.metta'). +mf('./examples/compat/test_scripts/e1_kb_write.metta'). +mf('./examples/compat/test_scripts/e2_states.metta'). +mf('./examples/compat/test_scripts/e3_match_states.metta'). +mf('./examples/compat/test_scripts/f1_imports.metta'). +mf('./examples/compat/test_scripts/f1_moduleA.metta'). +mf('./examples/compat/test_scripts/f1_moduleB.metta'). +mf('./examples/compat/test_scripts/f1_moduleC.metta'). +mf('./examples/compat/test_scripts/_e2_states_dia.metta'). +mf('./examples/fibo.metta'). +mf('./examples/fwgc.metta'). +mf('./examples/httpclient.metta'). +mf('./examples/NARS.metta'). +mf('./examples/NARS_listing.metta'). +mf('./examples/RUN_minnars.metta'). +mf('./examples/RUN_tests0.metta'). +mf('./examples/RUN_tests1.metta'). +mf('./examples/RUN_tests2.metta'). +mf('./examples/RUN_tests3.metta'). +mf('./examples/send-more.metta'). +mf('./examples/talk80.metta'). +mf('./examples/VRUN_tests0.metta'). +mf('./examples/VRUN_tests1.metta'). +mf('./examples/VRUN_tests2.metta'). +mf('./examples/VRUN_tests3.metta'). +mf('./src/nm_test.metta'). +mf('./src/r.metta'). +mf('./src/test_nspace.metta'). +:- forall(mf(H),add_history1(load_metta(H))). +%:- load_metta + + + + + +end_of_file. + + + +parsing(String, Expr) :- string(String),!,string_codes(String,Codes),phrase(expressions(Expr), Codes). +parsing(String, Expr) :- phrase(expressions(Expr), String). + +expressions([E|Es]) --> + ws, expression(E), ws, + !, % single solution: longest input match + expressions(Es). +expressions([]) --> []. + +% ws --> ";",until_eol, +ws --> [W], { code_type(W, space) }, ws. +ws --> []. + +% A number N is represented as n(N), a symbol S as s(S). + +expression(s(A)) --> symbol(Cs), { atom_codes(A, Cs) }. +expression(n(N)) --> number(Cs), { number_codes(N, Cs) }. +expression(List) --> [L],{is_bracket_lr(L,R)},expressions(List), [R]. +expression([s(quote),Q]) --> "'", expression(Q). + +number([D|Ds]) --> digit(D), number(Ds). +number([D]) --> digit(D). + +digit(D) --> [D], { code_type(D, digit) }. + +symbol([A|As]) --> + [A], + { is_ok_symbolchar(A) }, + symbolr(As). + +symbolr([A|As]) --> + [A], + { is_ok_symbolchar(A) ; code_type(A, alnum) }, + symbolr(As). +symbolr([]) --> []. + +is_bracket_lr(L,R):- member(LR,["()","{}","[]","\"\""]), nth0(0,LR,L),nth0(1,LR,R). +is_ok_symbolchar(A):- \+ code_type(A, space), \+ code_type(A, white), \+ is_bracket_lr(A,_), \+ is_bracket_lr(_,A). + +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + Interpretation + -------------- + + Declaratively, execution of a Lisp form is a relation between the + (function and variable) binding environment before its execution + and the environment after its execution. A Lisp program is a + sequence of Lisp forms, and its result is the sequence of their + results. The environment is represented as a pair of association + lists Fs-Vs, associating function names with argument names and + bodies, and variables with values. DCGs are used to implicitly + thread the environment state through. +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + +codelist_to_forms_i(AsciiCodesList,FormsOut):- + parsing(AsciiCodesList, Forms0), + compile_all(Forms0, FormsOut),!. + +run(Program, Values) :- + parsing(Program, Forms0), + empty_assoc(E), + compile_all(Forms0, Forms), + writeq(seeingFormas(Forms)),nl, + phrase(eval_all(Forms, Values0), [E-E], _), + maplist(unfunc, Values0, Values). + +unfunc(s(S), S). +unfunc(t, t). +unfunc(n(N), N). +unfunc([], []). +unfunc([Q0|Qs0], [Q|Qs]) :- unfunc(Q0, Q), unfunc(Qs0, Qs). + +fold([], _, V, n(V)). +fold([n(F)|Fs], Op, V0, V) :- E =.. [Op,V0,F], V1 is E, fold(Fs, Op, V1, V). + +compile_all(Fs0, Fs) :- maplist(compile, Fs0, Fs). + +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + compile/2 marks (with 'user/1') calls of user-defined functions. + This eliminates an otherwise defaulty representation of function + calls and thus allows for first argument indexing in eval//3. +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + +compile(F0, F) :- + ( F0 = n(_) -> F = F0 + ; F0 = s(t) -> F = t + ; F0 = s(nil) -> F = [] + ; F0 = s(_) -> F = F0 + ; F0 = [] -> F = [] + ; F0 = [s(quote),Arg] -> F = [quote,Arg] + ; F0 = [s(setq),s(Var),Val0] -> compile(Val0, Val), F = [setq,Var,Val] + ; F0 = [s(Op)|Args0], + memberchk(Op, [+,-,*,equal,if,>,<,=,progn,eval,list,car,cons, + cdr,while,not]) -> + compile_all(Args0, Args), + F = [Op|Args] + ; F0 = [s(defun),s(Name),Args0|Body0] -> + compile_all(Body0, Body), + maplist(arg(1), Args0, Args), + F = [defun,Name,Args|Body] + ; F0 = [s(Op)|Args0] -> compile_all(Args0, Args), F = [user(Op)|Args] + ). + +eval_all([], []) --> []. +eval_all([A|As], [B|Bs]) --> eval(A, B), eval_all(As, Bs). + +eval(n(N), n(N)) --> []. +eval(t, t) --> []. +eval([], []) --> []. +eval(s(A), V), [Fs-Vs] --> [Fs-Vs], { get_assoc(A, Vs, V) }. +eval([L|Ls], Value) --> eval(L, Ls, Value). + +eval(quote, [Q], Q) --> []. +eval(+, As0, V) --> eval_all(As0, As), { fold(As, +, 0, V) }. +eval(-, As0, V) --> eval_all(As0, [n(V0)|Vs0]), { fold(Vs0, -, V0, V) }. +eval(*, As0, V) --> eval_all(As0, Vs), { fold(Vs, *, 1, V) }. +eval(car, [A], C) --> eval(A, V), { V == [] -> C = [] ; V = [C|_] }. +eval(cdr, [A], C) --> eval(A, V), { V == [] -> C = [] ; V = [_|C] }. +eval(list, Ls0, Ls) --> eval_all(Ls0, Ls). +eval(not, [A], V) --> eval(A, V0), goal_truth(V0=[], V). +eval(>, [A,B], V) --> eval(A, n(V1)), eval(B, n(V2)), goal_truth(V1>V2, V). +eval(<, [A,B], V) --> eval(>, [B,A], V). +eval(=, [A,B], V) --> eval(A, n(V1)), eval(B, n(V2)), goal_truth(V1=:=V2, V). +eval(progn, Ps, V) --> eval_all(Ps, Vs), { last(Vs, V) }. +eval(eval, [A], V) --> eval(A, F0), { compile(F0, F1) }, eval(F1, V). +eval(equal, [A,B], V) --> eval(A, V1), eval(B, V2), goal_truth(V1=V2, V). +eval(cons, [A,B], [V0|V1]) --> eval(A, V0), eval(B, V1). +eval(while, [Cond|Bs], []) --> + ( eval(Cond, []) -> [] + ; eval_all(Bs, _), + eval(while, [Cond|Bs], _) + ). +eval(defun, [F,As|Body], s(F)), [Fs-Vs0] --> + [Fs0-Vs0], + { put_assoc(F, Fs0, As-Body, Fs) }. +eval(user(F), As0, V), [Fs-Vs] --> + eval_all(As0, As1), + [Fs-Vs], + { empty_assoc(E), + get_assoc(F, Fs, As-Body), + bind_arguments(As, As1, E, Bindings), + phrase(eval_all(Body, Results), [Fs-Bindings], _), + last(Results, V) }. +eval('bind!', [Var,V0], V), [Fs0-Vs] --> + eval(V0, V), + [Fs0-Vs0], + { put_assoc(Var, Vs0, V, Vs) }. +eval(setq, [Var,V0], V), [Fs0-Vs] --> + eval(V0, V), + [Fs0-Vs0], + { put_assoc(Var, Vs0, V, Vs) }. +eval(if, [Cond,Then|Else], Value) --> + ( eval(Cond, []) -> eval_all(Else, Values), { last(Values, Value) } + ; eval(Then, Value) + ). + +:- meta_predicate goal_truth(0,*,//,//). +goal_truth(Goal, T) --> { Goal -> T = t ; T = [] }. + +bind_arguments([], [], Bs, Bs). +bind_arguments([A|As], [V|Vs], Bs0, Bs) :- + put_assoc(A, Bs0, V, Bs1), + bind_arguments(As, Vs, Bs1, Bs). + +run(S):-'format'('~n~s~n',[S]),run(S,V),writeq(V). + +%if_script_file_time(X):-if_startup_script(time(X)). +if_script_file_time(_):-!. +%if_script_file_time(X):- nop(time(X)). + +% Append: + :- if_script_file_time(run(" + (defun append (x y) + (if x + (cons (car x) (append (cdr x) y)) + y)) + + (append '(a b) '(3 4 5))")). + + %@ V = [append, [a, b, 3, 4, 5]]. + + +% Fibonacci, naive version: + :- if_script_file_time(run(" + (defun fib (n) + (if (= 0 n) + 0 + (if (= 1 n) + 1 + (+ (fib (- n 1)) (fib (- n 2)))))) + (fib 24)")). + + %@ % 14,255,802 inferences, 3.71 CPU in 3.87 seconds (96% CPU, 3842534 Lips) + %@ V = [fib, 46368]. + + +% Fibonacci, accumulating version: + :- if_script_file_time(run(" + (defun fib (n) + (if (= 0 n) 0 (fib1 0 1 1 n))) + + (defun fib1 (f1 f2 i to) + (if (= i to) + f2 + (fib1 f2 (+ f1 f2) (+ i 1) to))) + + (fib 250)")). + + %@ % 39,882 inferences, 0.010 CPU in 0.013 seconds (80% CPU, 3988200 Lips) + %@ V = [fib, fib1, 7896325826131730509282738943634332893686268675876375]. + + +% Fibonacci, iterative version: + :- if_script_file_time(run(" + (defun fib (n) + (setq f (cons 0 1)) + (setq i 0) + (while (< i n) + (setq f (cons (cdr f) (+ (car f) (cdr f)))) + (setq i (+ i 1))) + (car f)) + + (fib 350)")). + + %@ % 30,794 inferences, 0.002 CPU in 0.002 seconds (100% CPU, 12831368 Lips) + %@ V = [fib, 6254449428820551641549772190170184190608177514674331726439961915653414425]. + + + +% Fibonacci, accumulating version: + :- if_script_file_time(run(" + (defun fib (n) + (if (= 0 n) 0 (fib1 0 1 1 n))) + + (defun fib1 (f1 f2 i to) + (if (= i to) + f2 + (fib1 f2 (+ f1 f2) (+ i 1) to))) + + (fib 350)")). + + %@ % 44,595 inferences, 0.003 CPU in 0.003 seconds (100% CPU, 14526532 Lips) + %@ V = [fib, fib1, 6254449428820551641549772190170184190608177514674331726439961915653414425]. + + +% Higher-order programming and eval: + :- if_script_file_time(run(" + (defun map (f xs) + (if xs + (cons (eval (list f (car xs))) (map f (cdr xs))) + ())) + + (defun plus1 (x) (+ 1 x)) + + (map 'plus1 '(1 2 3)) + " + )). + + %@ V = [map, plus1, [2, 3, 4]]. + +%:- ensure_loaded(metta_reader). + + + +#[test] +fn test_case_operation() { + let metta = new_metta_rust(); + let result = metta.run(&mut SExprParser::new(" + ")); + + let expected = metta.run(&mut SExprParser::new(" + ! OK + ! 7 + ! (superpose (OK-3 OK-4)) + ! (superpose (3 4 5)) + ! (superpose ()) + ")); + assert_eq!(result, expected); + + let metta = new_metta_rust(); + let result = metta.run(&mut SExprParser::new(" + (Rel-P A B) + (Rel-Q A C) + + ; cases can be used for deconstruction + !(case (match &self ($rel A $x) ($rel $x)) + (((Rel-P $y) (P $y)) + ((Rel-Q $y) (Q $y)))) + + ; %void% can be used to capture empty results + !(case (match &self ($rel B $x) ($rel $x)) + (((Rel-P $y) (P $y)) + ((Rel-Q $y) (Q $y)) + (%void% no-match))) + + ; a functional example + (= (maybe-inc $x) + (case $x + (((Just $v) (Just (+ 1 $v))) + (Nothing Nothing))) + ) + !(maybe-inc Nothing) + !(maybe-inc (Just 2)) + ")); + let expected = metta.run(&mut SExprParser::new(" + ! (superpose ((Q C) (P B))) + ! no-match + ! Nothing + ! (Just 3) + ")); + assert_eq_metta_results!(result, expected); +} + + + +use hyperon::metta::text::*; +use hyperon::metta::runner::new_metta_rust; + +#[test] +fn test_reduce_higher_order() { + let program = " + ; Curried plus + (: plus (-> Number (-> Number Number))) + (= ((plus $x) $y) (+ $x $y)) + ; Define inc as partial evaluation of plus + (: inc (-> (-> Number Number))) + (= (inc) (plus 1)) + + !(assertEqualToResult ((inc) 2) (3)) + "; + let metta = new_metta_rust(); + + let result = metta.run(&mut SExprParser::new(program)); + + assert_eq!(result, Ok(vec![vec![]])); +} + + + +use hyperon::*; +use hyperon::space::grounding::GroundingSpace; + +#[test] +fn test_custom_match_with_space() { + let mut main_space = GroundingSpace::new(); + let mut inserted_space = GroundingSpace::new(); + inserted_space.add(expr!("implies" ("B" x) ("C" x))); + inserted_space.add(expr!("implies" ("A" x) ("B" x))); + inserted_space.add(expr!("A" "Sam")); + main_space.add(Atom::gnd(inserted_space)); + let result = main_space.query(&expr!("," ("implies" ("B" x) z) ("implies" ("A" x) y) ("A" x))); + assert_eq!(result.len(), 1); + assert_eq!(result[0].resolve(&VariableAtom::new("y")), Some(expr!("B" "Sam"))); + assert_eq!(result[0].resolve(&VariableAtom::new("z")), Some(expr!("C" "Sam"))); +} + + + +use hyperon::*; +use hyperon::common::*; +use hyperon::metta::interpreter::*; +use hyperon::space::grounding::GroundingSpace; + +#[test] +fn test_types_in_metta() { + let mut space = GroundingSpace::new(); + space.add(expr!("=" ("check" (":" n "Int")) ({IS_INT} n))); + space.add(expr!("=" ("check" (":" n "Nat")) ({AND} ("check" (":" n "Int")) ({GT} n {0})))); + space.add(expr!("=" ("if" {true} then else) then)); + space.add(expr!("=" ("if" {false} then else) else)); + space.add(expr!(":" "if" ("->" "bool" "Atom" "Atom" "Atom"))); + space.add(expr!("=" ("fac" n) ("if" ("check" (":" n "Nat")) ("if" ({EQ} n {1}) {1} ({MUL} n ("fac" ({SUB} n {1})))) ({ERR})))); + + assert_eq!(interpret(&space, &expr!("check" (":" {3} "Int"))), Ok(vec![expr!({true})])); + assert_eq!(interpret(&space, &expr!("check" (":" {(-3)} "Int"))), Ok(vec![expr!({true})])); + assert_eq!(interpret(&space, &expr!("check" (":" {3} "Nat"))), Ok(vec![expr!({true})])); + assert_eq!(interpret(&space, &expr!("check" (":" {(-3)} "Nat"))), Ok(vec![expr!({false})])); + assert_eq!(interpret(&space, &expr!("if" ("check" (":" {(3)} "Nat")) "ok" "nok")), Ok(vec![expr!("ok")])); + assert_eq!(interpret(&space, &expr!("if" ("check" (":" {(-3)} "Nat")) "ok" "nok")), Ok(vec![expr!("nok")])); + assert_eq!(interpret(&space, &expr!("fac" {1})), Ok(vec![expr!({1})])); + assert_eq!(interpret(&space, &expr!("fac" {3})), Ok(vec![expr!({6})])); +} + + + + + + + + + #[test] + fn test_match_expression_with_variables() { + let mut space = GroundingSpace::new(); + space.add(expr!("+" "A" ("*" "B" "C"))); + assert_eq!(space.query(&expr!("+" a ("*" b c))), + bind_set![{a: expr!("A"), b: expr!("B"), c: expr!("C") }]); + } + + #[test] + fn test_match_different_value_for_variable() { + let mut space = GroundingSpace::new(); + space.add(expr!("+" "A" ("*" "B" "C"))); + assert_eq!(space.query(&expr!("+" a ("*" a c))), BindingsSet::empty()); + } + + #[test] + fn test_match_query_variable_has_priority() { + let mut space = GroundingSpace::new(); + space.add(expr!("equals" x x)); + + let result = space.query(&expr!("equals" y z)); + assert_eq!(result, bind_set![{ y: expr!(z) }]); + } + + #[test] + fn test_match_query_variable_via_data_variable() { + let mut space = GroundingSpace::new(); + space.add(expr!(x x)); + assert_eq!(space.query(&expr!(y (z))), bind_set![{y: expr!((z))}]); + } + + #[test] + fn test_match_if_then_with_x() { + let mut space = GroundingSpace::new(); + space.add(expr!("=" ("if" "True" then) then)); + assert_eq!(space.query(&expr!("=" ("if" "True" "42") X)), + bind_set![{X: expr!("42")}]); + } + + #[test] + fn test_match_combined_query() { + let mut space = GroundingSpace::new(); + space.add(expr!("posesses" "Sam" "baloon")); + space.add(expr!("likes" "Sam" ("blue" "stuff"))); + space.add(expr!("has-color" "baloon" "blue")); + + let result = space.query(&expr!("," ("posesses" "Sam" object) + ("likes" "Sam" (color "stuff")) + ("has-color" object color))); + assert_eq!(result, bind_set![{object: expr!("baloon"), color: expr!("blue")}]); + } + diff --git a/.Attic/canary_docme/metta_threads.pl b/.Attic/canary_docme/metta_threads.pl new file mode 100644 index 00000000000..7d028e7ea7c --- /dev/null +++ b/.Attic/canary_docme/metta_threads.pl @@ -0,0 +1,187 @@ +:- use_module(library(predicate_options)). +:- use_module(library(record)). + +% convenience for async/3 options +:- record opts( policy:oneof([ephemeral,lazy])=ephemeral + ). +:- predicate_options(spawn/2,2,[pass_to(async/3,3)]). +:- predicate_options(async/3,3, [ policy(+oneof([ephemeral,lazy])) + ]). + +:- meta_predicate + spawn(0), + async(0,-), + async(0,-,+), + async_policy(+,0,-,+). + +:- thread_local + spawn_token_needs_await/1. + +%% spawn(:Goal) is det. +% +% Like spawn/2 with default options. +spawn(Goal) :- + spawn(Goal, []). + + +%% spawn(:Goal,+Options) is det. +% +% Seek solutions to Goal in a background thread. Solutions are +% communicated to the calling thread by unifying free variables in +% Goal. If Goal has no free variables, you must use async/3 instead. +% Options are passed through to async/3. +% +% For example, the following code runs in about 1 second because both +% sleep/1 calls happen in parallel. When foo/0 unifies L, it blocks +% until silly/1 has finished. +% +% silly(L) :- +% sleep(1), +% L = [a,b]. +% foo :- +% spawn(silly(L)), +% sleep(1), +% L=[A,B], % blocks, if necessary +% writeln(A-B). +% +% If Goal produces multiple solutions, they're iterated when +% backtracking over the unification (=|L=[A,B]|= above). If Goal fails +% or throws an exception, the calling thread sees it at the unification +% point. +spawn(Goal,Options) :- + term_variables(Goal, Vars), + async(Goal, Token, Options), + Id is random(1<<63), + assert(spawn_token_needs_await(Id)), + make_opts(Options,Opts), + maplist(spawn_freeze(Id,Token,Opts), Vars). + +spawn_freeze(Id,Token,Opts,Var) :- + freeze(Var,spawn_thaw(Id,Token,Opts)). + +spawn_thaw(Id,Token,Opts) :- + ( retract(spawn_token_needs_await(Id)) -> + debug(spawn,"Await on ~d",[Id]), + await(Token) + ; opts_policy(Opts,lazy) -> + debug(spawn,"Awaiting again on ~d",[Id]), + await(Token) + ; % already called await/1 -> + debug(spawn,"Already did await on ~d",[Id]), + true + ). + + +%% lazy(Goal) is det. +% +% Postpone execution of goal until needed. This is just spawn/1 +% using the =lazy= thread policy. +% +% lazy/1 can be helpful when complicated or expensive goals are only +% needed in some code paths but duplicating those goals is too verbose. +% It can be an alternative to creating a new, named predicate. For +% example, +% +% foo(Xs) :- +% lazy(i_am_slow(a,B,[c(C),d(d),e(etc)])), % complicated +% +% ( day_of_week(tuesday) -> +% append(B,C,Xs) +% ; phase_of_moon(full) -> +% append(C,B,Xs) +% ; true -> +% % i_am_slow/3 not executed in this code path +% Xs = [hi] +% ). +lazy(Goal) :- + spawn(Goal,[policy(lazy)]). + + +%% async(:Goal,-Token) is det. +% +% Like async/3 with default options. +async(Goal,Token) :- + async(Goal,Token,[]). + + +%% async(:Goal,-Token,+Options) is det. +% +% Seek solutions to Goal in a background thread. Use await/1 with Token +% to block until the computation is done. Solutions are communicated to +% the calling thread by unifying free variables in Goal. Both Goal and +% its corresponding solutions are copied between threads. Be aware if +% any of those terms are very large. +% +% Options are as follows: +% +% * policy(Policy) +% If =ephemeral= (default), create a new thread in which to call +% goal. If =lazy=, only execute Goal when await/1 is called; no +% background threads are used. +async(Goal,Token,Options) :- + make_opts(Options,Opts), + opts_policy(Opts, Policy), + async_policy(Policy, Goal, Token, Opts). + + +async_policy(ephemeral, Goal, Token, _Opts) :- + % what does the caller need to track this computation? + term_variables(Goal, Vars), + message_queue_create(SolutionsQ, [max_size(1)]), + Token = ephemeral_token(Vars,SolutionsQ), + + % start the worker thread + Work = work(Goal,Vars,SolutionsQ), + thread_create(ephemeral_worker(Work), _, [detached(true)]). +async_policy(lazy,Goal,Token,_Opts) :- + Token = lazy_thunk(Goal). + + +ephemeral_worker(work(Goal,Vars,SolutionsQ)) :- + debug(spawn,"Seeking solutions to: ~q", [Goal]), + ( catch(call_cleanup(Goal,Done=true),E,true) *-> + ( nonvar(E) -> + debug(spawn,"Caught exception: ~q", [E]), + thread_send_message(SolutionsQ,exception(E)) + ; var(Done) -> + debug(spawn,"Sending solution: ~q", [Vars]), + thread_send_message(SolutionsQ,solution(Vars)), + fail % look for another solution + ; Done=true -> + debug(spawn,"Final solution: ~q", [Vars]), + thread_send_message(SolutionsQ,final(Vars)) + ) + ; % no solutions -> + debug(spawn, "Found no solutions", []), + thread_send_message(SolutionsQ,none) + ). + + +%% await(+Token) +% +% Wait for solutions from an async/3 call. Token is an opaque value +% provided by async/3 which identifies a background computation. +% +% await/1 strives to have the same determinism as the original Goal +% passed to async/3. If that goal fails, await/1 fails. If that goal +% throws an exception, so does await/1. If that goal produces many +% solutions, so does await/1 on backtracking. +await(ephemeral_token(Vars,SolutionsQ)) :- + repeat, + thread_get_message(SolutionsQ,Solution), + ( Solution = solution(Vars) -> + true + ; Solution = final(Vars) -> + !, + true + ; Solution = none -> + !, + fail + ; Solution = exception(E) -> + throw(E) + ; % what? -> + throw(unexpected_await_solution(Solution)) + ). +await(lazy_thunk(Goal)) :- + call(Goal). + diff --git a/.Attic/canary_docme/metta_types.pl b/.Attic/canary_docme/metta_types.pl new file mode 100644 index 00000000000..a94a7f93da8 --- /dev/null +++ b/.Attic/canary_docme/metta_types.pl @@ -0,0 +1,809 @@ +/* + * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpreter/Runtime + * 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. + */ +typed_list(Cmpd,Type,List):- compound(Cmpd), Cmpd\=[_|_], compound_name_arguments(Cmpd,Type,[List|_]),is_list(List). +is_syspred(H,Len,Pred):- notrace(is_syspred0(H,Len,Pred)). +is_syspred0(H,_Ln,_Prd):- \+ atom(H),!,fail. +is_syspred0(H,_Ln,_Prd):- upcase_atom(H,U),downcase_atom(H,U),!,fail. +is_syspred0(H,Len,Pred):- current_predicate(H/Len),!,Pred=H. +is_syspred0(H,Len,Pred):- atom_concat(Mid,'!',H), H\==Mid, is_syspred0(Mid,Len,Pred),!. +is_syspred0(H,Len,Pred):- atom_concat(Mid,'-p',H), H\==Mid, is_syspred0(Mid,Len,Pred),!. +is_syspred0(H,Len,Pred):- atom_concat(Mid,'-fn',H), H\==Mid, is_syspred0(Mid,Len,Pred),!. +is_syspred0(H,Len,Pred):- into_underscores(H,Mid), H\==Mid, is_syspred0(Mid,Len,Pred),!. +%is_function(F):- atom(F). +is_metta_data_functor(_Eq,_Othr,H):- + bt,trace, clause(is_data_functor(H),_). +is_metta_data_functor(Eq,Other,H):- H\=='Right', H\=='Something', + % metta_type(Other,H,_), % fail, + \+ get_metta_atom(Eq,Other,[H|_]), + \+ metta_eq_def(Eq,Other,[H|_],_), + \+ is_metta_builtin(H), + \+ is_comp_op(H,_), + \+ is_math_op(H,_,_). + + +:- if( \+ current_predicate(mnotrace/1) ). + mnotrace(G):- once(G). +:- endif. + +'Number':attr_unify_hook(_,NewValue):- numeric(NewValue). + +%is_decl_type(ST):- metta_type(_,_,[_|Type]),is_list(Type),sub_sterm(T,Type),nonvar(T),T=@=ST, \+ nontype(ST). + +is_decl_utype('%Undefined%'). +is_decl_utype('Number'). +is_decl_utype('Symbol'). +is_decl_utype('Expression'). +is_decl_utype('String'). +is_decl_utype('Bool'). +is_decl_utype('Type'). +is_decl_utype('Any'). +is_decl_utype('Atom'). +%is_decl_utype(Type):- is_decl_type_l(Type). +is_decl_mtype('Variable'). +is_decl_mtype('Number'). +is_decl_mtype('Symbol'). +is_decl_mtype('Expression'). +is_decl_mtype('Grounded'). + +%is_decl_type([ST|_]):- !, atom(ST),is_decl_type_l(ST). +%is_decl_type(ST):- \+ atom(ST),!,fail. +is_decl_type(Type):- is_decl_utype(Type). +is_decl_type(Type):- is_decl_type_l(Type). +is_decl_type([Type,SType]):- is_decl_type_l(Type),is_decl_utype(SType). + +is_decl_type_l('StateMonad'). is_decl_type_l('List'). + +last_type(List,Type):- is_list(List),last(List,Type),is_type(Type). +last_type(Type,Type):- is_type(Type),!. + +is_type(Type):- nontype(Type),!,fail. +is_type(Type):- is_decl_type(Type). +%is_type(Type):- atom(Type). + +nontype(Type):- var(Type),!. +nontype('->'). +nontype(N):- number(N). + +needs_eval(EvalMe):- is_list(EvalMe). + + +args_violation(_Dpth,_Slf,Args,List):- ( \+ iz_conz(Args); \+ iz_conz(List)), !, fail. +args_violation(Depth,Self,[A|Args],[L|List]):- + once( arg_violation(Depth,Self,A,L) ; + args_violation(Depth,Self,Args,List)). + +arg_violation(Depth,Self,A,L):- + \+ (get_type_equals(Depth,Self,A,T), \+ type_violation(T,L)). +%arg_violation(Depth,Self,A,_):- get_type(Depth,Self,A,_),!. + +type_violation(T,L):- \+ \+ (is_nonspecific_type(T);is_nonspecific_type(L)),!,fail. +type_violation(T,L):- T\=L. + + +not_arg_violation(Depth,Self,Arg,Type):- + arg_conform(Depth,Self,Arg,Type), + \+ arg_violation(Depth,Self,Arg,Type). + + +get_types(Depth,Self,Var,TypeSet):- + setof(Type,get_type_each(Depth,Self,Var,Type),TypeSet). + +get_type_equals(_Depth,_Self,Var,TypeO):- var(Var),var(TypeO),!. +get_type_equals(Depth,Self,Var,TypeO):- get_type(Depth,Self,Var,TypeO). + +%if_or_else(get_type(Depth,Self,Val,Type),Type='%Undefined%'), + +get_type(Depth,Self,Val,TypeO):- + no_repeats_var(NoRepeatType), + get_type_each(Depth,Self,Val,Type), + NoRepeatType=Type, + Type=TypeO, + (return_only_first_type->!;true). + +return_only_first_type:- true_flag. + +is_space_type(Space,is_asserted_space):- was_asserted_space(Space),!. +is_space_type(Space,Test):- no_repeats(Test,space_type_method(Test,_,_)),call(Test,Space),!. + +is_state_type(State,Test):- no_repeats(Test,state_type_method(Test,_,_)),call(Test,State),!. + +%is_dynaspace(Expr):- \+ is_list(Expr), callable(Expr), is_space_type(Expr,_). +is_dynaspace(S):- var(S),!,fail. +is_dynaspace(S):- was_asserted_space(S). +is_dynaspace(S):- py_named_space(S). +is_dynaspace(S):- typed_list(S,'hyperon::space::DynSpace',_). +% fake_notrace( is_space_type(Expr,_)),!. + + +get_type_each(_, _, Nil, UD):- Nil==[],!,UD='%Undefined%'. +get_type_each(Depth,Self,Val,Type):- \+ integer(Depth),!,get_type_each(10,Self,Val,Type). +get_type_each(Depth,_Slf,_Type,_):- Depth<1,!, fail. +%get_type(Depth,Self,Val,Type):- is_debugging(eval), +% ftrace(get_type_each(Depth,Self,Val,Type)), +% fail. +get_type_each(Depth,Self,Expr,['StateMonad',Type]):- + notrace( is_valid_nb_state(Expr)),!, + if_or_else(state_decltype(Expr,Type),nonvar(Type)), + ('get-state'(Expr,Val),!,Depth2 is Depth-1, + get_value_type(Depth2,Self,Val,Type)). + +get_type_each(_Dpth,Self,Var,Type):- var(Var),!, + get_attr(Var,metta_type,Self=TypeList),member(Type,TypeList). + +get_type_each(_Dpth,_Slf,Expr,'hyperon::space::DynSpace'):- is_dynaspace(Expr),!. +get_type_each(Depth,Self,Val,Type):- \+ compound(Val),!, get_type_nc(Depth,Self,Val,Type). + +get_type_each(Depth,Self,Val,Type):- + if_t(option_value('type-check',auto),check_bad_type(Depth,Self,Val)), + if_or_else((get_type_cmpd_2nd_non_nil(Depth,Self,Val,Type,How),trace_get_type(How,Type,gt(Val))), + (trace_get_type('FAILED','',gt(Val)),fail)). + +get_type_cmpd_2nd_non_nil(Depth,Self,Val,Type,How):- + call_nth(get_type_cmpd(Depth,Self,Val,Type,How),Nth), + (Nth>1 -> Type\==[] ; true). +/* +have_some_defs(Depth,Self,Val):- + \+ \+ + ([H|Args] = Val, + metta_type(Eq,H,[Ar|ArgTypes]),Ar=='->', + append(ParamTypes,[RType],ArgTypes), + length(ParamTypes,Len), + len_or_unbound(Args,ALen), + Len = ALen). + +check_bad_type(_Depth,_Self,Val):- \+ is_list(Val),!. +check_bad_type(Depth,Self,Val):- \+ have_some_defs(Depth,Self,Val),!, + trace_get_type(checking_childs,Val,check),!, + maplist(check_bad_type(Depth,Self),Val). +check_bad_type(Depth,Self,Val):- + maplist(check_bad_type(Depth,Self),Val), + check_bad_type2(Depth,Self,Val). + +check_bad_type2(Depth,Self,Val):- Val= [Op|Args], + typed_expression(Depth,Self,[Op|Args],ArgTypes,RType), + trace_get_type(type_sig(Op),ArgTypes,RType), + args_conform(Depth,Self,Args,ArgTypes), + (args_violation(Depth,Self,Args,ArgTypes) -> + (trace_get_type(bad_type,args_violation(Args,ArgTypes),check),fail); + (trace_get_type(conformed,no_args_violation(Args,ArgTypes),check),true)). +*/ +typed_expression(Depth,Self,[Op|Args],ArgTypes,RType):- + len_or_unbound(Args,Len), + get_operator_typedef1(Self,Op,Len,ArgTypes,RType). + +badly_typed_expression(Depth,Self,[Op|Args]):- + typed_expression(Depth,Self,[Op|Args],ArgTypes,RType), + can_assign(RetType,RType), + args_violation(Depth,Self,Args,ArgTypes), + !. + +:- nodebug(metta(types)). +:- nodebug(types). +trace_get_type(How,Type,Val):- + if_trace(types, + color_g_mesg('#7f2f2f', + w_indent(3,format('<-- ~@ <- ~@ < ~@',[wsf(How),wsf(Type),wsf(Val)])))),!. +wsf(T):- with_indents(false,write_src(T)). + +get_type_nc(_Dpth,Self,Op,Type):- metta_type(Self,Op,Type). +get_type_nc(Dpth,Slf,Val,Type):- symbol(Val),!,get_type_symb(Dpth,Slf,Val,Type). +get_type_nc(_Dpth,_Slf,Val,'String'):- string(Val),!. +%get_type_nc(_Dpth,_Slf,Val,Type):- py_is_object(Val),py_type(Val,Type). +get_type_nc(_Dpth,_Slf,Val,'Number'):- number(Val). +get_type_nc(_Dpth,_Slf,Val,'Integer'):- integer(Val),!, specialize_number. +get_type_nc(_Dpth,_Slf,Val,'Decimal'):- float(Val),!, specialize_number. +get_type_nc(_Dpth,_Slf,Val,'Rational'):- rational(Val),!. + +specialize_number:- false_flag. + +get_type_symb(_Dpth,_Slf,Val,'Bool'):- (Val=='False';Val=='True'). +get_type_symb(_Dpth,_Slf,Val,'Type'):- is_decl_type(Val). +get_type_symb(_Dpth,_Slf,Val,Type):- symbolic_list_concat([Type,_|_],'@',Val). +get_type_symb(_Dpth,_Slf,Val,Type):- symbolic_list_concat([Type,_|_],':',Val). +get_type_symb(Depth,Self,Op,Type):- % defined symbol + Depth2 is Depth-1, eval_args(Depth2,Self,Op,Val),Op\=@=Val,!, + get_type(Depth2,Self,Val,Type). + +get_dict_type(_Vl,Type,TypeO):- nonvar(Type),TypeO=Type. +get_dict_type(Val,_,Type):- get_dict(Val,type,Type). +get_dict_type(Val,_,TypeO):- get_dict(Val,class,Type). +get_dict_type(Val,_,TypeO):- get_dict(Val,types,TypeL), + is_list(TypeL),member(Type,TypeL). + + +%get_type_cmpd(_Dpth,Self,Op,Type):- copy_term(Op,Copy), +% metta_type(Self,Op,Type), Op=@=Copy. + +get_type_cmpd(_Dpth,_Slf,Val,Type,dict):- is_dict(Val,Type),!, + get_dict_type(Val,Type,TypeO). + +% Curried Op +get_type_cmpd(Depth,Self,[[Op|Args]|Arg],Type,curried(W)):- + symbol(Op), + Depth2 is Depth-1, + get_type_cmpd(Depth2,Self,[Op|Args],Type1,W), + get_type(Depth2,Self,Arg,ArgType), + ignore(sub_var(ArgType,Type1)->true; + (sub_term(ST,Type1),var(ST),ST=ArgType)), + last(Type1,Type). + + + +get_type_cmpd(Depth,Self,[Op|Args],Type,ac(Op,[P|Arams],RetType)):- symbol(Op), + len_or_unbound(Args,Len), + get_operator_typedef1(Self,Op,Len,[P|Arams],RetType), + % Fills in type variables when possible + args_conform(Depth,Self,Args,[P|Arams]), + % \+ maplist(var,Arams), + % unitests: arg violations should return () + (\+ args_violation(Depth,Self,Args,[P|Arams])), + Type=RetType. + + +get_type_cmpd(_Dpth,_Slf,Cmpd,Type,typed_list):- + typed_list(Cmpd,Type,_List). + +get_type_cmpd(_Dpth,_Slf,_Cmpd,[],unknown). + +/* +get_type_cmpd(Depth,Self,[Op|Expr],Type,not_bat):- + symbol(Op), + maplist(get_type(Depth,Self),Expr,Types), + [Op|Types]\=@=[Op|Expr], + \+ badly_typed_expression(Depth,Self,[Op|Expr]), + metta_type(Self,[Op|Types],Type). + +get_type_cmpd(Depth,Self,List,Types,maplist(get_type)):- + List\==[], + \+ badly_typed_expression(Depth,Self,List), + is_list(List), + Depth2 is Depth-1, + maplist(get_type(Depth2,Self),List,Types), + \+ badly_typed_expression(Depth,Self,Types). + +*/ +get_type_cmpd(Depth,Self,EvalMe,Type,eval_first):- + needs_eval(EvalMe), + Depth2 is Depth-1, + eval_args(Depth2,Self,EvalMe,Val), + \+ needs_eval(Val), + get_type(Depth2,Self,Val,Type). + + +state_decltype(Expr,Type):- functor(Expr,_,A), + arg(A,Expr,Type),once(var(Type);is_decl_type(Type)). + + +get_value_type(_Dpth,_Slf,Var,'%Undefined%'):- var(Var),!. +get_value_type(_Dpth,_Slf,Val,'Number'):- number(Val),!. +get_value_type(_Dpth,_Slf,Val,'String'):- string(Val),!. +get_value_type(Depth,Self,Val,T):- get_type(Depth,Self,Val,T), T\==[], T\=='%Undefined%',!. +get_value_type(_Dpth,_Slf,Val,T):- 'get-metatype'(Val,T). + +/* + +get_value_type(Depth,Self,EvalMe,Type):- needs_eval(EvalMe), + eval_args(Depth,Self,EvalMe,Val), \+ needs_eval(Val),!, + get_value_type(Depth,Self,Val,Type). + +get_value_type(_Dpth,Self,[Fn|_],Type):- symbol(Fn),metta_type(Self,Fn,List),last_element(List,Type), nonvar(Type), + is_type(Type). +get_value_type(_Dpth,Self,List,Type):- is_list(List),metta_type(Self,List,LType),last_element(LType,Type), nonvar(Type), + is_type(Type). + +get_value_type(Depth,_Slf,Type,Type):- Depth<1,!. +get_value_type(_Dpth,Self,List,Type):- is_list(List),metta_type(Self,Type,['->'|List]). +get_value_type(Depth,Self,List,Types):- List\==[], is_list(List),Depth2 is Depth-1,maplist(get_value_type(Depth2,Self),List,Types). +get_value_type(_Dpth,Self,Fn,Type):- symbol(Fn),metta_type(Self,Fn,Type),!. +%get_value_type(Depth,Self,Fn,Type):- nonvar(Fn),metta_type(Self,Fn,Type2),Depth2 is Depth-1,get_value_type(Depth2,Self,Type2,Type). +%get_value_type(Depth,Self,Fn,Type):- Depth>0,nonvar(Fn),metta_type(Self,Type,Fn),!. %,!,last_element(List,Type). + +%get_value_type(Depth,Self,Expr,Type):-Depth2 is Depth-1, +% eval_args(Depth2,Self,Expr,Val), +% Expr\=@=Val,get_value_type(Depth2,Self,Val,Type). + + +get_value_type(_Dpth,_Slf,Val,'String'):- string(Val),!. +get_value_type(_Dpth,_Slf,Val,Type):- is_decl_type(Val),Type=Val. +get_value_type(_Dpth,_Slf,Val,'Bool'):- (Val=='False';Val=='True'),!. +% get_value_type(_Dpth,_Slf,Val,'Symbol'):- symbol(Val). +%get_value_type(Depth,_Slf,Cmpd,Type):- compound(Cmpd), functor(Cmpd,Type,1),!. +%get_value_type(_Dpth,_Slf,Cmpd,Type):- \+ ground(Cmpd),!,Type=[]. +%get_value_type(_Dpth,_Slf,_,'%Undefined%'):- fail. +%get_value_type(Depth,Self,Val,Type):- Depth2 is Depth-1, get_type_equals(Depth2,Self,Val,Type). +*/ + + +as_prolog(I,O):- as_prolog(10,'&self',I,O). +as_prolog(_Dpth,_Slf,I,O):- \+ iz_conz(I),!,I=O. +as_prolog(Depth,Self,[Cons,H,T],[HH|TT]):- Cons=='Cons',!,as_prolog(Depth,Self,H,HH),as_prolog(Depth,Self,T,TT). +as_prolog(Depth,Self,[List,H|T],O):- List=='::',!,maplist(as_prolog(Depth,Self),[H|T],L),!, O = L. +as_prolog(Depth,Self,[At,H|T],O):- At=='@',!,maplist(as_prolog(Depth,Self),[H|T],[HH|L]),atom(H),!, O =.. [HH|L]. +as_prolog(Depth,Self,I,O):- is_list(I),!,maplist(as_prolog(Depth,Self),I,O). +as_prolog(_Dpth,_Slf,I,I). + + +try_adjust_arg_types(_Eq,RetType,Depth,Self,Params,X,Y):- + as_prolog(Depth,Self,X,M), + args_conform(Depth,Self,M,Params),!, + set_type(Depth,Self,Y,RetType), + into_typed_args(Depth,Self,Params,M,Y). +%adjust_args(Else,Eq,RetType,Depth,Self,_,X,Y):- is_list(X), !, maplist(eval_args(Depth,Self),X,Y). +%adjust_args(Else,Eq,RetType,Depth,Self,_,X,Y):- is_list(X), !, maplist(as_prolog(Depth,Self),X,Y),!. + +adjust_args_9(Eq,RetType,ResIn,ResOut,Depth,Self,AE,More,Adjusted):- + adjust_args(eval,Eq,RetType,ResIn,ResOut,Depth,Self,AE,More,Adjusted). + +adjust_args(Else,_Eq,_RetType,Res,Res,_Dpth,Self,F,X,Y):- (X==[] ; + is_special_op(Self,F); \+ iz_conz(X)),!,Y=X. +adjust_args(Else,Eq,RetType,Res,NewRes,Depth,Self,Op,X,Y):- + if_or_else(adjust_argsA(Else,Eq,RetType,Res,NewRes,Depth,Self,Op,X,Y), + adjust_argsB(Else,Eq,RetType,Res,NewRes,Depth,Self,Op,X,Y)). + +adjust_argsA(Else,Eq,RetType,Res,NewRes,Depth,Self,Op,X,Y):- + len_or_unbound(X,Len), + get_operator_typedef(Self,Op,Len,ParamTypes,RRetType), + (nonvar(NewRes)->CRes=NewRes;CRes=Res), + RRetType = RetType, + args_conform(Depth,Self,[CRes|X],[RRetType|ParamTypes]), + into_typed_args(Depth,Self,[RRetType|ParamTypes],[Res|X],[NewRes|Y]). + +adjust_argsB(Else,Eq,_RetType,Res,Res,Depth,Self,_,Args,Adjusted):- is_list(Args),!, + maplist(eval_1_arg(Else,Eq,_,Depth,Self),Args,Adjusted). +adjust_argsB(Else,_Eq,_RetType,Res,Res,Depth,Self,_,X,Y):- call(Else,X,Y). % as_prolog(Depth,Self,X,Y),!. + +eval_1_arg(Else,Eq,ReturnType,Depth,Self,Arg,Adjusted):- + must_det_ll(if_or_else(eval(Eq,ReturnType,Depth,Self,Arg,Adjusted),call(Else,Arg,Adjusted))). + + +get_operator_typedef(Self,Op,ParamTypes,RetType):- + len_or_unbound(ParamTypes,Len), + get_operator_typedef(Self,Op,Len,ParamTypes,RetType). + +reset_cache:- retractall(get_operator_typedef0(_,_,_,_,_)). + +:- dynamic(get_operator_typedef0/5). +get_operator_typedef(Self,Op,Len,ParamTypes,RetType):- + len_or_unbound(ParamTypes,Len), + if_or_else(get_operator_typedef0(Self,Op,Len,ParamTypes,RetType), + if_or_else(get_operator_typedef1(Self,Op,Len,ParamTypes,RetType), + get_operator_typedef2(Self,Op,Len,ParamTypes,RetType))). + +get_operator_typedef1(Self,Op,Len,ParamTypes,RetType):- + len_or_unbound(ParamTypes,Len), + if_t(nonvar(ParamTypes),append(ParamTypes,[RetType],List)), + metta_type(Self,Op,['->'|List]), + if_t(var(ParamTypes),append(ParamTypes,[RetType],List)), + assert(get_operator_typedef0(Self,Op,Len,ParamTypes,RetType)). +get_operator_typedef2(Self,Op,Len,ParamTypes,RetType):- + ignore('AnyRet'=RetType), + maplist(is_eval_kind,ParamTypes), + assert(get_operator_typedef0(Self,Op,Len,ParamTypes,RetType)). + %nop(wdmsg(missing(get_operator_typedef2(Self,Op,ParamTypes,RetType)))),!,fail. + + +ignored_args_conform(Depth,Self,A,L):- ( \+ iz_conz(Args); \+ iz_conz(List)), !. +ignored_args_conform(Depth,Self,A,L):- maplist(ignored_arg_conform(Depth,Self),A,L). +ignored_arg_conform(Depth,Self,A,L):- nonvar(L), is_nonspecific_type(L),!. +ignored_arg_conform(Depth,Self,A,L):- get_type(Depth,Self,A,T), type_conform(T,L),!. +ignored_arg_conform(Depth,Self,_,_):- !. + +args_conform(_Dpth,_Slf,Args,List):- ( \+ iz_conz(Args); \+ iz_conz(List)), !. +args_conform(Depth,Self,[A|Args],[L|List]):- + arg_conform(Depth,Self,A,L), args_conform(Depth,Self,Args,List). + +arg_conform(_Dpth,_Slf,_A,L):- nonvar(L), is_nonspecific_type(L),!. + arg_conform(Depth,Self,A,L):- get_type(Depth,Self,A,T), type_conform(T,L),!. +%arg_conform(_Dpth,_Slf,_,_). +%arg_conform(Depth,Self,A,_):- get_type(Depth,Self,A,_),!. + +type_conform(T,L):- T=L,!. +type_conform(T,L):- \+ \+ (is_nonspecific_type(T);is_nonspecific_type(L)),!. +type_conform(T,L):- can_assign(T,L). + + +:- dynamic(thrown_metta_return/1). +throw_metta_return(L):- + asserta(thrown_metta_return(L)), + (throw(metta_return(L))). + + +into_typed_args(_Dpth,_Slf,T,M,Y):- (\+ iz_conz(T); \+ iz_conz(M)),!, M=Y. +into_typed_args(Depth,Self,[T|TT],[M|MM],[Y|YY]):- + into_typed_arg(Depth,Self,T,M,Y), + into_typed_args(Depth,Self,TT,MM,YY). + +into_typed_arg(_Dpth,Self,T,M,Y):- var(M),!,Y=M, nop(put_attr(M,metta_type,Self=T)). +into_typed_arg(Depth,Self,T,M,Y):- into_typed_arg0(Depth,Self,T,M,Y)*->true;M=Y. + +into_typed_arg0(Depth,Self,T,M,Y):- var(T), !, + must_det_ll((get_type(Depth,Self,M,T), + (wants_eval_kind(T)->eval_args(Depth,Self,M,Y);Y=M))). + +into_typed_arg0(Depth,Self,T,M,Y):- is_pro_eval_kind(T),!,eval_args(Depth,Self,M,Y). +into_typed_arg0(Depth,Self,T,M,Y):- ground(M),!, \+ arg_violation(Depth,Self,M,T),Y=M. +into_typed_arg0(_Dpth,_Slf,T,M,Y):- nonvar(T), is_non_eval_kind(T),!,M=Y. +into_typed_arg0(Depth,Self,_,M,Y):- eval_args(Depth,Self,M,Y). + +wants_eval_kind(T):- nonvar(T), is_pro_eval_kind(T),!. +wants_eval_kind(_):- true. + +metta_type:attr_unify_hook(Self=TypeList,NewValue):- + attvar(NewValue),!,put_attr(NewValue,metta_type,Self=TypeList). +metta_type:attr_unify_hook(Self=TypeList,NewValue):- + get_type(20,Self,NewValue,Was), + can_assign(Was,Type). + +%set_type(Depth,Self,Var,Type):- nop(set_type(Depth,Self,Var,Type)),!. +set_type(Depth,Self,Var,Type):- nop(set_type(Depth,Self,Var,Type)),!. +set_type(Depth,Self,Var,Type):- + get_types(Depth,Self,Var,TypeL), + add_type(Depth,Self,Var,TypeL,Type). + +add_type(_Depth,_Self, Var,_TypeL,_Type):- + \+ nonvar(Var),!. +add_type(_Depth,_Self,_Var,TypeL,Type):- + \+ \+ (member(E,TypeL),E==Type),!. +add_type(_Depth,Self,_Var,TypeL,Type):- + append([Type],TypeL,TypeList), + put_attr(Var,metta_type,Self=TypeList). + + + + +can_assign(Was,Type):- (is_nonspecific_type(Was);is_nonspecific_type(Type)),!. +can_assign(Was,Type):- Was=Type,!. +%can_assign(Was,Type):- (Was=='Nat';Type=='Nat'),!,fail. +%can_assign(Was,Type):- \+ cant_assign_to(Was,Type). +%can_assign(_Ws,_Typ). +/* +cant_assign_to(Was,Type):- cant_assign(Was,Type),!. +cant_assign_to(Type,Was):- cant_assign(Was,Type),!. +cant_assign(A,B):- \+ A \= B, !, fail. +cant_assign(Number,String):- formated_data_type(Number),formated_data_type(String), Number\==String. +cant_assign(Number,Other):- formated_data_type(Number), symbol(Other), Number\==Other. +*/ +is_non_eval_kind(Var):- var(Var),!. +is_non_eval_kind(Type):- nonvar(Type),Type\=='Any', is_nonspecific_type(Type),!. +is_non_eval_kind('Atom'). + +is_nonspecific_type(Any):- notrace(is_nonspecific_type0(Any)),!. +is_nonspecific_type0(Var):- var(Var),!,fail. +is_nonspecific_type0('%Undefined%'). +is_nonspecific_type0('ErrorType'). +%is_nonspecific_type([]). +is_nonspecific_type0('Atom'). +is_nonspecific_type0(Any):- is_nonspecific_any(Any). + +formated_data_type('Number'). +formated_data_type('Symbol'). +formated_data_type('Bool'). +formated_data_type('Char'). +formated_data_type('String'). +formated_data_type([List|_]):- List=='List'. + +is_nonspecific_any(Any):- notrace(is_nonspecific_any0(Any)),!. + +is_nonspecific_any0(Any):- Any=='Any'. +is_nonspecific_any0(Any):- Any=='%Undefined%'. +%is_nonspecific_any0(Any):- Any=='Type'. +is_nonspecific_any0(Any):- Any=='AnyRet'. + + +is_nonspecific_type_na(NotAtom):- NotAtom\=='Atom', is_nonspecific_type(NotAtom). +narrow_types(RetType,RetType,RetType):- !. +narrow_types(Any,RetType,RetType):- nonvar(Any),is_nonspecific_any(Any),!. +narrow_types(Any,RetType,RetType):- nonvar(Any),is_nonspecific_any(Any),!. +narrow_types(Any,RetType,RetType):- nonvar(Any),is_nonspecific_type_na(Any),!. +narrow_types(RetType,Any,RetType):- nonvar(Any),is_nonspecific_type_na(Any),!. +narrow_types(RetType,Any,RetType):- is_type_list(Any,List),!,narrow_types([RetType|List],Out). +narrow_types(Any,RetType,RetType):- is_type_list(Any,List),!,narrow_types([RetType|List],Out). +narrow_types(Fmt,Fmt1,Fmt):- formated_data_type(Fmt),formated_data_type(Fmt1). +narrow_types(Fmt,Fmt1,Fmt):- formated_data_type(Fmt),!. +narrow_types(Fmt1,Fmt,Fmt):- formated_data_type(Fmt),!. +narrow_types(Fmt1,Fmt2,'NarrowTypeFn'(Fmt1,Fmt2)). + +is_type_list('NarrowTypeFn'(Fmt1,Fmt2),List):- get_type_list('NarrowTypeFn'(Fmt1,Fmt2),List). + +get_type_list('NarrowTypeFn'(Fmt1,Fmt2),List):- !, + get_type_list(Fmt1,List1),get_type_list(Fmt2,List2), + append(List1,List2,List). +get_type_list(A,[A]). + +narrow_types(NL,Out):- \+ is_list(NL),!, Out=[NL]. +narrow_types([A|List],Out):- var(A),!,narrow_types(List,LT),Out='NarrowTypeFn'(A,LT). +narrow_types([A,B|List],Out):- narrow_types([B|List],BL),narrow_types(A,BL,Out). +narrow_types([A],A). + +is_pro_eval_kind(Var):- var(Var),!. +is_pro_eval_kind(SDT):- formated_data_type(SDT). +is_pro_eval_kind(A):- A=='Atom',!,fail. +is_pro_eval_kind(A):- A=='%Undefined%',!,fail. +is_pro_eval_kind(A):- is_nonspecific_any(A),!. + +is_feo_f('Cons'). + +is_seo_f('{...}'). +is_seo_f('[...]'). +is_seo_f('{}'). +is_seo_f('[]'). +is_seo_f('StateMonad'). +is_seo_f('State'). +is_seo_f('Event'). +is_seo_f('Concept'). +is_seo_f(N):- number(N),!. + +is_absorbed_return_type(Params,Var):- var(Var),!, \+ sub_var(Var,Params). +is_absorbed_return_type(_,'Bool'). +is_absorbed_return_type(_,[Ar]):- !, Ar == (->). +is_absorbed_return_type(_,'EmptyType'). +is_absorbed_return_type(_,'ReturnType'). +is_absorbed_return_type(_,X):- is_self_return(X). + +is_self_return('ErrorType'). + +is_non_absorbed_return_type(Params,Var):- + \+ is_absorbed_return_type(Params,Var). + + +%is_user_defined_goal(Self,[H|_]):- is_user_defined_head(Eq,Self,H). + +is_user_defined_head(Other,H):- is_user_defined_head(=,Other,H). +is_user_defined_head(Eq,Other,H):- mnotrace(is_user_defined_head0(Eq,Other,H)). +is_user_defined_head0(Eq,Other,[H|_]):- !, nonvar(H),!, is_user_defined_head_f(Eq,Other,H). +is_user_defined_head0(Eq,Other,H):- callable(H),!,functor(H,F,_), is_user_defined_head_f(Eq,Other,F). +is_user_defined_head0(Eq,Other,H):- is_user_defined_head_f(Eq,Other,H). + +is_user_defined_head_f(Other,H):- is_user_defined_head_f(=,Other,H). +is_user_defined_head_f(Eq,Other,H):- is_user_defined_head_f1(Eq,Other,H). +is_user_defined_head_f(Eq,Other,H):- is_user_defined_head_f1(Eq,Other,[H|_]). + +%is_user_defined_head_f1(Eq,Other,H):- metta_type(Other,H,_). +%s_user_defined_head_f1(Other,H):- get_metta_atom(Eq,Other,[H|_]). +is_user_defined_head_f1(Other,H):- is_user_defined_head_f1(=,Other,H). +is_user_defined_head_f1(Eq,Other,H):- metta_eq_def(Eq,Other,[H|_],_). +%is_user_defined_head_f(Eq,_,H):- is_metta_builtin(H). + + + +is_special_op(Op):- current_self(Self),is_special_op(Self,Op). + +is_special_op(_Slf,F):- \+ atom(F), \+ var(F), !, fail. +%is_special_op(Self,Op):- get_operator_typedef(Self,Op,Params,_RetType), +% maplist(is_non_eval_kind,Params). +%is_special_op(_Slf,Op):- is_special_builtin(Op). + +is_eval_kind(ParamType):- ignore(ParamType='Any'). + +is_metta_data_functor(Eq,F):- + current_self(Self),is_metta_data_functor(Eq,Self,F). + +:- if( \+ current_predicate(get_operator_typedef/4)). +get_operator_typedef(Self,Op,ParamTypes,RetType):- + get_operator_typedef(Self,Op,_,ParamTypes,RetType). +:- endif. + +:- if( \+ current_predicate(get_operator_typedef1/4)). +get_operator_typedef1(Self,Op,ParamTypes,RetType):- + get_operator_typedef1(Self,Op,_,ParamTypes,RetType). +:- endif. + +:- if( \+ current_predicate(get_operator_typedef/5)). +get_operator_typedef(Self,Op,_,ParamTypes,RetType):- + get_operator_typedef(Self,Op,ParamTypes,RetType). +:- endif. + + +is_special_builtin('case'). +%is_special_builtin(':'). + +%is_special_builtin('='). +%is_special_builtin('->'). +is_special_builtin('bind!'). +%is_special_builtin('new-space'). +is_special_builtin('let'). +is_special_builtin('let*'). +is_special_builtin('if'). +is_special_builtin('rtrace'). +is_special_builtin('or'). +is_special_builtin('and'). +is_special_builtin('not'). +is_special_builtin('match'). +is_special_builtin('call'). +is_special_builtin('let'). +is_special_builtin('let*'). +is_special_builtin('nop'). +is_special_builtin('assertEqual'). +is_special_builtin('assertEqualToResult'). +is_special_builtin('collapse'). +is_special_builtin('superpose'). +%is_special_builtin('=='). + +is_metta_builtin(Special):- is_special_builtin(Special). + +is_metta_builtin('=='). +is_metta_builtin(F):- once(atom(F);var(F)), current_op(_,yfx,F). +is_metta_builtin('println!'). +is_metta_builtin('transfer!'). +is_metta_builtin('compile!'). +is_metta_builtin('+'). +is_metta_builtin('-'). +is_metta_builtin('*'). +is_metta_builtin('/'). +is_metta_builtin('%'). +is_metta_builtin('=='). +is_metta_builtin('<'). +is_metta_builtin('>'). +is_metta_builtin('all'). +is_metta_builtin('import!'). +is_metta_builtin('pragma!'). + +% Comparison Operators in Prolog +% is_comp_op('=', 2). % Unification +is_comp_op('\\=', 2). % Not unifiable +is_comp_op('==', 2). % Strict equality +is_comp_op('\\==', 2). % Strict inequality +is_comp_op('@<', 2). % Term is before +is_comp_op('@=<', 2). % Term is before or equal +is_comp_op('@>', 2). % Term is after +is_comp_op('@>=', 2). % Term is after or equal +is_comp_op('=<', 2). % Less than or equal +is_comp_op('<', 2). % Less than +is_comp_op('>=', 2). % Greater than or equal +is_comp_op('>', 2). % Greater than +is_comp_op('is', 2). % Arithmetic equality +is_comp_op('=:=', 2). % Arithmetic exact equality +is_comp_op('=\\=', 2). % Arithmetic inequality + +% Arithmetic Operations +is_math_op('*', 2, exists). % Multiplication +is_math_op('**', 2, exists). % Exponentiation +is_math_op('+', 1, exists). % Unary Plus +is_math_op('+', 2, exists). % Addition +is_math_op('-', 1, exists). % Unary Minus +is_math_op('-', 2, exists). % Subtraction +is_math_op('.', 2, exists). % Array Indexing or Member Access (Depends on Context) +is_math_op('/', 2, exists). % Division +is_math_op('//', 2, exists). % Floor Division +is_math_op('///', 2, exists). % Alternative Division Operator (Language Specific) +is_math_op('/\\', 2, exists). % Bitwise AND +is_math_op('<<', 2, exists). % Bitwise Left Shift +is_math_op('>>', 2, exists). % Bitwise Right Shift +is_math_op('\\', 1, exists). % Bitwise NOT +is_math_op('\\/', 2, exists). % Bitwise OR +is_math_op('^', 2, exists). % Bitwise XOR +is_math_op('abs', 1, exists). % Absolute Value +is_math_op('acos', 1, exists). % Arc Cosine +is_math_op('acosh', 1, exists). % Hyperbolic Arc Cosine +is_math_op('asin', 1, exists). % Arc Sine +is_math_op('asinh', 1, exists). % Hyperbolic Arc Sine +is_math_op('atan', 1, exists). % Arc Tangent +is_math_op('atan2', 2, exists). % Two-Argument Arc Tangent +is_math_op('atanh', 1, exists). % Hyperbolic Arc Tangent +is_math_op('cbrt', 1, exists). % Cube Root +is_math_op('ceil', 1, exists). % Ceiling Function +is_math_op('ceiling', 1, exists). % Ceiling Value +is_math_op('cmpr', 2, exists). % Compare Two Values (Language Specific) +is_math_op('copysign', 2, exists). % Copy the Sign of a Number +is_math_op('cos', 1, exists). % Cosine Function +is_math_op('cosh', 1, exists). % Hyperbolic Cosine +is_math_op('cputime', 0, exists). % CPU Time +is_math_op('degrees', 1, exists). % Convert Radians to Degrees +is_math_op('denominator', 1, exists). % Get Denominator of Rational Number +is_math_op('div', 2, exists). % Integer Division +is_math_op('e', 0, exists). % Euler's Number +is_math_op('epsilon', 0, exists). % Machine Epsilon +is_math_op('erf', 1, exists). % Error Function +is_math_op('erfc', 1, exists). % Complementary Error Function +is_math_op('eval', 1, exists). % Evaluate Expression +is_math_op('exp', 1, exists). % Exponential Function +is_math_op('expm1', 1, exists). % exp(x) - 1 +is_math_op('fabs', 1, exists). % Absolute Value (Floating-Point) +is_math_op('float', 1, exists). % Convert Rational to Float +is_math_op('float_fractional_part', 1, exists). % Fractional Part of Float +is_math_op('float_integer_part', 1, exists). % Integer Part of Float +is_math_op('floor', 1, exists). % Floor Value +is_math_op('fmod', 2, exists). % Floating-Point Modulo Operation +is_math_op('frexp', 2, exists). % Get Mantissa and Exponent +is_math_op('fsum', 1, exists). % Accurate Floating Point Sum +is_math_op('gamma', 1, exists). % Gamma Function +is_math_op('gcd', 2, exists). % Greatest Common Divisor +is_math_op('getbit', 2, exists). % Get Bit at Position +is_math_op('hypot', 2, exists). % Euclidean Norm, Square Root of Sum of Squares +is_math_op('inf', 0, exists). % Positive Infinity +is_math_op('integer', 1, exists). % Convert Float to Integer +is_math_op('isinf', 1, exists). % Check for Infinity +is_math_op('isnan', 1, exists). % Check for Not a Number +is_math_op('lcm', 2, exists). % Least Common Multiple +is_math_op('ldexp', 2, exists). % Load Exponent of a Floating Point Number +is_math_op('lgamma', 1, exists). % Log Gamma +is_math_op('log', 1, exists). % Logarithm Base e +is_math_op('log10', 1, exists). % Base 10 Logarithm +is_math_op('log1p', 1, exists). % log(1 + x) +is_math_op('log2', 1, exists). % Base 2 Logarithm +is_math_op('lsb', 1, exists). % Least Significant Bit +is_math_op('max', 2, exists). % Maximum of Two Values +is_math_op('maxr', 2, exists). % Maximum Rational Number (Language Specific) +is_math_op('min', 2, exists). % Minimum of Two Values +is_math_op('minr', 2, exists). % Minimum Rational Number (Language Specific) +is_math_op('mod', 2, exists). % Modulo Operation +is_math_op('modf', 2, exists). % Return Fractional and Integer Parts +is_math_op('msb', 1, exists). % Most Significant Bit +is_math_op('nan', 0, exists). % Not a Number +is_math_op('nexttoward', 2, exists). % Next Representable Floating-Point Value +is_math_op('numerator', 1, exists). % Get Numerator of Rational Number +is_math_op('pi', 0, exists). % Pi +is_math_op('popcount', 1, exists). % Count of Set Bits +is_math_op('pow', 2, exists). % Exponentiation +is_math_op('powm', 3, exists). % Modulo Exponentiation +is_math_op('radians', 1, exists). % Convert Degrees to Radians +is_math_op('remainder', 2, exists). % Floating-Point Remainder +is_math_op('remquo', 3, exists). % Remainder and Part of Quotient +is_math_op('round', 1, exists). % Round to Nearest Integer +is_math_op('roundeven', 1, exists). % Round to Nearest Even Integer +is_math_op('setbit', 2, exists). % Set Bit at Position +is_math_op('signbit', 1, exists). % Sign Bit of Number +is_math_op('sin', 1, exists). % Sine Function +is_math_op('sinh', 1, exists). % Hyperbolic Sine +is_math_op('sqrt', 1, exists). % Square Root +is_math_op('tan', 1, exists). % Tangent Function +is_math_op('tanh', 1, exists). % Hyperbolic Tangent +is_math_op('testbit', 2, exists). % Test Bit at Position +is_math_op('trunc', 1, exists). % Truncate Decimal to Integer +is_math_op('ulogb', 1, exists). % Unbiased Exponent of a Floating-Point Value +is_math_op('xor', 2, exists). % Exclusive OR +is_math_op('zerop', 1, exists). % Test for Zero + +%:- load_pfc_file('metta_ontology.pl.pfc'). + + diff --git a/.Attic/canary_docme/metta_utils.pl b/.Attic/canary_docme/metta_utils.pl new file mode 100644 index 00000000000..550c60f3e58 --- /dev/null +++ b/.Attic/canary_docme/metta_utils.pl @@ -0,0 +1,2561 @@ + +:- set_prolog_flag(verbose_autoload, false). +:- set_prolog_flag(verbose, silent). +:- set_prolog_flag(verbose_load, silent). +:- ensure_loaded(library(logicmoo_utils)). +:- assert((user:'$exported_op'(_,_,_):- fail)). +:- abolish((system:'$exported_op'/3)). +:- assert((system:'$exported_op'(_,_,_):- fail)). + +:- if(exists_source(library(logicmoo_utils))). +:- ensure_loaded(library(logicmoo_utils)). +:- endif. +:- if(exists_source(library(dictoo))). +%:- ensure_loaded(library(dictoo)). +:- endif. + + + +:- dynamic(done_once/1). +do_once(G):- + ((done_once(GG),GG=@=G) -> true + ;(assert(done_once(G)),(once(@(G,user))->true;retract(done_once(G))))). + +cleanup_debug:- + forall( + (clause(prolog_debug:debugging(A1,B,C),Body,Cl1), + clause(prolog_debug:debugging(A2,B,C),Body,Cl2), + A1=@=A2,Cl1\==Cl2), + erase(Cl2)). + +:- export(plain_var/1). +plain_var(V):- notrace((var(V), \+ attvar(V), \+ get_attr(V,ci,_))). +catch_nolog(G):- ignore(catch(notrace(G),E,once(true;nop(u_dmsg(E=G))))). +catch_log(G):- ignore(catch((G),E,((u_dmsg(E=G),ugtrace(G))))). +% catch_log(G):- ignore(catch(notrace(G),E,((writeln(E=G),catch_nolog(ds))))). + +get_user_error(UE):- stream_property(UE,file_no(2)),!. +get_user_error(UE):- stream_property(UE,alias(user_error)),!. + +ufmt(G):- notrace((fbug(G)->true;ufmt0(G))). +ufmt0(G):- fmt(G)->true;writeln(G). +u_dmsg(G):- is_list(G),!,my_maplist(u_dmsg,G). +u_dmsg(M):- get_user_error(UE), \+ current_predicate(with_toplevel_pp/2),!, with_output_to(UE,ufmt(M)). +u_dmsg(M):- get_user_error(UE),!, with_toplevel_pp(ansi, with_output_to(UE,ufmt(M))). +u_dmsg(M):- get_user_error(UE), stream_property(UO,file_no(1)), current_output(CO),!, + (UO==CO -> fbug(M) ; + (with_toplevel_pp(ansi, with_output_to(UE,ufmt(M))), with_output_to(CO,pp(M)))). +u_dmsg(G):-ufmt(G),!. + + +:- multifile(is_cgi/0). +:- dynamic(is_cgi/0). +:- multifile(arc_html/0). +:- dynamic(arc_html/0). + + +logicmoo_use_swish:- + set_prolog_flag(use_arc_swish,true), + ld_logicmoo_webui,call(call,webui_start_swish_and_clio), + http_handler('/swish', http_redirect(moved, '/swish/'), []). + +arc_user(Nonvar):- nonvar(Nonvar),!,arc_user(Var),!,Nonvar=Var. +arc_user(main):- main_thread, !. %\+ if_thread_main(fail),!. +arc_user(ID):- catch((pengine:pengine_user(ID)),_,fail),!. +arc_user(ID):- catch((xlisting_web:is_cgi_stream,xlisting_web:find_http_session(User),http_session:session_data(User,username(ID))),_,fail),!. +arc_user(ID):- catch((is_cgi, (xlisting_web:find_http_session(ID))),_,fail),!. +arc_user(ID):- is_cgi,!,ID=web_user. +arc_user(ID):- thread_self(ID). + +:- dynamic(arc_user_prop/3). + +%luser_setval(N,V):- nb_setval(N,V),!. +luser_setval(N,V):- arc_user(ID),luser_setval(ID,N,V),!. +luser_setval(ID,N,V):- \+ (arc_sensical_term(N),arc_sensical_term(V)), + warn_skip(not_arc_sensical_term(luser_setval(ID,N,V))). +luser_setval(ID,N,V):- + (atom(N)->nb_setval(N,V);true), + retractall(arc_user_prop(ID,N,_)),asserta(arc_user_prop(ID,N,V)). + + +luser_unsetval(N):- ignore(nb_delete(N)), arc_user(ID),luser_unsetval(ID,N),!. +luser_unsetval(ID,N):- retractall(arc_user_prop(ID,N,_)). + +set_luser_default(N,V):- luser_setval(global,N,V). +luser_default(N,V):- var(V),!,luser_getval(N,V). +luser_default(N,V):- set_luser_default(N,V). + +luser_linkval(N,V):- arc_user(ID),luser_linkval(ID,N,V),!. +luser_linkval(ID,N,V):- \+ var(V), \+ (arc_sensical_term(N),arc_sensical_term(V)), + trace, + warn_skip(not_arc_sensical_term(luser_linkval(ID,N,V))). +luser_linkval(ID,N,V):- + (atom(N)->nb_linkval(N,V);true), + retractall(arc_user_prop(ID,N,_)),asserta(arc_user_prop(ID,N,V)). + +arc_sensical_term(O):- nonvar(O), O\==[], O\=='', O \= (_ - _), O\==end_of_file. +arc_sensical_term(V,O):- arc_sensical_term(V), !, O=V. + +%arc_option(grid_size_only):- !,fail. +arc_option(O):- luser_getval(O,t). +if_arc_option(O,G):- (arc_option(O)->must_det_ll(G); true). + +with_luser(N,V,Goal):- + (luser_getval(N,OV);OV=[]), + setup_call_cleanup( + luser_setval(N,V), + once(Goal), + luser_setval(N,OV)). + +%luser_getval(N,V):- nb_current(N,VVV),arc_sensical_term(VVV,VV),!,V=VV. +% caches the valuetemp on this thread +luser_getval(N,V):- luser_getval_0(N,VV),VV=V,arc_sensical_term(V),!. + +luser_getval_0(arc_user,V):- arc_user(V). +luser_getval_0(N,V):- luser_getval_1(N,V). + +luser_getval_1(N,V):- luser_getval_2(N,V). +luser_getval_1(N,V):- luser_getval_3(N,V), \+ (luser_getval_2(N,VV), nop(VV\=V)). +luser_getval_1(N,V):- get_luser_default(N,V), \+ (luser_getval_3(N,VV), nop(VV\=V)), \+ (luser_getval_2(N,VV), nop(VV\=V)). + +%luser_getval_0(N,V):- luser_getval_2(N,V), \+ luser_getval_1(N,_). +%luser_getval_0(N,V):- luser_getval_3(N,V), \+ luser_getval_2(N,_), \+ luser_getval_1(N,_). +%luser_getval_3(N,V):- is_cgi, current_predicate(get_param_req/2),get_param_req(N,M),url_decode_term(M,V). +luser_getval_2(N,V):- \+ main_thread, atom(N), httpd_wrapper:http_current_request(Request), member(search(List),Request),member(N=VV,List),url_decode_term(VV,V),arc_sensical_term(V),!. +luser_getval_2(N,V):- atom(N), nb_current(N,ValV),arc_sensical_term(ValV,Val),Val=V. + +luser_getval_3(N,V):- arc_user(ID), arc_user_prop(ID,N,V). +luser_getval_3(_,_):- \+ is_cgi, !, fail. +luser_getval_3(N,V):- \+ main_thread, atom(N), current_predicate(get_param_sess/2),get_param_sess(N,M),url_decode_term(M,V),arc_sensical_term(V). +%luser_getval_3(N,V):- atom(N), nb_current(N,ValV),arc_sensical_term(ValV,Val),Val=V. + + +get_luser_default(N,V):- arc_user_prop(global,N,VV),VV=V,arc_sensical_term(V),!. +get_luser_default(N,V):- atom(N), current_prolog_flag(N,VV),VV=V,arc_sensical_term(V),!. +%luser_getval(ID,N,V):- thread_self(ID),nb_current(N,V),!. +%luser_getval(ID,N,V):- !, ((arc_user_prop(ID,N,V);nb_current(N,V))*->true;arc_user_prop(global,N,V)). + + +ansi_main:- thread_self(main),nop(is_cgi),!. + +main_thread:- thread_self(main),!. +if_thread_main(G):- main_thread->call(G);true. + + + + +:- if(\+ current_predicate(fbug/1)). +%fbug(P):- format(user_error,'~N~p~n',[P]). +:- endif. + + + +substM(T, F, R, R):- T==F,!. +substM(T, _, _, R):- \+ compound(T),!,R=T. +substM([H1|T1], F, R, [H2|T2]) :- !, substM(H1, F, R, H2), substM(T1, F, R, T2). +substM(C1, F, R, C2) :- C1 =.. [Fn|A1], substM_l(A1,F,R,A2),!, C2 =.. [Fn|A2]. +substM_l([], _, _, []). substM_l([H1|T1], F, R, [H2|T2]) :- substM(H1, F, R, H2), substM_l(T1, F, R, T2). + + +pp_m(Cl):- write_src(Cl),!. +pp_m(C,Cl):- color_g_mesg(C,write_src(Cl)),!. +% notrace((format('~N'), ignore(( \+ ((numbervars(Cl,0,_,[singletons(true)]), print_tree_with_final(Cl,"."))))))). +pp_q(Cl):- + notrace((format('~N'), ignore(( \+ ((numbervars(Cl,0,_,[singletons(true)]), print_tree_with_final(Cl,"."))))))). + + +ncatch(G,E,F):- catch(G,E,F). +mcatch(G,E,F):- catch(G,E,F). +%mcatch(G,E,F):- catch(G,E,(fbug(G=E),catch(bt,_,fail),fbug(G=E),ignore(call(F)),throw(E))). +%ncatch(G,E,F):- catch(G,E,(fbug(G=E),catch(bt,_,fail),fbug(G=E),call(G))). +%ncatch(G,E,(F)). + + +:- if( \+ current_predicate(if_t/2)). +:- meta_predicate(if_t(0,0)). +if_t(IF, THEN) :- call(call,ignore((((IF,THEN))))). +:- endif. + +:- if( \+ current_predicate(must_ll/1)). +:- meta_predicate(must_ll(0)). +must_ll(G):- md(call,G)*->true;throw(not_at_least_once(G)). +:- endif. + +:- if( \+ current_predicate(at_least_once/1)). +:- meta_predicate(at_least_once(0)). +at_least_once(G):- call(G)*->true;throw(not_at_least_once(G)). +:- endif. + +%wraps_each(must_ll,call). +wraps_each(must_det_ll,once). +md_like(MD):- wraps_each(MD,_). + +remove_must_det(_):- !,fail. +%remove_must_det(MD):- !. +%remove_must_det(MD):- nb_current(remove_must_det(MD),TF),!,TF==true. +%remove_must_det(MD):- \+ false. + +%remove_mds(MD,G,GGG):- compound(G), G = must_det_ll(GG),!,expand_goal(GG,GGG),!. +%remove_mds(MD,G,GGG):- compound(G), G = must_det_l(GG),!,expand_goal(GG,GGG),!. +remove_mds(MD,GG,GO):- sub_term(G,GG),compound(G),compound_name_arg(G,MD,GGGG),subst001(GG,G,GGGG,GGG),remove_mds(MD,GGG,GO). +remove_mds(_,GG,GG). +%remove_mds(MD,G,GG):- compound(G), G = ..[MD,AA], compound(G),removed_term(G,GO),expand_goal(GO,GG). + +%never_rrtrace:-!. +never_rrtrace:- nb_current(cant_rrtrace,t),!,notrace. +never_rrtrace:- is_cgi,notrace. + + +%itrace:- !. +%itrace:- \+ current_prolog_flag(debug,true),!. +itrace:- if_thread_main(trace),!. +ibreak:- if_thread_main(((trace,break))). +%recolor(_,_):- ibreak. + +%tc_arg(N,C,E):- compound(C),!,arg(N,C,E). +tc_arg(N,C,E):- catch(arg(N,C,E),Err, + /*unrepress_output*/((bt,fbug(tc_arg(N,C,E)=Err),((tracing->true;trace),break,arg(N,C,E))))). + + + + + + +compound_name_arg(G,MD,Goal):- var(G),!,atom(MD),G=..[MD,Goal]. +compound_name_arg(G,MD,Goal):- compound(G),!, compound_name_arguments(G,MD,[Goal]). + + +:- multifile(user:message_hook/3). +:- dynamic(user:message_hook/3). +%user:message_hook(Term, Kind, Lines):- error==Kind, itrace,fbug(user:message_hook(Term, Kind, Lines)),trace,fail. +user:message_hook(Term, Kind, Lines):- + fail, error==Kind, + fbug(message_hook(Term, Kind, Lines)),fail. + +:- meta_predicate(must_det_ll(0)). +:- meta_predicate(must_det_ll1(1,0)). +:- meta_predicate(md_failed(1,0)). +:- meta_predicate(must_not_error(0)). +%:- meta_predicate(must_det_l(0)). + +%:- no_xdbg_flags. +:- meta_predicate(wno_must(0)). + +wno_must(G):- locally(nb_setval(no_must_det_ll,t),locally(nb_setval(cant_rrtrace,t),call(G))). + +md_maplist(_MD,_,[]):-!. +md_maplist(MD,P1,[H|T]):- call(MD,call(P1,H)), md_maplist(MD,P1,T). + +md_maplist(_MD,_,[],[]):-!. +md_maplist(MD,P2,[HA|TA],[HB|TB]):- call(MD,call(P2,HA,HB)), md_maplist(MD,P2,TA,TB). + +md_maplist(_MD,_,[],[],[]):-!. +md_maplist(MD,P3,[HA|TA],[HB|TB],[HC|TC]):- call(MD,call(P3,HA,HB,HC)), md_maplist(MD,P3,TA,TB,TC). + +%must_det_ll(G):- !, once((/*notrace*/(G)*->true;md_failed(P1,G))). + +%:- if( \+ current_predicate(must_det_ll/1)). +must_det_ll(X):- tracing,!,once(X). +must_det_ll(X):- md(once,X). +%:- endif. + +md(P1,G):- tracing,!, call(P1,G). % once((call(G)*->true;md_failed(P1,G))). +md(P1,G):- remove_must_det(MD), wraps_each(MD,P1),!,call(G). +md(P1,G):- never_rrtrace,!, call(P1,G). +md(P1,G):- /*notrace*/(arc_html),!, ignore(/*notrace*/(call(P1,G))),!. +%md(P1,X):- !,must_not_error(X). +md(P1,(X,Goal)):- is_trace_call(X),!,call((itrace,call(P1,Goal))). +md(_, X):- is_trace_call(X),!,itrace. +md(P1, X):- nb_current(no_must_det_ll,t),!,call(P1,X). +md(P1,X):- \+ callable(X), !, throw(md_not_callable(P1,X)). +md(P1,(A*->X;Y)):- !,(must_not_error(A)*->md(P1,X);md(P1,Y)). +md(P1,(A->X;Y)):- !,(must_not_error(A)->md(P1,X);md(P1,Y)). +md(P1,(X,Cut)):- (Cut==(!)),md(P1,X),!. +md(MD,maplist(P1,List)):- !, call(MD,md_maplist(MD,P1,List)). +md(MD,maplist(P2,ListA,ListB)):- !, call(MD,md_maplist(MD,P2,ListA,ListB)). +md(MD,maplist(P3,ListA,ListB,ListC)):- !, call(MD,md_maplist(MD,P3,ListA,ListB,ListC)). +md(P1,(X,Cut,Y)):- (Cut==(!)), !, (md(P1,X),!,md(P1,Y)). +md(P1,(X,Y)):- !, (md(P1,X),md(P1,Y)). +%md(P1,X):- /*notrace*/(ncatch(X,_,fail)),!. +%md(P1,X):- conjuncts_to_list(X,List),List\=[_],!,maplist(must_det_ll,List). +md(_,must_det_ll(X)):- !, must_det_ll(X). +md(_,grid_call(P2,I,O)):- !, must_grid_call(P2,I,O). +%md(P1,call(P2,I,O)):- !, must_grid_call(P2,I,O). +%md(P1,(X,Y,Z)):- !, (md(P1,X)->md(P1,Y)->md(P1,Z)). +%md(P1,(X,Y)):- !, (md(P1,X)->md(P1,Y)). +%md(P1,if_t(X,Y)):- !, if_t(must_not_error(X),md(P1,Y)). +md(P1,forall(X,Y)):- !, md(P1,forall(must_not_error(X),must_not_error(Y))). +md(P1,\+ (X, \+ Y)):- !, md(P1,forall(must_not_error(X),must_not_error(Y))). + +md(P1,(X;Y)):- !, ((must_not_error(X);must_not_error(Y))->true;md_failed(P1,X;Y)). +md(P1,\+ (X)):- !, (\+ must_not_error(X) -> true ; md_failed(P1,\+ X)). +%md(P1,(M:Y)):- nonvar(M), !, M:md(P1,Y). +md(P1,X):- + ncatch(must_det_ll1(P1,X), + md_failed(P1,G,N), % <- ExceptionTerm + % bubble up and start running + ((M is N -1, M>0)->throw(md_failed(P1,G,M));(ugtrace(md_failed(P1,G,M),X),throw('$aborted')))),!. +%must_det_ll(X):- must_det_ll1(P1,X),!. + +must_det_ll1(P1,X):- tracing,!,must_not_error(call(P1,X)),!. +must_det_ll1(P1,once(A)):- !, once(md(P1,A)). +must_det_ll1(P1,X):- + strip_module(X,M,P),functor(P,F,A), + setup_call_cleanup(nop(trace(M:F/A,+fail)),(must_not_error(call(P1,X))*->true;md_failed(P1,X)), + nop(trace(M:F/A,-fail))),!. + + +%must_not_error(G):- must(once(G)). + +must_not_error(G):- (tracing;never_rrtrace),!,call(G). +must_not_error(G):- notrace(is_cgi),!, ncatch((G),E,((u_dmsg(E=G)))). +%must_not_error(X):- is_guitracer,!, call(X). +%must_not_error(G):- !, call(G). +must_not_error(X):- !,ncatch(X,E,(fbug(E=X),ugtrace(error(E),X))). +must_not_error(X):- ncatch(X,E,(rethrow_abort(E);(/*arcST,*/writeq(E=X),pp(etrace=X), + trace, + rrtrace(visible_rtrace([-all,+exception]),X)))). + + +always_rethrow('$aborted'). +always_rethrow(md_failed(_,_,_)). +always_rethrow(return(_)). +always_rethrow(metta_return(_)). +always_rethrow(give_up(_)). +always_rethrow(time_limit_exceeded(_)). +always_rethrow(depth_limit_exceeded). +always_rethrow(restart_reading). +always_rethrow(E):- never_rrtrace,!,throw(E). + +%catch_non_abort(Goal):- cant_rrtrace(Goal). +catch_non_abort(Goal):- catch(cant_rrtrace(Goal),E,rethrow_abort(E)),!. +rethrow_abort(E):- format(user_error,'~N~q~n',[catch_non_abort_or_abort(E)]),fail. +%rethrow_abort(time_limit_exceeded):-!. +rethrow_abort('$aborted'):- !, throw('$aborted'),!,forall(between(1,700,_),sleep(0.01)),writeln(timeout),!,fail. +rethrow_abort(E):- ds,!,format(user_error,'~N~q~n',[catch_non_abort(E)]),!. + +cant_rrtrace(Goal):- never_rrtrace,!,call(Goal). +cant_rrtrace(Goal):- setup_call_cleanup(cant_rrtrace,Goal,can_rrtrace). + +main_debug:- main_thread,current_prolog_flag(debug,true). +cant_rrtrace:- nb_setval(cant_rrtrace,t). +can_rrtrace:- nb_setval(cant_rrtrace,f). +%md_failed(P1,X):- predicate_property(X,number_of_clauses(1)),clause(X,(A,B,C,Body)), (B\==!),!,must_det_ll(A),must_det_ll((B,C,Body)). + +md_failed(P1,X):- notrace((write_src_uo(failed(P1,X)),fail)). +md_failed(P1,X):- tracing,visible_rtrace([-all,+fail,+call,+exception],call(P1,X)). +md_failed(P1,X):- \+ tracing, !, visible_rtrace([-all,+fail,+exit,+call,+exception],call(P1,X)). +md_failed(P1,G):- is_cgi, \+ main_debug, !, u_dmsg(arc_html(md_failed(P1,G))),fail. +md_failed(_P1,G):- option_value(testing,true),!, + T='FAILEDDDDDDDDDDDDDDDDDDDDDDDDDD!!!!!!!!!!!!!'(G), + write_src_uo(T), give_up(T,G). +md_failed(P1,G):- never_rrtrace,!,notrace,/*notrace*/(u_dmsg(md_failed(P1,G))),!,throw(md_failed(P1,G,2)). +%md_failed(P1,G):- tracing,call(P1,G). +md_failed(_,_):- never_rrtrace,!,fail. +md_failed(P1,X):- notrace,is_guitracer,u_dmsg(failed(X))/*,arcST*/,nortrace,atrace,call(P1,X). +md_failed(P1,G):- main_debug,/*notrace*/(write_src_uo(md_failed(P1,G))),!,throw(md_failed(P1,G,2)). +% must_det_ll(X):- must_det_ll(X),!. + +write_src_uo(G):- + stream_property(S,file_no(1)), + with_output_to(S, + (format('~N~n~n',[]), + write_src(G), + format('~N~n~n'))),!, + %stack_dump, + stream_property(S2,file_no(2)), + with_output_to(S2, + (format('~N~n~n',[]), + write_src(G), + format('~N~n~n'))),!. + +:- meta_predicate(rrtrace(0)). +rrtrace(X):- rrtrace(etrace,X). + +stack_dump:- ignore(catch(bt,_,true)). %,ignore(catch(dumpST,_,true)),ignore(catch(bts,_,true)). +ugtrace(error(Why),G):- !, notrace,write_src_uo(Why),stack_dump,write_src_uo(Why),rtrace(G). +ugtrace(Why,G):- tracing,!,notrace,write_src(Why),rtrace(G). +ugtrace(Why,_):- is_testing, !, ignore(give_up(Why,5)),throw('$aborted'). +ugtrace(_Why,G):- ggtrace(G),throw('$aborted'). +%ugtrace(Why,G):- ggtrace(G). + +give_up(Why,_):- is_testing,!,write_src_uo(Why),!, throw(give_up(Why)). +give_up(Why,N):- is_testing,!,write_src_uo(Why),!, halt(N). +give_up(Why,_):- write_src_uo(Why),throw('$aborted'). + +is_guitracer:- getenv('DISPLAY',_), current_prolog_flag(gui_tracer,true). +:- meta_predicate(rrtrace(1,0)). +rrtrace(P1,X):- never_rrtrace,!,nop((u_dmsg(cant_rrtrace(P1,X)))),!,fail. +rrtrace(P1,G):- is_cgi,!, u_dmsg(arc_html(rrtrace(P1,G))),call(P1,G). +rrtrace(P1,X):- notrace, \+ is_guitracer,!,nortrace, /*arcST, sleep(0.5), trace,*/ + (notrace(\+ current_prolog_flag(gui_tracer,true)) -> call(P1,X); (itrace,call(P1,X))). +%rrtrace(_,X):- is_guitracer,!,notrace,nortrace,ncatch(call(call,ugtrace),_,true),atrace,call(X). +rrtrace(P1,X):- itrace,!, call(P1,X). + +:- meta_predicate(arc_wote(0)). +arc_wote(G):- with_pp(ansi,wote(G)). +arcST:- itrace,arc_wote(bts),itrace. +atrace:- arc_wote(bts). +%atrace:- ignore((stream_property(X,file_no(2)), with_output_to(X,dumpST))),!. + +:- meta_predicate(odd_failure(0)). +odd_failure(G):- never_rrtrace,!,call(G). +odd_failure(G):- wno_must(G)*->true;fail_odd_failure(G). + +:- meta_predicate(fail_odd_failure(0)). +fail_odd_failure(G):- u_dmsg(odd_failure(G)),rtrace(G), fail. +%fail_odd_failure(G):- call(G)*->true;(u_dmsg(odd_failure(G)),fail,rrtrace(G)). + + +bts:- + ensure_loaded(library(prolog_stack)), + prolog_stack:export(prolog_stack:get_prolog_backtrace_lc/3), + use_module(library(prolog_stack),[print_prolog_backtrace/2,get_prolog_backtrace_lc/3]), + /*notrace*/(prolog_stack:call(call,get_prolog_backtrace_lc,8000, Stack, [goal_depth(600)])), + stream_property(S,file_no(1)), prolog_stack:print_prolog_backtrace(S, Stack), + ignore((fail, current_output(Out), \+ stream_property(Out,file_no(1)), print_prolog_backtrace(Out, Stack))),!. + +my_assertion(G):- my_assertion(call(G),G). + +my_assertion(_,G):- call(G),!. +my_assertion(Why,G):- u_dmsg(my_assertion(Why,G)),writeq(Why=goal(G)),nl,!,ibreak. + +must_be_free(Free):- plain_var(Free),!. +must_be_free(Free):- \+ nonvar_or_ci(Free),!. +must_be_free(Nonfree):- arcST,u_dmsg(must_be_free(Nonfree)), + ignore((attvar(Nonfree),get_attrs(Nonfree,ATTS),pp(ATTS))),ibreak,fail. + +must_be_nonvar(Nonvar):- nonvar_or_ci(Nonvar),!. +must_be_nonvar(IsVar):- arcST,u_dmsg(must_be_nonvar(IsVar)),ibreak,fail. + + +% goal_expansion(must_det_l(G),I,must_det_ll(G),O):- nonvar(I),source_location(_,_), nonvar(G),I=O. + +%goal_expansion(G,I,GG,O):- nonvar(I),source_location(_,_), compound(G), remove_mds(MD,G,GG),I=O. + +%:- system:ensure_loaded(library(pfc_lib)). +%:- expects_dialect(pfc). +/* +goal_expansion(Goal,Out):- compound(Goal), tc_arg(N1,Goal,E), + compound(E), E = set(Obj,Member), setarg(N1,Goal,Var), + expand_goal((Goal,b_set_dict(Member,Obj,Var)),Out). +*/ +get_setarg_p1(P3,E,Cmpd,SA):- compound(Cmpd), get_setarg_p2(P3,E,Cmpd,SA). +get_setarg_p2(P3,E,Cmpd,SA):- arg(N1,Cmpd,E), SA=call(P3,N1,Cmpd). +get_setarg_p2(P3,E,Cmpd,SA):- arg(_,Cmpd,Arg),get_setarg_p1(P3,E,Arg,SA). + +my_b_set_dict(Member,Obj,Var):- set_omemberh(b,Member,Obj,Var). +%nb_set_dict(Member,Obj,Var), +set_omemberh(_,Member,Obj,Var):- !, arc_setval(Obj,Member,Var). +%nb_link_dict(Member,Obj,Var), +%set_omemberh(nb,Member,Obj,Var):- !, nb_set_dict(Member,Obj,Var). +%set_omemberh(link,Member,Obj,Var):- !, nb_link_dict(Member,Obj,Var). +%set_omemberh(How,Member,Obj,Var):- call(call,How,Member,Obj,Var),!. + +set_omember(Member,Obj,Var):- set_omember(b,Member,Obj,Var). + +set_omember(How,Member,Obj,Var):- + must_be_nonvar(Member), must_be_nonvar(Obj), must_be_nonvar(How), !, + set_omemberh(How,Member,Obj,Var),!. + + + +get_kov(K,O,V):- dictoo:is_dot_hook(user,O,K,V),!,o_m_v(O,K,V). +get_kov(K,O,V):- ((get_kov1(K,O,V)*->true;(get_kov1(props,O,VV),get_kov1(K,VV,V)))). + +get_kov1(K,O,V):- (is_hooked_obj(O),o_m_v(O,K,V))*->true;get_kov2(K,O,V). +% (get_kov(Prop,VM,Value) -> true ; (get_kov(props,VM,Hashmap),nonvar(Hashmap),must_not_error(nb_get_value(Hashmap,Prop,ValueOOV)),get_oov_value(ValueOOV,Value))). +get_kov2(K,O,V):- is_dict(O),!,get_dict(K,O,OOV),get_oov_value(OOV,V). +get_kov2(K,O,V):- nonvar(K),is_rbtree(O),!,rb_lookup(K,V,O). +get_kov2(K,O,V):- is_rbtree(O),!,rb_in(K,V,OOV),get_oov_value(OOV,V). +%get_kov(K,O,V):- is_rbtree(O),!,nb_rb_get_node(K,O,Node),nb_rb_node_value(Node,V). + +get_oov_value(ValueOOV,Value):- compound(ValueOOV),ValueOOV=oov(Value),!. +get_oov_value(Value,Value). + + +term_expansion_setter(I,O):- maybe_expand_md(must_det_ll,I,O),I\=@=O,!. +term_expansion_setter(I,O):- maybe_expand_md(must_det_ll,I,M),I\=@=M,!,term_expansion_setter(M,O). +term_expansion_setter(Goal,get_kov(Func,Self,Value)):- compound(Goal), + compound_name_arguments(Goal,'.',[ Self, Func, Value]),var(Value). + +term_expansion_setter((Head:-Body),Out):- + get_setarg_p1(setarg,I,Head,P1), is_setter_syntax(I,Obj,Member,Var,How), + call(P1,Var), + BodyCode = (Body, set_omember(How,Member,Obj,Var)), + % goal_expansion_setter(BodyCode,Goal), + expand_term((Head:- BodyCode),Out),!. + +%term_expansion_setter((Head:-Body),(Head:-GBody)):- goal_expansion_setter(Body,GBody),!. + +:- export(term_expansion_setter/2). +:- system:import(term_expansion_setter/2). + +%goal_expansion(Goal,'.'(Training, Objs, Obj)):- Goal = ('.'(Training, Objs, A), Obj = V), var(Obj). + +is_setter_syntax(I,_Obj,_Member,_Var,_):- \+ compound(I),!,fail. +is_setter_syntax(set(Obj,Member),Obj,Member,_Var,b). +is_setter_syntax(gset(Obj,Member),Obj,Member,_Var,nb). +is_setter_syntax(hset(How,Obj,Member),Obj,Member,_Var,How). +is_setter_syntax(set(ObjMember),Obj,Member,_Var,b):- obj_member_syntax(ObjMember,Obj,Member). +is_setter_syntax(gset(ObjMember),Obj,Member,_Var,nb):- obj_member_syntax(ObjMember,Obj,Member). +is_setter_syntax(hset(How,ObjMember),Obj,Member,_Var,How):- obj_member_syntax(ObjMember,Obj,Member). + +obj_member_syntax(ObjMember,Obj,Member):-compound(ObjMember), compound_name_arguments(ObjMember,'.',[Obj,Member]),!. + +maybe_expand_md(_MD,I,_):- \+ compound(I),!,fail. +%maybe_expand_md(MD,I,_):- compound(I),!,fail. % THIS DISABLES +% THIS DISABLES +%maybe_expand_md(MD,must_det_ll(GoalL),GoalL):-!. +maybe_expand_md(MD,MDGoal,GoalLO):- compound_name_arg(MDGoal,MD,Goal),!, expand_md(MD,Goal,GoalLO). +maybe_expand_md(MD,maplist(P1,GoalL),GoalLO):- P1 ==MD,!, + expand_md(MD,GoalL,GoalLO). +maybe_expand_md(MD,maplist(P1,GoalL),GoalLO):- P1 ==MD,!, + expand_md(MD,GoalL,GoalLO). +maybe_expand_md(MD,I,O):- sub_term(C,I),compound(C), compound_name_arg(C,MD,Goal), + compound(Goal),Goal=(_,_), + once((expand_md(MD,Goal,GoalO),substM(I,C,GoalO,O))),I\=@=O. + + +%maybe_expand_md(MD,I,O):- sub_term(S,I),compound(S),S=must_det_ll(G), +% once(expand_md(MD,S,M)),M\=S, + + + +expand_md(_MD,Nil,true):- Nil==[],!. +expand_md(_MD,Var,Var):- \+ callable(Var),!. +expand_md(MD,[A|B],(AA,BB)):- assertion(callable(A)), assertion(is_list(B)), !, + expand_md1(MD,A,AA), expand_md(MD,B,BB). +expand_md(MD,A,AA):- !, expand_md1(MD,A,AA). + +prevents_expansion(A):- is_trace_call(A). +is_trace_call(A):- A == trace. +is_trace_call(A):- A == itrace. + +skip_expansion(A):- var(A),!,fail. +skip_expansion(!). +skip_expansion(false). +skip_expansion(true). +skip_expansion(C):- compound(C),functor(C,F,A),skip_fa_expansion(F,A). +skip_fa_expansion(once,1). +skip_fa_expansion(call,_). +skip_fa_expansion(if_t,2). + +expand_md1(_MD,Var,Var):- \+ callable(Var),!. +expand_md1(_MD,Cut,Cut):- skip_expansion(Cut),!. +expand_md1(MD,MDAB, AABB):- compound(MDAB), compound_name_arg(MDAB,MD,AB),!, expand_md(MD,AB,AABB). +expand_md1(MD,maplist(P1,A),md_maplist(MD,P1,A)):-!. +expand_md1(MD,maplist(P2,A,B),md_maplist(MD,P2,A,B)):-!. +expand_md1(MD,maplist(P3,A,B,C),md_maplist(MD,P3,A,B,C)):-!. +expand_md1(MD,my_maplist(P1,A),md_maplist(MD,P1,A)):-!. +expand_md1(MD,my_maplist(P2,A,B),md_maplist(MD,P2,A,B)):-!. +expand_md1(MD,my_maplist(P3,A,B,C),md_maplist(MD,P3,A,B,C)):-!. +%expand_md1(MD,Goal,O):- \+ compound(Goal), !,O = must_det_ll(Goal). +%expand_md1(MD,(A,B),((A,B))):- remove_must_det(MD), prevents_expansion(A),!. +%expand_md1(MD,(A,B),must_det_ll((A,B))):- prevents_expansion(A),!. +expand_md1(MD,(A,B),(AA,BB)):- !, expand_md(MD,A,AA), expand_md(MD,B,BB). +expand_md1(MD,(C*->A;B),(CC*->AA;BB)):- !, expand_md(MD,A,AA), expand_md(MD,B,BB), expand_must_not_error(C,CC). +expand_md1(MD,(C->A;B),(CC->AA;BB)):- !, expand_md(MD,A,AA), expand_md(MD,B,BB), expand_must_not_error(C,CC). +expand_md1(MD,(C;B),(CC;BB)):- !, expand_md(MD,B,BB), expand_must_not_error(C,CC). + +expand_md1(MD,locally(C,A),locally(C,AA)):- !, expand_md(MD,A,AA). + +expand_md1(MD,call_cleanup(A,B),call_cleanup(AA,BB)):- !, expand_md(MD,A,AA), expand_md(MD,B,BB). +expand_md1(MD,setup_call_cleanup(C,A,B),setup_call_cleanup(CC,AA,BB)):- !, + expand_md(MD,C,CC),expand_md(MD,A,AA), expand_md(MD,B,BB). + +expand_md1(MD,M:P, M:AABB):-!,expand_md(MD,P, AABB). + +expand_md1(MD,P, AABB) :- predicate_property(P,(meta_predicate( MP ))), + strip_module(P,_,SP),strip_module(MP,_,SMP), kaggle_arc_1_pred(_,SP), + \+ skippable_built_in(P), + SP=..[F|Args],SMP=..[F|Margs],!, + maplist(expand_meta_predicate_arg(MD),Margs,Args,EArgs), + AABB=..[F|EArgs]. + +expand_md1(MD, A, MDAA):- \+ remove_must_det(MD), !, expand_goal(A,AA),!,compound_name_arg(MDAA,MD,AA). +expand_md1(_MD, A, AA):- expand_goal(A,AA),!. + +expand_must_not_error(C,C):- remove_must_det(must_not_error),!. +expand_must_not_error(C,CC):- \+ predicate_property(C,meta_predicate(_)),!, CC = must_not_error(C),!. +expand_must_not_error(C,CC):- expand_md(must_not_error, C, CC). + +kaggle_arc_1_pred(M,P):- + predicate_property(M:P,file(F)), + \+ predicate_property(M:P,imported_from(_)), + \+ \+ atom_contains(F,'arc_'), + \+ atom_contains(F,'_pfc'), + \+ atom_contains(F,'_afc'), + % \+ atom_contains(F,'_ui_'), + true. + +%meta_builtin(P):- var(P),meta_builtin(P). +%meta_builtin(P):- predicate_property(P,interpreted),predicate_property(P,static). +skippable_built_in(MP):- strip_module(MP,_,P), predicate_property(system:P,built_in), + once(predicate_property(system:P,iso);predicate_property(system:P,notrace)). +%meta_builtin(P):- predicate_property(P,/*notrace*/), \+ predicate_property(P,nodebug). + +expand_meta_predicate_arg(_MD,'?',A,A):-!. +expand_meta_predicate_arg(_MD,'+',A,A):-!. +expand_meta_predicate_arg(_MD,'-',A,A):-!. +expand_meta_predicate_arg(MD, ':',A,AA):- !,expand_md1(MD,A,AA). +expand_meta_predicate_arg(MD, 0,A,AA):- !,expand_md1(MD,A,AA). +%expand_meta_predicate_arg(MD,*,A,AA):- !,expand_md1(MD,A,AA). +expand_meta_predicate_arg(_MD,_,A,A). + +goal_expansion_getter(Goal,O):- \+ compound(Goal), !,O = Goal. +goal_expansion_getter(I,O):- md_like(MD),maybe_expand_md(MD,I,O),I\=@=O,!. +goal_expansion_getter(I,O):- md_like(MD),maybe_expand_md(MD,I,M),I\=@=M,!,goal_expansion_getter(M,O). +goal_expansion_getter(Goal,get_kov(Func,Self,Value)):- compound(Goal), + compound_name_arguments(Goal,'.',[ Self, Func, Value]),var(Value). +goal_expansion_getter(Goal,Out):- + compound_name_arguments(Goal,F,Args), + maplist(goal_expansion_getter,Args,ArgsOut), + compound_name_arguments(Out,F,ArgsOut). + +:- export(goal_expansion_getter/2). +:- system:import(goal_expansion_getter/2). + + +goal_expansion_setter(Goal,_):- \+ compound(Goal), !, fail. + + +goal_expansion_setter(I,O):- md_like(MD),maybe_expand_md(MD,I,O),I\=@=O,!. +goal_expansion_setter(G,GO):- remove_must_det(MD), !,remove_mds(MD,G,GG),goal_expansion_setter(GG,GO). +%goal_expansion_setter(GG,GO):- remove_must_det(MD), sub_term(G,GG),compound(G),G = must_det_ll(GGGG),subst001(GG,G,GGGG,GGG),!,goal_expansion_setter(GGG,GO). +%goal_expansion_setter((G1,G2),(O1,O2)):- !, expand_goal(G1,O1), expand_goal(G2,O2),!. +goal_expansion_setter(set_omember(A,B,C,D),set_omember(A,B,C,D)):-!. +goal_expansion_setter(set_omember(A,B,C),set_omember(b,A,B,C)):-!. +goal_expansion_setter(Goal,get_kov(Func,Self,Value)):- compound(Goal), + compound_name_arguments(Goal,'.',[ Self, Func, Value]),var(Value). +goal_expansion_setter(I,O):- md_like(MD),maybe_expand_md(MD,I,M),I\=@=M,!,goal_expansion_setter(M,O). + + +goal_expansion_setter(Goal,Out):- + predicate_property(Goal,meta_predicate(_)),!,fail, + tc_arg(N1,Goal,P), goal_expansion_setter(P,MOut), + setarg(N1,Goal,MOut), !, expand_goal(Goal, Out). + +goal_expansion_setter(Goal,Out):- + tc_arg(N1,Goal,P), is_setter_syntax(P,Obj,Member,Var,How), + setarg(N1,Goal,Var), !, expand_goal((Goal,set_omember(How,Member,Obj,Var)), Out). + +goal_expansion_setter(Goal,Out):- + get_setarg_p1(setarg,I,Goal,P1), compound(I), compound_name_arguments(I,'.',[ Self, Func, Value]), + call(P1,get_kov(Func,Self,Value)),!, + expand_goal(Goal,Out). + +goal_expansion_setter(Goal,Out):- + get_setarg_p1(setarg,I,Goal,P1), is_setter_syntax(I,Obj,Member,Var,How), + call(P1,Var),!, + expand_goal((Goal,set_omember(How,Member,Obj,Var)),Out). + +:- export(goal_expansion_setter/2). +:- system:import(goal_expansion_setter/2). + + +/* +system:term_expansion((Head:-Goal),I,(Head:-Out),O):- nonvar(I), compound(Goal), + goal_expansion_setter(Goal,Out),Goal\=@=Out,I=O,!, + nop((print(goal_expansion_getter(Goal-->Out)),nl)). +*/ +arc_term_expansion1((system:term_expansion((Head:-Body),I,Out,O):- + nonvar(I), compound(Head), + term_expansion_setter((Head:-Body),Out),(Head:-Body)=In,In\==Out,I=O,!, + nop((print(term_expansion_setter(In-->Out)),nl)))). + + +%system:goal_expansion(Goal,I,Out,O):- compound(Goal),goal_expansion_getter(Goal,Out),Goal\==Out,I=O,!, +% ((print(goal_expansion_getter(Goal-->Out)),nl)). + +%user:goal_expansion(Goal,I,Out,O):- compound(Goal),goal_expansion_getter(Goal,Out),Goal\==Out,I=O,!, +% ((print(goal_expansion_getter(Goal-->Out)),nl)). + +arc_term_expansion1((goal_expansion(Goal,I,Out,O):- + goal_expansion_setter(Goal,Out),Goal\==Out,I=O,!, + nop((print(goal_expansion_setter(Goal-->Out)),nl)))). + +:- export(arc_term_expansions/1). +arc_term_expansions(H:- (current_prolog_flag(arc_term_expansion, true), B)):- + arc_term_expansion1(H:-B). + +:- export(enable_arc_expansion/0). +enable_arc_expansion:- + forall(arc_term_expansions(Rule), + (strip_module(Rule,M,Rule0), + nop(u_dmsg(asserta_if_new(Rule,M,Rule0))), + asserta_if_new(Rule))), + set_prolog_flag(arc_term_expansion, true). + +:- export(disable_arc_expansion/0). +disable_arc_expansion:- + forall(arc_term_expansions(Rule),forall(retract(Rule),true)), + set_prolog_flag(arc_term_expansion, false). + +:- multifile(goal_expansion/4). +:- dynamic(goal_expansion/4). + +goal_expansion(G,I,GG,O):- nonvar(I),source_location(_,_), + compound(G), + (remove_must_det(MD)->remove_mds(MD,G,GG);(md_like(MD),maybe_expand_md(MD,G,GG))),I=O. + + + + + + + + + + + +/* +:- export(plain_var/1). +plain_var(V):- notrace((var(V), \+ attvar(V), \+ get_attr(V,ci,_))). + +my_assertion(G):- call(G),!. +my_assertion(G):- fbug(my_assertion(G)),writeq(goal(G)),nl,!,break. +must_be_free(AllNew):- plain_var(AllNew),!. +must_be_free(AllNew):- arcST,fbug(must_be_free(AllNew)),break,fail. +must_be_nonvar(AllNew):- nonvar_or_ci(AllNew),!. +must_be_nonvar(AllNew):- arcST,fbug(must_be_nonvar(AllNew)),break,fail. + +my_len(X,Y):- var(X),!,length(X,Y). +my_len(X,Y):- is_list(X),!,length(X,Y). +my_len(X,Y):- functor([_|_],F,A),functor(X,F,A),!,length(X,Y). +my_len(X,Y):- arcST,!,ibreak. +*/ +is_map(G):- is_vm_map(G),!. +%arc_webui:- false. +sort_safe(I,O):- catch(sort(I,O),_,I=O). +my_append(A,B):- append(A,B). +my_append(A,B,C):- append(A,B,C). +with_tty_false(Goal):- with_set_stream(current_output,tty(false),Goal). +with_tty_true(Goal):- with_set_stream(current_output,tty(true),Goal). + +% Count occurrences of G and store the result in N +count_of(G,N):- findall_vset(G,G,S),length(S,N). +findall_vset(T,G,S):- findall(T,G,L),variant_list_to_set(L,S). +flatten_objects(Objs,ObjsO):- flatten([Objs],ObjsO),!. + + +var_e(E,S):- E==S,!. +var_e(E,S):- (nonvar(E);attvar(E)),!,E=@=S. + +variant_list_to_set([E|List],Out):- select(S,List,Rest),var_e(E,S),!, variant_list_to_set([E|Rest],Out). +variant_list_to_set([E|List],[E|Out]):- !, variant_list_to_set(List,Out). +variant_list_to_set(H,H). + +nb_subst(Obj,New,Old):- + get_setarg_p1(nb_setarg,Found,Obj,P1),Found=@=Old, + p1_call(P1,New),!,nb_subst(Obj,New,Old). +nb_subst(_Obj,_New,_Old). + +system:any_arc_files(Some):- is_list(Some),!, Some\==[],maplist(any_arc_files,Some). +system:any_arc_files(Some):- atom_contains(Some,'arc'). + +:- thread_local(in_memo_cached/5). +:- multifile(prolog:make_hook/2). +:- dynamic(prolog:make_hook/2). +prolog:make_hook(before, Some):- any_arc_files(Some), forall(muarc:clear_all_caches,true). + +:- multifile(muarc:clear_all_caches/0). +:- dynamic(muarc:clear_all_caches/0). +muarc:clear_all_caches:- \+ luser_getval(extreme_caching,true), retractall(in_memo_cached(_,_,_,_,_)), fail. +%arc_memoized(G):- !, call(G). + +arc_memoized(G):- compound(G),ground(G),functor(G,F,1),functor(C,F,1),!,arc_memoized(C),G=C,!. +arc_memoized(G):- + copy_term(G,C,GT), + (Key = (C+GT)), + (in_memo_cached(Key,C,track,started,Info)->throw(already_memoizing(in_memo_cached(Key,C,track,started,Info))) ; true), + numbervars(Key,0,_,[attvar(bind),singletons(true)]),!, + setup_call_cleanup((asserta(in_memo_cached(Key,C,track,started,_),Started)), + catch( + (in_memo_cached(Key,C,GT,Found,AttGoals)*->(G=Found,maplist(call,AttGoals)) + ; ((call(G),copy_term(G,CG,GG)) *->asserta(in_memo_cached(Key,C,GT,CG,GG)) + ;asserta(in_memo_cached(Key,C,GT,failed,_)))), + E, (retractall(in_memo_cached(Key,C,GT,_,_)),throw(E))),erase(Started)). + +set_nth1(1,[_|Row],E,[E|Row]):-!. +set_nth1(N,[W|Row],E,[W|RowMod]):- Nm1 is N-1, set_nth1(Nm1,Row,E,RowMod). + +findall_count(T,G,N):- findall_set(T,G,S),length(S,N). + +findall_set(T,G,S):- findall(T,G,L),list_to_set(L,S). + +make_list_inited(0,_,[]):-!. +make_list_inited(1,E,[E]):-!. +make_list_inited(N,E,[E|List]):- Nm1 is N -1,make_list_inited(Nm1,E,List). + +nth_fact(P,I):- clause(P,true,Ref),nth_clause(P,I,Ref). + +nonvar_or_ci(C):- (nonvar(C);attvar(C)),!. + +add_i(Info):- + quietly((tersify(Info,InfoT), + luser_getval(test_rules,TRules), + luser_getval(pair_rules,PRules), + nb_set_add(TRules,InfoT), + nb_set_add(PRules,InfoT), + nop(pp(cyan,+InfoT)))). + +add_i(F,Info):- + append_term(i(F),Info,FInfo), + add_i(FInfo). + +add_rule(Info):- add_i(rule,Info). +add_cond(Info):- add_i(cond,Info). +%do_action(Info):- guess_pretty(Info),add_i(action,Info),call(Info). +do_action(Call):- !, copy_term(Call,Info),call(Call),add_i(action,Info). +add_action(Info):- add_i(action,Info). +add_note(Info):- add_i(note,Info). +add_indiv(W,Info):- add_i(indiv(W),Info). +add_comparitor(Info):- add_i(comparitor,Info). +show_rules:- + luser_getval(pair_rules,PRules), maplist(pp(cyan),PRules), + luser_getval(test_rules,TRules), maplist(pp(blue),TRules), + !. + + +sub_atom_value(TestID,A):- sub_term(A,TestID),(atom(A);string(A)). + +my_list_to_set(List, Set):- my_list_to_set(List, (=) ,Set). +my_list_to_set_variant(List, Set):- my_list_to_set(List, (=@=) ,Set). +my_list_to_set_cmp(List, Set):- my_list_to_set(List, (=@=) ,Set). + +my_list_to_set([E|List],P2, Set):- select(C,List,Rest), p2_call(P2, E,C), !, my_list_to_set([E|Rest],P2, Set). +my_list_to_set([E|List],P2, [E|Set]):-!, my_list_to_set(List,P2, Set). +my_list_to_set([],_,[]). + +my_list_to_set_cmp([E|List],C3, Set):- select(C,List,Rest), call(C3,R,E,C), + R== (=), my_list_to_set_cmp([C|Rest],C3, Set),!. + my_list_to_set_cmp([E|List],C3, [E|Set]):-!, my_list_to_set_cmp(List,C3, Set). +my_list_to_set_cmp([],_,[]). + + +contains_nonvar(N,Info):- sub_term(E,Info),nonvar_or_ci(E),E=N,!. + +max_min(A,B,C,D):- must_be_free(C),must_be_free(D),max_min0(A,B,C,D). +max_min0(A,B,B,B):- plain_var(A). +max_min0(A,B,A,A):- plain_var(B),!. +max_min0(A,B,C,D):- number(A),number(B), !, ((A > B) -> (C=A, D=B) ; (C=B, D=A)). +max_min0(_,A,A,A):- number(A),!. +max_min0(A,_,A,A):- number(A),!. +max_min0(_,_,_,_). + +as_debug(L,G):- as_debug(L,true,G). +as_debug(9,_,_):- !. +as_debug(_,C,G):- ignore(catch((call(C)->wots(S,G),format('~NDEBUG: ~w~N',[S]);true),_,true)). + +shall_count_as_same(A,B):- same_term(A,B),!. % unify ok_ok cmatch +shall_count_as_same(A,B):- plain_var(A),!,A==B. +shall_count_as_same(A,B):- atomic(A),!, A=@=B. +shall_count_as_same(A,B):- var(B),!,A=@=B. +shall_count_as_same(A,B):- A=@=B,!. +shall_count_as_same(A,B):- copy_term(B,CB),copy_term(A,CA),\+ \+ ( A=B, B=@=CB, A=@=CA),!. +%shall_count_as_same(A,B):- \+ A \= B, !. + +count_each([C|L],GC,[Len-C|LL]):- include(shall_count_as_same(C),GC,Lst),length(Lst,Len),!,count_each(L,GC,LL). +count_each([],_,[]). + +count_each_inv([C|L],GC,[C-Len|LL]):- include(shall_count_as_same(C),GC,Lst),length(Lst,Len),count_each_inv(L,GC,LL). +count_each_inv([],_,[]). + +maplist_n(N,P,[H1|T1]):- + p2_call(P,N,H1), N1 is N+1, + maplist_n(N1,P,T1). +maplist_n(_N,_P,[]). + +maplist_n(N,P,[H1|T1],[H2|T2]):- + call(P,N,H1,H2), N1 is N+1, + maplist_n(N1,P,T1,T2). +maplist_n(_N,_P,[],[]). + +/* +print_points_grid(Points):- + points_range(Points, LoH, LoV, HiH, HiV, H, V), writeqln(size_range(LoH, LoV, HiH, HiV, H, V)), points_to_grid(Points, Grid), print_grid(Grid). + +print_points_grid(Grid):- + points_range(Grid, LoH, LoV, HiH, HiV, _H, _V), print_grid(Grid, LoH, LoV, HiH, HiV, Grid). +*/ + + +%print_trainer:- kaggle_arc_train(Name, Stuff), atom_json_term(Stuff, JSON, []), print_arc(Name, JSON). +%print_evaler:- kaggle_arc_eval(Name, Stuff), atom_json_term(Stuff, JSON, []), print_arc(Name, JSON). + + /* +% data looks like + +kaggle_arc_train('007bbfb7', trn, [[0, 7, 7], [7, 7, 7], [0, 7, 7]], [[0,0,0,0, 7, 7,0, 7, 7], [0,0,0, 7, 7, 7, 7, 7, 7], [0,0,0,0, 7, 7,0, 7, 7], [0, 7, 7,0, 7, 7,0, 7, 7], [7, 7, 7, 7, 7, 7, 7, 7, 7], [0, 7, 7,0, 7, 7,0, 7, 7], [0,0,0,0, 7, 7,0, 7, 7], [0,0,0, 7, 7, 7, 7, 7, 7], [0,0,0,0, 7, 7,0, 7, 7]]). +kaggle_arc_train('007bbfb7', trn, [[4,0, 4], [0,0,0], [0, 4,0]], [[4,0, 4,0,0,0, 4,0, 4], [0,0,0,0,0,0,0,0,0], [0, 4,0,0,0,0,0, 4,0], [0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0, 4,0, 4,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0,0, 4,0,0,0,0]]). +kaggle_arc_train('007bbfb7', trn, [[0,0,0], [0,0, 2], [2,0, 2]], [[0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0, 2], [0,0,0,0,0,0, 2,0, 2], [0,0,0,0,0,0,0,0,0], [0,0, 2,0,0,0,0,0, 2], [2,0, 2,0,0,0, 2,0, 2]]). +kaggle_arc_train('007bbfb7', trn, [[6, 6,0], [6,0,0], [0, 6, 6]], [[6, 6,0, 6, 6,0,0,0,0], [6,0,0, 6,0,0,0,0,0], [0, 6, 6,0, 6, 6,0,0,0], [6, 6,0,0,0,0,0,0,0], [6,0,0,0,0,0,0,0,0], [0, 6, 6,0,0,0,0,0,0], [0,0,0, 6, 6,0, 6, 6,0], [0,0,0, 6,0,0, 6,0,0], [0,0,0,0, 6, 6,0, 6, 6]]). +kaggle_arc_train('007bbfb7', trn, [[2, 2, 2], [0,0,0], [0, 2, 2]], [[2, 2, 2, 2, 2, 2, 2, 2, 2], [0,0,0,0,0,0,0,0,0], [0, 2, 2,0, 2, 2,0, 2, 2], [0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0, 2, 2, 2, 2, 2, 2], [0,0,0,0,0,0,0,0,0], [0,0,0,0, 2, 2,0, 2, 2]]). +kaggle_arc_train('007bbfb7', tst, [[7,0, 7], [7,0, 7], [7, 7,0]], [[7,0, 7,0,0,0, 7,0, 7], [7,0, 7,0,0,0, 7,0, 7], [7, 7,0,0,0,0, 7, 7,0], [7,0, 7,0,0,0, 7,0, 7], [7,0, 7,0,0,0, 7,0, 7], [7, 7,0,0,0,0, 7, 7,0], [7,0, 7, 7,0, 7,0,0,0], [7,0, 7, 7,0, 7,0,0,0], [7, 7,0, 7, 7,0,0,0,0]]). + +kaggle_arc_train('00d62c1b', trn, [[0,0,0,0,0,0], [0,0, 3,0,0,0], [0, 3,0, 3,0,0], [0,0, 3,0, 3,0], [0,0,0, 3,0,0], [0,0,0,0,0,0]], [[0,0,0,0,0,0], [0,0, 3,0,0,0], [0, 3, 4, 3,0,0], [0,0, 3, 4, 3,0], [0,0,0, 3,0,0], [0,0,0,0,0,0]]). +kaggle_arc_train('00d62c1b', trn, [[0,0,0,0,0,0,0,0,0,0], [0,0, 3,0, 3,0,0,0,0,0], [0,0,0, 3,0, 3,0,0,0,0], [0,0, 3,0,0,0, 3,0,0,0], [0,0,0,0,0, 3,0, 3,0,0], [0,0,0, 3,0, 3, 3,0,0,0], [0,0, 3, 3, 3,0,0,0,0,0], [0,0,0, 3,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0]], [[0,0,0,0,0,0,0,0,0,0], [0,0, 3,0, 3,0,0,0,0,0], [0,0,0, 3,0, 3,0,0,0,0], [0,0, 3,0,0,0, 3,0,0,0], [0,0,0,0,0, 3, 4, 3,0,0], [0,0,0, 3,0, 3, 3,0,0,0], [0,0, 3, 3, 3,0,0,0,0,0], [0,0,0, 3,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0]]). +kaggle_arc_train('00d62c1b', trn, [[0,0,0,0,0, 3,0,0,0,0], [0,0,0,0, 3,0,0,0,0,0], [0, 3, 3,0, 3, 3,0, 3,0,0], [3,0,0, 3,0,0, 3,0, 3,0], [0,0,0, 3,0,0, 3, 3,0,0], [0,0,0, 3,0,0, 3,0,0,0], [0,0,0, 3,0,0, 3,0,0,0], [0,0,0,0, 3, 3,0, 3,0,0], [0,0,0,0,0,0,0,0, 3,0], [0,0,0,0,0,0,0,0,0,0]], [[0,0,0,0,0, 3,0,0,0,0], [0,0,0,0, 3,0,0,0,0,0], [0, 3, 3,0, 3, 3,0, 3,0,0], [3,0,0, 3, 4, 4, 3, 4, 3,0], [0,0,0, 3, 4, 4, 3, 3,0,0], [0,0,0, 3, 4, 4, 3,0,0,0], [0,0,0, 3, 4, 4, 3,0,0,0], [0,0,0,0, 3, 3,0, 3,0,0], [0,0,0,0,0,0,0,0, 3,0], [0,0,0,0,0,0,0,0,0,0]]). +kaggle_arc_train('00d62c1b', trn, [[0,0,0,0,0,0,0,0,0,0], [0,0, 3, 3, 3, 3,0,0,0,0], [0,0, 3,0,0, 3,0,0,0,0], [0,0, 3,0,0, 3,0, 3,0,0], [0,0, 3, 3, 3, 3, 3, 3, 3,0], [0,0,0, 3,0,0,0,0, 3,0], [0,0,0, 3,0,0,0, 3, 3,0], [0,0,0, 3, 3,0,0, 3,0, 3], [0,0,0, 3,0, 3,0,0, 3,0], [0,0,0,0, 3,0,0,0,0,0]], [[0,0,0,0,0,0,0,0,0,0], [0,0, 3, 3, 3, 3,0,0,0,0], [0,0, 3, 4, 4, 3,0,0,0,0], [0,0, 3, 4, 4, 3,0, 3,0,0], [0,0, 3, 3, 3, 3, 3, 3, 3,0], [0,0,0, 3,0,0,0,0, 3,0], [0,0,0, 3,0,0,0, 3, 3,0], [0,0,0, 3, 3,0,0, 3, 4, 3], [0,0,0, 3, 4, 3,0,0, 3,0], [0,0,0,0, 3,0,0,0,0,0]]). +kaggle_arc_train('00d62c1b', trn, [[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0, 3,0,0,0,0,0,0,0,0,0,0,0], [0,0,0,0, 3, 3, 3, 3,0, 3, 3,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0, 3,0, 3,0,0,0,0,0,0,0, 3,0], [0,0,0,0,0,0,0,0, 3, 3, 3, 3, 3, 3, 3, 3,0,0,0,0], [0,0,0,0,0,0,0,0, 3,0,0,0,0,0,0, 3,0,0,0,0], [0,0,0,0, 3,0,0,0, 3,0,0,0,0,0,0, 3,0,0,0,0], [0,0,0,0,0,0,0,0, 3,0,0,0,0,0,0, 3,0,0,0,0], [0,0,0,0,0,0,0,0, 3,0,0,0,0,0,0, 3,0,0,0,0], [0,0, 3,0,0,0,0,0, 3, 3, 3, 3, 3, 3, 3, 3,0,0,0,0], [0,0,0,0,0,0,0,0, 3,0,0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0, 3, 3, 3,0,0,0,0, 3,0, 3,0,0], [0,0,0,0,0,0, 3, 3,0,0, 3,0,0, 3,0,0,0,0,0,0], [0,0,0,0,0,0,0, 3,0,0, 3, 3,0,0, 3,0,0, 3,0,0], [0,0,0,0,0,0,0, 3, 3, 3, 3,0, 3,0,0, 3, 3, 3,0,0], [0,0,0,0,0,0,0,0,0,0, 3,0,0,0,0, 3,0, 3,0,0], [0,0,0,0,0,0,0,0,0,0,0,0, 3,0,0, 3, 3, 3,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0, 3,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]], [[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0, 3,0,0,0,0,0,0,0,0,0,0,0], [0,0,0,0, 3, 3, 3, 3, 4, 3, 3,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0, 3, 4, 3,0,0,0,0,0,0,0, 3,0], [0,0,0,0,0,0,0,0, 3, 3, 3, 3, 3, 3, 3, 3,0,0,0,0], [0,0,0,0,0,0,0,0, 3, 4, 4, 4, 4, 4, 4, 3,0,0,0,0], [0,0,0,0, 3,0,0,0, 3, 4, 4, 4, 4, 4, 4, 3,0,0,0,0], [0,0,0,0,0,0,0,0, 3, 4, 4, 4, 4, 4, 4, 3,0,0,0,0], [0,0,0,0,0,0,0,0, 3, 4, 4, 4, 4, 4, 4, 3,0,0,0,0], [0,0, 3,0,0,0,0,0, 3, 3, 3, 3, 3, 3, 3, 3,0,0,0,0], [0,0,0,0,0,0,0,0, 3,0,0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0, 3, 3, 3,0,0,0,0, 3,0, 3,0,0], [0,0,0,0,0,0, 3, 3, 4, 4, 3,0,0, 3,0,0,0,0,0,0], [0,0,0,0,0,0,0, 3, 4, 4, 3, 3,0,0, 3,0,0, 3,0,0], [0,0,0,0,0,0,0, 3, 3, 3, 3,0, 3,0,0, 3, 3, 3,0,0], [0,0,0,0,0,0,0,0,0,0, 3,0,0,0,0, 3, 4, 3,0,0], [0,0,0,0,0,0,0,0,0,0,0,0, 3,0,0, 3, 3, 3,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0, 3,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]]). +kaggle_arc_train('00d62c1b', tst, [[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0, 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0, 3,0, 3, 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0, 3,0, 3, 3, 3, 3, 3,0, 3, 3,0,0,0,0,0,0,0,0], [0,0,0,0, 3,0,0,0,0, 3,0,0, 3,0,0,0,0,0,0,0], [0,0,0,0, 3, 3, 3, 3, 3,0, 3, 3, 3,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0, 3, 3, 3, 3, 3,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0, 3,0,0,0, 3,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0, 3,0,0,0, 3,0,0], [0,0,0,0,0,0,0,0,0, 3, 3, 3, 3, 3,0,0,0, 3,0,0], [0,0,0,0,0,0,0,0,0, 3,0,0,0, 3,0,0,0, 3,0,0], [0,0,0,0,0,0,0,0, 3, 3, 3, 3, 3, 3,0,0,0, 3,0,0], [0,0,0,0,0,0, 3, 3,0, 3,0,0,0, 3, 3, 3, 3, 3,0,0], [0,0, 3,0,0,0,0,0, 3, 3,0,0,0,0,0,0,0,0,0,0], [0, 3,0, 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0, 3,0, 3,0, 3, 3, 3, 3, 3, 3,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0, 3,0,0,0, 3,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0, 3,0,0,0, 3,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0, 3, 3, 3, 3, 3,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]], [[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0, 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0, 3, 4, 3, 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0, 3,0, 3, 3, 3, 3, 3,0, 3, 3,0,0,0,0,0,0,0,0], [0,0,0,0, 3, 4, 4, 4, 4, 3, 4, 4, 3,0,0,0,0,0,0,0], [0,0,0,0, 3, 3, 3, 3, 3,0, 3, 3, 3,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0, 3, 3, 3, 3, 3,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0, 3, 4, 4, 4, 3,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0, 3, 4, 4, 4, 3,0,0], [0,0,0,0,0,0,0,0,0, 3, 3, 3, 3, 3, 4, 4, 4, 3,0,0], [0,0,0,0,0,0,0,0,0, 3, 4, 4, 4, 3, 4, 4, 4, 3,0,0], [0,0,0,0,0,0,0,0, 3, 3, 3, 3, 3, 3, 4, 4, 4, 3,0,0], [0,0,0,0,0,0, 3, 3, 4, 3,0,0,0, 3, 3, 3, 3, 3,0,0], [0,0, 3,0,0,0,0,0, 3, 3,0,0,0,0,0,0,0,0,0,0], [0, 3, 4, 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0, 3,0, 3,0, 3, 3, 3, 3, 3, 3,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0, 3, 4, 4, 4, 3,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0, 3, 4, 4, 4, 3,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0, 3, 3, 3, 3, 3,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]]). +*/ +%tell(s), ignore((nl, nl, task_pairs(Name, ExampleNum, In, Out), format('~N~q.~n', [test_pairs_cache(Name, ExampleNum, In, Out)]), fail)), told. +map_pred(Pred, P, X) :- map_pred([],Pred, P, X). +%map_pred(NoCycles,_Pred, P, X) :- member(E,NoCycles), E==P,!, X = P. +map_pred(NoCycles,Pred, P, X) :- p2_call(Pred, P, X)*->true;map_pred0(NoCycles,Pred, P, X). + +map_pred1(Pred, P, P1) :- map_pred1(P, Pred, P, P1). + +map_pred0(_NoCycles,_Pred, Args, ArgSO) :- must_be_free(ArgSO), Args==[],!, ArgSO=[]. +map_pred0(_NoCycles, Pred, P, P1) :- p2_call(Pred, P, P1),!. % *->true;fail. +map_pred0(NoCycles,Pred, P, X) :- fail, attvar(P), !, %duplicate_term(P,X),P=X, + get_attrs(P,VS), map_pred([P|NoCycles],Pred, VS, VSX), P=X, put_attrs(X,VSX),!. +map_pred0(NoCycles,Pred, P, X):- map_pred1(NoCycles,Pred, P, X). + +map_pred1(_NoCycles,_Pred, P, P1) :- ( \+ compound(P) ; is_ftVar(P)), !, must_det_ll(P1=P), !. +% map_pred0(NoCycles,Pred, Args, ArgSO) :- is_list(Args), !, maplist(map_pred([Args|NoCycles],Pred), Args, ArgS), ArgS=ArgSO. +map_pred1(NoCycles,Pred, IO, OO) :- is_list(IO),!, maplist(map_pred(NoCycles,Pred), IO, OO). +map_pred1(NoCycles,Pred, IO, [O|ArgS]) :- IO= [I|Args], !, + map_pred([IO,ArgS|NoCycles],Pred, I, O), map_pred0([IO,I|NoCycles],Pred, Args, ArgS). +map_pred1(NoCycles,Pred, P, P1) :- + compound_name_arguments(P, F, Args), maplist(map_pred([P|NoCycles],Pred),Args,ArgS), compound_name_arguments(P1, F, ArgS). +%map_pred(_Pred, P, P). +/* +:- meta_predicate map_pred(2, ?, ?, ?, ?). +map_pred(Pred, P, X, Sk, P1) :- must_be_free(X), p2_call(Pred, P, X), !, must(Sk=P1), !. +map_pred(_Pred, P, _, _, P1) :- is_ftVar(P), !, must(P1=P), !. +map_pred(Pred, [P|Args], X, Sk, [P1|ArgS]) :- !, map_pred(Pred, P, X, Sk, P1), !, must(map_pred(Pred, Args, X, Sk, ArgS)), !. +map_pred(Pred, P, X, Sk, P1) :- compound(P), !, compound_name_arguments(P, F, Args), map_pred(Pred, [F|Args], X, Sk, [Fs|ArgS]), !, compound_name_arguments(P1, Fs, ArgS), !. +map_pred(_Pred, P, _, _, P). +*/ +is_cons(A):- compound(A),A=[_|_]. + +into_grid_or_var(G,G):- is_cons(G),!. +into_grid_or_var(G,G):- var(G),!. +into_grid_or_var(O,G):- cast_to_grid(O,G,_Uncast),!. + +maybe_mapgrid(P2,I,O):- is_grid(I),!,mapgrid(P2,I,O). +maybe_mapgrid(P3,I,O,M):- is_grid(I),!,mapgrid(P3,I,O,M). +maybe_mapgrid(P4,I,O,M,N):- is_grid(I),!,mapgrid(P4,I,O,M,N). + +mapgrid(P4,Grid,GridM,GridN,GridO):- into_grid_or_var(Grid,G1),into_grid_or_var(GridM,G2),into_grid_or_var(GridN,G3),into_grid_or_var(GridO,G4),mapg_list(P4,G1,G2,G3,G4). +mapg_list(P4,Grid,GridM,GridN,GridO):- is_list(Grid),!,maplist(mapg_list(P4),Grid,GridM,GridN,GridO). +mapg_list(P4,Grid,GridM,GridN,GridO):- call(P4,Grid,GridM,GridN,GridO),!. + +mapgrid(P3,Grid,GridN,GridO):- into_grid_or_var(Grid,G1),into_grid_or_var(GridN,G2),into_grid_or_var(GridO,G3),mapg_list(P3,G1,G2,G3). +mapg_list(P3,Grid,GridN,GridO):- is_list(Grid),!,maplist(mapg_list(P3),Grid,GridN,GridO). +mapg_list(P3,Grid,GridN,GridO):- call(P3,Grid,GridN,GridO),!. + +mapgrid(P2, Grid,GridN):- into_grid_or_var(Grid,G1),into_grid_or_var(GridN,G2),!,mapg_list(P2, G1,G2). +mapg_list(P2, Grid,GridN):- is_list(Grid),!,maplist(mapg_list(P2),Grid,GridN). +mapg_list(P2, Grid,GridN):- p2_call(P2, Grid,GridN),!. + +mapgrid(P1,Grid):- into_grid_or_var(Grid,G1),mapg_list(P1,G1). +mapg_list(P1,Grid):- is_list(Grid),!,maplist(mapg_list(P1),Grid). +mapg_list(P1,Grid):- p1_call(P1,Grid),!. + + +maplist_ignore(_3,H,I,J):- (H==[];I==[],J==[]),!,(ignore(H=[]),ignore(I=[]),ignore(J=[])). +maplist_ignore(P3,H,I,J):- \+ is_list(H),!, ignore(p2_call(call(P3,H),I,J)). +maplist_ignore(P3,[H|Grid],[I|GridN],[J|GridO]):- maplist_ignore(P3,H,I,J), !,maplist_ignore(P3,Grid,GridN,GridO). + +maplist_ignore(_2,H,I):- (H==[];I==[]),!,(ignore(H=[]),ignore(I=[])). +maplist_ignore(P2, H,I):- \+ is_list(H),!, ignore(p2_call(P2, H,I)). +maplist_ignore(P2, [H|Grid],[I|GridN]):- maplist_ignore(P2, H,I), !,maplist_ignore(P2, Grid,GridN). + +%p1_or(P1,Q1,E):- must_be(callable,P1),!, (p1_call(P1,E);p1_call(Q1,E)). + +p1_call((P1;Q1),E):- must_be(callable,P1),!, (p1_call(P1,E);p1_call(Q1,E)). +p1_call((P1,Q1),E):- must_be(callable,P1),!, (p1_call(P1,E),p1_call(Q1,E)). +p1_call(or(P1,Q1),E):- must_be(callable,P1),!, (p1_call(P1,E);p1_call(Q1,E)). +p1_call(and(P1,Q1),E):- must_be(callable,P1),!, (p1_call(P1,E),p1_call(Q1,E)). +p1_call(not(not(P1)),E):- !, \+ \+ p1_call(P1,E). +p1_call(not(P1),E):- !, not(p1_call(P1,E)). +p1_call(once(P1),E):- !, once(p1_call(P1,E)). +p1_call(ignore(P1),E):- !, ignore(p1_call(P1,E)). +p1_call(chk(P1),E):- !, \+ \+ (p1_call(P1,E)). +p1_call( \+ (P1),E):- !, \+ p1_call(P1,E). +p1_call(P1,E):- !, call(P1,E). + +chk(X,E):- \+ \+ call(X,E). + +p2_call_p2(P2a,P2b,A,B):- p2_call(P2a,A,M),p2_call(P2b,M,B). + +p2_call(P2,A,B):- P2==[],!,A=B. +p2_call(p1_call(P1),E,O):- !, p1_call(P1,E), E=O. +p2_call([P2],Grid,GridN):- !, p2_call(P2, Grid,GridN). +p2_call([P2|P2L],Grid,GridN):- !, p2_call(P2, Grid,GridM),p2_call(P2L,GridM,GridN). +p2_call(ignore(P2),A,B):- p2_call(P2,A,B)*->true;A=B. +p2_call(type(Type,P2),A,B):- into_type(Type,A,AA),p2_call(P2,AA,B). +p2_call(or(P2,Q2),A,B):- nop(must_be(callable,P2)),!, (p2_call(P2,A,B);p2_call(Q2,A,B)). +p2_call(and(P2,Q2),A,B):- nop(must_be(callable,P2)),!, (p2_call(P2,A,AB),p2_call(Q2,AB,B)). +p2_call(P2,A,B):- must_be(callable,P2), call(P2,A,B). + + +p1_or(P1A,P1B,X):- p1_call(P1A,X)->true;p1_call(P1B,X). +p1_and(P1A,P1B,X):- p1_call(P1A,X),p1_call(P1B,X). +p1_not(P1,E):- \+ p1_call(P1,E). +p1_ignore(P1,E):- ignore(p1_call(P1,E)). +p1_arg(N,P1,E):- tc_arg(N,E,Arg),p1_call(P1,Arg). +p1_subterm(P1,E):- sub_term(Arg,E),p1_call(P1,Arg). + +:- meta_predicate my_partition(-, ?, ?, ?). +my_partition(_,[],[],[]):-!. +my_partition(P1,[H|L],[H|I],E):- \+ \+ p1_call(P1,H),!, + my_partition(P1,L,I,E). +my_partition(P1,[H|L],I,[H|E]):- + my_partition(P1,L,I,E),!. +my_partition(P1,H,I,HE):- arcST,ibreak, + my_partition(P1,[H],I,HE). + + +mapgroup(P2,G1,L2):- into_list(G1,L1),!, with_my_group(L1,maplist(P2,L1,L2)). +mapgroup(P1,G1):- into_list(G1,L1), !, with_my_group(L1,maplist(P1,L1)). + +selected_group(Grp):- nb_current('$outer_group',Grp),!. +selected_group([]). + +sub_cmpd(_, LF) :- \+ compound(LF), !, fail. +sub_cmpd(X, X). +sub_cmpd(X, Term) :- + ( is_list(Term) + -> member(E, Term), + sub_cmpd(X, E) + ; tc_arg(_, Term, Arg), + sub_cmpd(X, Arg) + ). + + + +%with_my_group([O|Grp],Goal):- compound(O),O=obj(_),!, locally(nb_setval('$outer_group',[O|Grp]),Goal). +with_my_group(_,Goal):- call(Goal). + +into_mlist(L,L). +my_maplist(P4,G1,L2,L3,L4):- into_mlist(G1,L1),!, with_my_group(L1,maplist(P4,L1,L2,L3,L4)). +my_maplist(P3,G1,L2,L3):- into_mlist(G1,L1),!, with_my_group(L1,maplist(P3,L1,L2,L3)). +my_maplist(P2,G1,L2):- into_mlist(G1,L1),!, with_my_group(L1,maplist(P2,L1,L2)). +my_maplist(P1,G1):- into_mlist(G1,L1), !, with_my_group(L1,maplist(P1,L1)). + + +my_include(P1,L,I):- include(p1_call(P1),L,I). +%my_include(P1,[H|L],O):- (p2_call(p1_call(P1),H,HH)*->(my_include(P1,L,I),O=[HH|I]);my_include(P1,L,O)). +my_include(_,_,[]). + +%my_exclude(P1,I,O):- my_include(not(P1),I,O). +my_exclude(P1,I,O):- my_partition(P1,I,_,O). + + +subst_1L([],Term,Term):-!. +subst_1L([X-Y|List], Term, NewTerm ) :- + subst0011(X, Y, Term, MTerm ), + subst_1L(List, MTerm, NewTerm ). + +subst_2L([],_,I,I). +subst_2L([F|FF],[R|RR],I,O):- subst0011(F,R,I,M),subst_2L(FF,RR,M,O). + + +subst001(I,F,R,O):- subst0011(F,R,I,O),!. + + +subst0011(X, Y, Term, NewTerm ) :- + copy_term((X,Y,Term),(CX,CY,Copy),Goals), + (Goals==[] + ->subst0011a( X, Y, Term, NewTerm ) + ;(subst0011a(CX, CY, Goals, NewGoals), + (NewGoals==Goals -> + subst0011a( X, Y, Term, NewTerm ) + ; (subst0011a(CX, CY, Copy, NewCopy), + NewTerm = NewCopy, maplist(call,NewGoals))))). + + + +subst0011a(X, Y, Term, NewTerm ) :- + ((X==Term)-> Y=NewTerm ; + (is_list(Term)-> maplist(subst0011a(X, Y), Term, NewTerm ); + (( \+ compound(Term); Term='$VAR'(_))->Term=NewTerm; + ((compound_name_arguments(Term, F, Args), + maplist(subst0011a(X, Y), Args, ArgsNew), + compound_name_arguments( NewTerm, F, ArgsNew )))))),!. + +subst001C(I,F,R,O):- subst001_p2(same_term,I,F,R,O),!. +subst0011C(F,R,I,O):- subst0011_p2(same_term,F,R,I,O),!. +subst_2LC(F,R,I,O):- subst_2L_p2(same_term,F,R,I,O). + +subst_2L_p2(_P2, [],_,I,I):-!. +subst_2L_p2(_P2, _,[],I,I):-!. +subst_2L_p2(P2, [F|FF],[R|RR],I,O):- subst0011_p2(P2, F,R,I,M),subst_2L_p2(P2, FF,RR,M,O). + +subst001_p2(P2, I,F,R,O):- subst0011_p2(P2, F,R,I,O),!. + +subst_1L_p2(_, [],Term,Term):-!. +subst_1L_p2(P2, [X-Y|List], Term, NewTerm ) :- + subst0011_p2(P2, X, Y, Term, MTerm ), + subst_1L_p2(P2, List, MTerm, NewTerm ). + +subst0011_p2(P2, X, Y, Term, NewTerm ) :- + copy_term((X,Y,Term),(CX,CY,Copy),Goals), + (Goals==[] + ->subst0011a_p2(P2, X, Y, Term, NewTerm ) + ;(subst0011a_p2(P2, CX, CY, Goals, NewGoals), + (NewGoals==Goals -> + subst0011a_p2(P2, X, Y, Term, NewTerm ) + ; (subst0011a_p2(P2, CX, CY, Copy, NewCopy), + NewTerm = NewCopy, maplist(call,NewGoals))))). + +subst0011a_p2(P2, X, Y, Term, NewTerm ) :- + (p2_call(P2,X,Term)-> Y=NewTerm ; + (is_list(Term)-> maplist(subst0011a_p2(P2, X, Y), Term, NewTerm ); + (( \+ compound(Term); Term='$VAR'(_))->Term=NewTerm; + ((compound_name_arguments(Term, F, Args), + maplist(subst0011a_p2(P2, X, Y), Args, ArgsNew), + compound_name_arguments( NewTerm, F, ArgsNew )))))),!. + + + +ppa(FF):- + copy_term(FF,FA,GF), + numbervars(FA+GF,0,_,[attvar(bind),singletons(true)]), + sort_safe(GF,GS),write(' '), + locally(b_setval(arc_can_portray,nil), + ppawt(FA)),format('~N'), + ignore((GS\==[], format('\t'),ppawt(attvars=GS),nl)),nl,!. + +ppawt(FA):- + write_term(FA,[numbervars(false), quoted(true), + character_escapes(true),cycles(true),dotlists(false),no_lists(false), + blobs(portray),attributes(dots), + portray(true), partial(false), fullstop(true), + %portray(false), partial(true), fullstop(true), + ignore_ops(false), quoted(true), quote_non_ascii(true), brace_terms(false)]). + +intersection(APoints,BPoints,Intersected,LeftOverA,LeftOverB):- + intersection_univ(APoints,BPoints,Intersected,LeftOverA,LeftOverB),!. + +same_univ(A,B):- (plain_var(A)->A==B;(B=@=A->true; (fail, \+ (A \=B )))). + +intersection_univ(APoints,BPoints,Intersected):- + intersection_univ(APoints,BPoints,Intersected,_,_),!. +intersection_univ(APoints,BPoints,Intersected,LeftOverA,LeftOverB):- + pred_intersection(same_univ,APoints,BPoints,Intersected,_,LeftOverA,LeftOverB). + +intersection_eq(APoints,BPoints,Intersected):- + intersection_eq(APoints,BPoints,Intersected,_,_),!. +intersection_eq(APoints,BPoints,Intersected,LeftOverA,LeftOverB):- + pred_intersection(same_univ,APoints,BPoints,Intersected,_,LeftOverA,LeftOverB). + +/* +intersection_u([],LeftOverB,[],[],LeftOverB):-!. +intersection_u(LeftOverA,[],[],LeftOverA,[]):-!. +intersection_u([A|APoints],BPoints,[A|Intersected],LeftOverA,LeftOverB):- + select(A,BPoints,BPointsMinusA),!, + intersection_u(APoints,BPointsMinusA,Intersected,LeftOverA,LeftOverB). +intersection_u([A|APoints],BPoints,Intersected,[A|LeftOverA],LeftOverB):- + intersection_u(APoints,BPoints,Intersected,LeftOverA,LeftOverB). +*/ + +:- meta_predicate(each_obj(?,?,0)). +each_obj([],_,_):-!. +each_obj([Obj|List],Obj,Goal):- ignore(Goal), each_obj(List,Obj,Goal). + +pred_intersection(_P2, [],LeftOverB, [],[], [],LeftOverB):-!. +pred_intersection(_P2, LeftOverA,[], [],[], LeftOverA,[]):-!. +pred_intersection(P2, [A|APoints],BPoints,[A|IntersectedA],[B|IntersectedB],LeftOverA,LeftOverB):- + select(B,BPoints,BPointsMinusA), + \+ \+ p2_call(P2, A,B),!, + pred_intersection(P2, APoints,BPointsMinusA,IntersectedA,IntersectedB,LeftOverA,LeftOverB). +pred_intersection(P2, [A|APoints],BPoints,IntersectedA,IntersectedB,[A|LeftOverA],LeftOverB):- + pred_intersection(P2, APoints,BPoints,IntersectedA,IntersectedB,LeftOverA,LeftOverB). + + + + + + + + + + + + + + + + + + + +pp(PP):-pp_m(PP). +pp(Color,PP):- ansi_format([fg(Color)],'~@',[pp(PP)]). + + +warn_skip(P):- pp(warn_skip(P)). + +with_set_stream(_,_,G):- call(G). + +fake_impl(M:F/A):- functor(P,F,A), asserta((M:P :- !, fail)). +fake_impl(F/A):- functor(P,F,A), asserta((P :- !, fail)). + + +:- fake_impl(arc_setval/3). +:- fake_impl(cast_to_grid/3). +:- fake_impl(dot_cfg:dictoo_decl/8). +:- fake_impl(get_param_sess/2). +:- fake_impl(into_list/2). +:- fake_impl(into_type/3). +:- fake_impl(is_grid/1). +:- fake_impl(is_hooked_obj/1). +:- fake_impl(is_vm_map/1). +:- fake_impl(ld_logicmoo_webui/0). +:- fake_impl(must_grid_call/3). +:- fake_impl(o_m_v/3). +:- fake_impl(quick_test/1). +:- fake_impl(url_decode_term/2). +:- fake_impl(xlisting_web:find_http_session/1). +:- fake_impl(xlisting_web:is_cgi_stream/0). + + +end_of_file. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +:- encoding(iso_latin_1). +/* + this is part of (H)MUARC https://logicmoo.org/xwiki/bin/view/Main/ARC/ + + This work may not be copied and used by anyone other than the author Douglas Miles + unless permission or license is granted (contact at business@logicmoo.org) +*/ + + +:- meta_predicate(print_grid(+,+,+,+)). +:- meta_predicate(print_grid(+,+,+)). + + +%:- autoload(library(http/html_write),[html/3,print_html/1]). + + +is_debugging(M):- \+ \+ debugging(M),!. +is_debugging(_):- is_testing,!. +%is_debugging(_):- menu_or_upper('B'). + +debug_m(_,Tiny):- display_length(Tiny,Len),Len<30,!,pp(Tiny). +debug_m(M,_):- \+ is_debugging(M),!. +%debug_m(_,List):- is_list(List),!,print_ss(List). +debug_m(_,Term):- pp(Term). +debug_c(M,_):- \+ is_debugging(M),!. +debug_c(_,C):- call(C),!. +debug_c(M,C):- wots_hs(S,C),debug_m(M,S),!. + +:- meta_predicate(wno(0)). +wno(G):- + locally(b_setval(print_collapsed,10), G). + +:- meta_predicate(print_collapsed(0)). +print_collapsed(Size,G):- + locally(b_setval(print_collapsed,Size), print_collapsed0(Size,G)). + +:- meta_predicate(print_collapsed0(0)). +print_collapsed0(Size,G):- Size<10, !, call(G). +% print_collapsed(Size,G):- call(G). +print_collapsed0(Size,G):- Size>=10, !, wots_hs(_S,G). +print_collapsed0(_,G):- wots_vs(S,G),write(S). + +tersify(I,O):- tracing,!,I=O. +%tersify(I,O):- term_variables(I,Vs), \+ ( member(V,Vs), attvar(V)),!,I=O. +tersify(I,O):- tersify23(I,O),!. +tersify(X,X):-!. + +tersify23(I,O):- quietly((tersify2(I,M),tersify3(M,O))),!. + +%srw_arc(I,O):- is_grid(I),!, wots_hs(O,(write('"'),print_grid(I),write('"'))). +%srw_arc(I,O):- compound(I),!, wots_hs(O,(write(ppt(I)))). +/* +srw_arc(I,O):- is_grid(I),!, wots_hs(O,(write('"'),print_grid(I),write('"'))). +*/ +srw_arc(I,O):- is_vm_map(I),!, O='..vvmm..'. +srw_arc(I,O):- is_grid(I),!, O='..grid..'. +/* +srw_arc(List,O):- current_prolog_flag(dmsg_len,Three), + is_list(List),length(List,L),L>Three, + append([A,B,C],[F|_],List),F \='...'(_), !, + simplify_goal_printed([A,B,C,'....'(L>Three)],O). +*/ +%srw_arc(gridFn(_),gridFn):-!. +%srw_arc(I,O):- is_points_list(I), length(I,N),N>10,!,O='..lo_points..'(N),!. +%srw_arc(I,O):- is_list(I), length(I,N),N>10,!,O='..lo_points..'(N),!. +srw_arc(I,O):- tersify(I,O),!,I\==O,!. + +:- multifile(dumpst_hook:simple_rewrite/2). +:- dynamic(dumpst_hook:simple_rewrite/2). + +dumpst_hook:simple_rewrite(I,O):- fail, notrace(catch(arc_simple_rewrite(I,O),_,fail)). + +arc_simple_rewrite(I,O):- + \+ current_prolog_flag(never_pp_hook, true), nb_current(arc_can_portray,t), + current_predicate(bfly_startup/0), + current_predicate(is_group/1), + b_setval(arc_can_portray,nil), + locally(b_setval(arc_can_portray,nil),once((compound(I), lock_doing(srw_arc,I,srw_arc(I,O))))), I\==O, I\=@=O, !, \+ I=O, + b_setval(arc_can_portray,t). + + +%:- set_prolog_flag(never_pp_hook, true). + + +portray_terse:- true,!. + +:- discontiguous arc_portray/2. + + +arc_portray(S,_):- term_is_ansi(S), !, write_keeping_ansi_mb(S). +arc_portray(_,_):- \+ \+ current_prolog_flag(never_pp_hook, true), nb_current(arc_can_portray,t), !, fail. +arc_portray(Map,TF):- get_map_pairs(Map,Type,Pairs),!, arc_portray_pairs(Type,TF,Pairs). + +arc_portray_t(G, _):- is_vm_map(G), !, write_map(G,'arc_portray_t'). +arc_portray_t(G, _):- is_grid(G), !, data_type(G,W),writeq(grid(W)). +arc_portray_t(G, _):- print(G),!. + +arc_portray(G, _):- is_vm_map(G), !, write_map(G,'arc_portray'). +arc_portray(G, TF):- TF == true, portray_terse, arc_portray_t(G, TF),!. +arc_portray(G, TF):- catch(arc_portray_nt(G, TF),E,(writeln(E),never_let_arc_portray_again,fail)),!. +%arc_portray(G, _TF):- writeq(G),!. + +% Portray In Debugger + +arc_portray_nt(G, false):- is_grid(G), print_grid(G),!. +%arc_portray_nt([G|L],_False):- is_object(G), !, pp([G|L]). +%arc_portray_nt(G0, true):- is_group(G0), ppt(G0),!. +%arc_portray_nt(G0, false):- is_group(G0), ppt(G0),!. +arc_portray_nt(G0, Tracing):- is_group(G0), into_list(G0,G), length(G,L),% L>1, !, + maplist(tersify,G0,GG), write(GG), + if_t(Tracing==false, + in_cmt(( + dash_chars, + once(((why_grouped(_TestID,Why,WG),WG=@=G,fail);(Why = (size2D=L)))),!, + print_grid(Why,G),nl_now, + + %underline_print(writeln(Why)), + %print_info_l(G), + dash_chars))). + + +arc_portray_nt(G,_False):- is_object(G), wots(S,writeg(G)), + global_grid(G,GG),!, + print_grid(GG), + write(S),!. % show_indiv(S,G). + %object_grid(G,OG), + %neighbor_map(OG,NG), !, + %print_grid(object_grid,NG),nl_now, + %underline_print(print_info(G)), + +arc_portray_nt(G,false):- via_print_grid(G),!, grid_size(G,H,V),!,H>0,V>0, print_grid(H,V,G). + +% Portray In tracer +arc_portray_nt(G,true):- is_object(G),underline_print((ppt(G))). +arc_portray_nt(G,true):- via_print_grid(G),write_nbsp,underline_print((ppt(G))),write_nbsp. +arc_portray_nt(G,true):- tersify(G,O),write_nbsp,writeq(O),write_nbsp. +arc_portray_nt(G0, _):- \+ is_gridoid(G0),!,print(G0). + + +arc_portray_pairs(Type,TF,Pairs):- + length(Pairs,N), + writeln(arc_portray_pairs(Type,TF,len(N))), + swap_kv(Pairs,VKPairs), + keysort(VKPairs,SVKPairs), + my_maplist(tc_arg(2),SVKPairs,SVKPairs2), + arc_portray_type_pairs(TF,SVKPairs2). + +arc_portray_type_pairs(TF,Pairs):- append(Left,[K1-V1,K2-V2|Right],Pairs),is_grid(V1),is_grid(V2),!, + append(Left,[call-print_side_by_side(yellow,V1,K1,_,V2,K2)|Right],PairsM), + arc_portray_type_pairs(TF,PairsM). +arc_portray_type_pairs(TF,Pairs):- + forall(member(K-V,Pairs),arc_portray_pair(Pairs,K,V,TF)). + +swap_kv([_-V|Pairs],VKPairs):- plain_var(V),!, swap_kv(Pairs,VKPairs). +swap_kv([K-V|Pairs],['-'(Type,K-V)|VKPairs]):- + data_type(V,Type), + swap_kv(Pairs,VKPairs). +swap_kv([],[]). + + +arc_portray_pair(Ps,K,Val,TF):- + nl_if_needed, + arc_portray_1_pair(Ps,K,Val,TF), + nl_if_needed_ansi. + +arc_portray_1_pair(_Ps,call,Val,_TF):- !, call(Val). +arc_portray_1_pair(Ps,K,Val,TF):- + (via_print_grid(Val) -> print_grid(K,Val) + ; (print(K),write('= '),once(arc_portray(Val,TF);print(Val)))), + ignore(arc_portray_pair_optional(Ps,K,Val,TF)),!. + +arc_portray_pair_optional(Ps,K,Val,TF):- + once(( Val\==[], is_list(Val),my_maplist(is_object,Val), + print_info(Val), + Val \= [_], + compare_objects(Val,Diffs), + color_print(cyan,call(arc_portray_pair(Ps,diffs(K),Diffs,TF))))). + + +% arc_portray(G):- \+ \+ catch((wots_hs(S,( tracing->arc_portray(G,true);arc_portray(G,false))),write(S),ttyflush),_,fail). +arc_portray(G):- \+ compound(G),fail. +arc_portray(G):- is_vm(G), !, write('..VM..'). +arc_portray(G):- \+ nb_current(arc_portray,t),\+ nb_current(arc_portray,f),is_print_collapsed,!, + locally(nb_setval(arc_portray,t),arc_portray1(G)). +arc_portray(G):- \+ nb_current(arc_portray,f),!, locally(nb_setval(arc_portray,t),arc_portray1(G)). +arc_portray(G):- locally(nb_setval(arc_portray,f),arc_portray1(G)). + +arc_portray1(G):- + flag(arc_portray_current_depth,X,X), X < 3, + \+ \+ + setup_call_cleanup(flag(arc_portray_current_depth,X,X+1),catch(((tracing->arc_portray(G,true); + arc_portray(G,false)),ttyflush),E,(fail,format(user_error,"~N~q~n",[E]),fail)),flag(arc_portray_current_depth,_,X)). + + +%via_print_grid(G):- tracing,!,fail. +via_print_grid(G):- is_points_list(G). %,!,fail,grid_size(G,H,V),number(H),number(V),H>1,V>1. +via_print_grid(G):- is_grid(G). +via_print_grid(G):- is_obj_props(G),!,fail. +via_print_grid(G):- is_object(G). +via_print_grid(G):- is_group(G). +via_print_grid(G):- is_gridoid(G). + + + +terseA(_,[],[]):- !. +terseA(_,L,'... attrs ...'(N)):- is_list(L),length(L,N),N>10,!. +terseA(I,[A|L],[B|LL]):-terseA(I,A,B),terseA(I,L,LL),!. +terseA(I,dif(A,B),B):-A==I,!. +terseA(I,dif(B,A),B):-A==I,!. +terseA(_,put_attr(_,B,A),A):- B==ci,!. +terseA(_,put_attr(_,B,A),B=A):-!. +terseA(_,A,A):-!. + + +simple_enough(I):- plain_var(I). +simple_enough(I):- atomic(I). +simple_enough(I):- \+ compound(I),!. +simple_enough(_*_):-!. +simple_enough(_+_):-!. +simple_enough(A):- functor(A,_,1),tc_arg(1,A,E),!,simple_enough(E). +%simple_enough(I):- number(I). +%simple_enough(I):- atom(I). + +tersify0(I,O):- simple_enough(I),!,I=O. +tersify0(I,av(C,Others)):- attvar(I),copy_term(I,C,Attrs),terseA(C,Attrs,Others),!. +tersify0(I,I):- var(I),!. + + +%tersifyC(D):- is_vm_map(D),!. +tersifyC(av(_,_)). +tersifyC(objFn(_,_)). +tersifyC(groupFn(_,_)). +tersifyC(objFn(_)). +tersifyC(groupFn(_)). + +tersify1(I,O):- simple_enough(I),!,I=O. +tersify1(av(_,Blue), -(Blue)):-!. +tersify1(I,O):- compound(I), tersifyC(I),!,I=O. +tersify1(gridFn(I),gridFn(I)):-!. % tersifyG(I,O). +%tersify1(gridFn(I),gridFn(O)):-tersifyG(I,O). +tersify1(Nil,[]):- Nil == [],!. +tersify1(I,gridFn(S)):- is_grid(I), into_gridnameA(I,O),!,sformat(S,'~w',[O]). +tersify1(I,gridFn(O)):- is_grid(I),tersifyG(I,O),!. +tersify1(I,groupFn(O,List)):- is_group(I), mapgroup(tersify1,I,List),mapgroup(obj_to_oid,I,OIDs),length(List,N), !,ignore((get_current_test(TestID),is_why_grouped(TestID,N,Why,OIDs),!,O=Why)). + +tersify1(I,Q):- is_object(I),object_ref_desc(I,Q),!. +tersify1(I,O):- is_vm_map(I), get_kov(objs,I,_),!, O='$VAR'('VM'). +tersify1(I,O):- is_vm_map(I), get_kov(pairs,I,_),!, O='$VAR'('Training'). + + +tersifyG(I,O):- tersifyL(I,O),numbervars(O,1,_,[attvar(bind),singletons(false)]),!. + +%tersifyL(I,I):- is_ftVar(I),!. +%tersifyL(I,I):- \+ compound(I),!. +tersifyL(I,O):- \+ is_cons(I),!,O=I. +tersifyL([H|I],[HH|I]):- \+ is_list(I),!,tersify(H,HH). +tersifyL([H|I],O):- nonvar(H), \+ is_group(I), display_length(I,N) , N>170, + length(I,LL),tersify(H,HH),(('...'(HH,LL,'...'(N)))=O),!. +tersifyL(I,O):- tersify0(I,O),!. +tersifyL([H|TT],[HH|TT]):- tersify(H,HH),!,tersifyL(TT,TT),!. +tersifyL(I,O):- tersify1(I,O),!. +tersifyL(I,I). + +tersify2(I,O):- compound(I),(I=(N=V)),tersify2(N,NN),tersify2(V,VV),!,O=(NN=VV). +tersify2(I,O):- simple_enough(I),!,I=O. +tersify2(I,O):- compound(I),tersify1(I,O),!. +tersify2(I,O):- tersify0(I,O),!. +tersify2(I,O):- is_list(I), !, my_maplist(tersify2,I,O). +tersify2(I,O):- compound(I), !, compound_name_arguments(I,F,IA), my_maplist(tersify,IA,OA), compound_name_arguments(O,F,OA). +tersify2(I,I). + +tersify3(I,O):- compound(I),(I=(N=V)),tersify3(N,NN),tersify3(V,VV),!,O=(NN=VV). +tersify3(I,O):- simple_enough(I),!,I=O. +tersify3(I,O):- compound(I),tersify1(I,O),!. +tersify3(I,O):- tersify0(I,O),!. +tersify3([H|I],O):- is_list(I), ((display_length(I,N), N>170) -> + (length(I,LL),tersify(H,HH),(('...'(HH,LL,'...'(N)))=O)); I=O),!. +tersify3(I,O):- is_list(I), !, my_maplist(tersify3,I,O). +tersify3(I,O):- compound(I), !, compound_name_arguments(I,F,IA), my_maplist(tersify,IA,OA), compound_name_arguments(O,F,OA). +tersify3(I,I). + +write_map(G,Where):- is_vm(G), !, write('...VM_'),write(Where),write('...'). +write_map(G,Where):- is_vm_map(G), !, write('...Map_'),write(Where),write('...'). +write_map(G,Where):- is_dict(G), !, write('...Dict_'),write(Where),write('...'). +write_map(_G,Where):- write('...'),write(Where),write('...'). + + + +non_empty_wqs_c(V):- \+ empty_wqs_c(V). +empty_wqs_c(V):- var(V),!,fail. +empty_wqs_c(A):- atom(A),atom_string(A,S),!,empty_wqs_c(S). +empty_wqs_c([]). +empty_wqs_c(""). +empty_wqs_c(" "). +empty_wqs_c(" "). +empty_wqs_c("\n"). + +is_writer_goal(H):- \+ callable(H),!,fail. +is_writer_goal(H):- is_list(H),!,fail. +is_writer_goal(A):- atom(A),!,is_writer_goal_f(A). +is_writer_goal(H):- \+ compound(H),!,fail. +%is_writer_goal((C1,C2)):- !, (is_writer_goal(C1);is_writer_goal(C2)). +is_writer_goal(C):- compound_name_arity(C,F,_),once(is_writer_goal_f(F);(tc_arg(_,C,E),is_writer_goal(E))). + + +is_writer_goal_f(wqs_c). +is_writer_goal_f(F):- is_writer_goal_l(F),!. +is_writer_goal_f(F):- \+ atom(F),!, term_to_atom(F,A),is_writer_goal_f(A). +is_writer_goal_f(F):- not_writer_goal_r(R),atom_concat(_,R,F),!,fail. +is_writer_goal_f(F):- is_writer_goal_l(L),atom_concat(L,_,F),!. +is_writer_goal_f(F):- is_writer_goal_l(R),atom_concat(_,R,F),!. +not_writer_goal_r(test). is_writer_goal_l(msg). is_writer_goal_l(call). +is_writer_goal_l(nl). is_writer_goal_l(format). is_writer_goal_l(with_). +is_writer_goal_l(locally). + +is_writer_goal_l(html). is_writer_goal_l(ptcol). is_writer_goal_l(wots). +is_writer_goal_l(print). is_writer_goal_l(flush_output). is_writer_goal_l(wqs). +is_writer_goal_l(pp). is_writer_goal_l(write). is_writer_goal_l(dash_). + + +maybe_color(SS,_):- term_contains_ansi(SS),!, write_nbsp, write(SS). +maybe_color(SS,P):- term_contains_ansi(P),!, write_nbsp, write(SS). +maybe_color(SS,P):- pp_msg_color(P,C), ansicall(C,is_maybe_bold(P,write(SS))),!. + +write_atom(S):- \+ atom(S),!,wqs(S). +write_atom(S):- atom_contains(S,'~'),!,notrace(catch(format(S,[]),_,maybe_write_atom_link(S))). +write_atom(S):- maybe_write_atom_link(S),!. +write_atom(S):- into_title_str(S,TS),write(TS),!. + +:- meta_predicate(into_title_str(+,-)). +into_title_str(Term,Str):- string(Term),!,Str=Term. +into_title_str(Term,Str):- plain_var(Term),sformat(Str,'~p',[Term]),!. +into_title_str(Term,Str):- var(Term),tersify0(Term,Terse), sformat(Str,'~p',[Terse]),!. +into_title_str(Term,Str):- term_is_ansi(Term), wots(Str,write_keeping_ansi_mb(Term)),!. +into_title_str(Term,Str):- (is_codelist(Term);is_charlist(Term)),catch(sformat(Str,'~s',[Term]),_,sformat(Str,'~p',[Term])),!. +into_title_str(Term,Str):- is_list(Term),my_maplist(into_title_str,Term,O3),atomics_to_string(O3," ",Str),!. +into_title_str([H|T],Str):- into_title_str(H,A),into_title_str(T,B),atomics_to_string([A,B]," ",Str),!. +into_title_str(Term,Str):- \+ callable(Term),sformat(Str,'~p',[Term]),!. +into_title_str(format(Fmt,Args),Str):- sformat(Str,Fmt,Args),!. +into_title_str(Term,""):- empty_wqs_c(Term),!. +into_title_str(out,"Output"). +into_title_str(in,"Input"). +into_title_str(i,"IN"). +into_title_str(o,"OUT"). +into_title_str(Term,Str):- atom(Term),is_valid_linkid(Term,Kind,_),Term\=@=Kind,into_title_str(Kind,KS),sformat(Str,'~w (~w)',[Term,KS]),!. +into_title_str(Term,Str):- atom(Term), atom_contains(Term,'_'), \+ atom_contains(Term,' '), to_case_breaks(Term,T), + include(\=(xti(_,punct)),T,O),my_maplist(tc_arg(1),O,O1),my_maplist(toProperCamelAtom,O1,O2), + atomics_to_string(O2," ",Str),!. +into_title_str(Term,Str):- has_short_id(Term,Kind,ID),Term\=@=Kind,into_title_str(Kind,KS),sformat(Str,'~w (~w)',[ID,KS]),!. + +into_title_str(T-U,Str):- into_title_str([some(T),"..to..",some(U)],Str). +into_title_str(T*U,Str):- into_title_str([some(T),"(",some(U),")"],Str). +into_title_str(T+U,Str):- into_title_str(T,S1), number(U), N is U+1, sformat(Str,'~w #~w',[S1,N]). +into_title_str(T+U,Str):- var(U), into_title_str(T,S1), sformat(Str,'~w(s)',[S1]). +into_title_str(title(Term),Str):- !, into_title_str(Term,Str),!. +into_title_str(some(Var),"Some"):- var(Var),!. +into_title_str(some(Var),Str):- !, into_title_str(Var,Str). +into_title_str(User:Term,Str):- User == user, !, into_title_str(Term,Str). +into_title_str(trn,"Training Pair"). +into_title_str(tst,"EVALUATION TEST"). +%into_title_str(Term,Str):- tersify23(Term,Terse),Term\=@=Terse,!,into_title_str(Terse,Str). +into_title_str(Term,Str):- callable_arity(Term,0),is_writer_goal(Term),catch(notrace(wots(Str,call_e_dmsg(Term))),_,fail),!. +into_title_str(Term,Str):- catch(sformat(Str,'~p',[Term]),_,term_string(Term,Str)),nonvar(Str),atom_length(Str,E50),E50<180,!. +into_title_str(Term,Str):- compound(Term), compound_name_arguments(Term,Name,Args), + %include(not_p1(plain_var),Args,Nonvars), + Args=Nonvars, + my_maplist(tersify,Nonvars,ArgsT), into_title_str([Name,"(",ArgsT,")"],Str),!. +into_title_str(Term,Str):- catch(sformat(Str,'~p',[Term]),_,term_string(Term,Str)). + +has_short_id(TestID,testid,UUID):- is_valid_testname(TestID),test_id_atom(TestID,UUID). +has_short_id(Obj,object,OID):- is_object(Obj),obj_to_oid(Obj,OID). +has_short_id(Grid,grid,GID):- is_grid(Grid),grid_to_gid(Grid,GID). + + +is_valid_linkid(ID,testid,TestID):- atom_id(ID,TestID),is_valid_testname(TestID),!. +is_valid_linkid(ID,object,Obj):- known_object(ID,Obj),!. +is_valid_linkid(ID,grid,Grid):- known_grid(ID,Grid),!. +% individuate_3(complete, two(v_1d398264_trn_0_in, v_1d398264_trn_0_out)) +is_valid_linkid(ID,group,Grp):- get_current_test(TestID),is_why_grouped_g(TestID,_Count,ID,Grp). + + +wqs_c(S):- term_is_ansi(S), !, write_keeping_ansi_mb(S). +wqs_c(S):- (string(S);is_codelist(S);is_charlist(S)),catch(format('~s',[S]),_,writeq(S)). +wqs_c(S):- empty_wqs_c(S),!. +wqs_c(S):- var(S),!,write(var(S)). +wqs_c(S):- atom(S),into_title_str(S,TS),write(TS),!. +wqs_c(S):- atom(S),write_atom(S),!. +%wqs_c(S):- atom(S),write(S),!. +wqs_c(S):- \+compound(S),!,notrace(catch(format('~p',[S]),_,write(S))). +wqs_c(title(S)):- !, wqs_c(S). +wqs_c(H+T):- !, wqs_c(H),write_nbsp,wqs_c(T). +wqs_c(S):- is_grid(S), print_grid(S),!. +wqs_c(S):- is_vm(S), pp(S) ,!. +wqs_c(L):- is_list(L), include(non_empty_wqs_c,L,LL),!,wqs_c_l(LL). +wqs_c([H|T]):- pp([H|T]),!. +wqs_c(H):- callable_arity(H,0),is_writer_goal(H),catch(call_e_dmsg(H),_,fail),!. +%wqs_c(H):- callable_arity(H,0),call(H),!. +wqs_c(H):- locally(t_l:wqs_fb(pp_no_nl),wqs(H)),!. + +wqs_c_l([]):-!. +wqs_c_l([H]):- wqs_c(H),!. +wqs_c_l([H|T]):- wqs_c(H),write_nbsp,wqs_c_l(T),!. + + + + + +ppt(_):- is_print_collapsed,!. +ppt(G):- stack_check_or_call(4000,writeq(G)),!. +ppt(G):- is_vm_map(G), !, write_map(G,'ppt'). +ppt(S):- term_is_ansi(S), !, write_keeping_ansi_mb(S). +%ppt(P):- compound(P),wqs1(P),!. + +ppt(P):- \+ ansi_main, wants_html,!,ptcol_html(P),write_br. +ppt(P):- \+ \+ ((tersify(P,Q),!,pp(Q))),!. +ppt(Color,P):- \+ ansi_main, wants_html,!,with_color_span(Color,ptcol_html(P)),write_br. +ppt(Color,P):- \+ \+ ((tersify(P,Q),!,pp(Color,Q))),!. + + +write_br:- ansi_main,!,nl. +write_br:- write('
'). + +ptc(Color,Call):- pp(Color,call(Call)). + +:- meta_predicate(ppnl(+)). +ppnl(Term):- is_list(Term),!,g_out(wqs(Term)). +ppnl(Term):- nl_if_needed,format('~q',[Term]),nl_if_needed_ansi. + +:- meta_predicate(pp(+)). +pp(Color,P):- \+ ansi_main, wants_html,!,with_color_span(Color,pp(P)),write_br. +pp(Color,P):- ignore((quietlyd((wots_hs(S,pp(P)),!,color_print(Color,S))))). + +pp(_):- is_print_collapsed,!. +%pp(Term):- is_toplevel_printing(Term), !, nl_if_needed, pp_no_nl(Term),!,nl_if_needed_ansi. +pp(_Term):- nl_if_needed, fail. +pp(Term):- \+ ansi_main, wants_html,!, wots_vs(SS,ptcol_html_scrollable(Term)),write(SS),write_br. +pp(Term):- \+ nb_current(arc_can_portray,_),!,locally(nb_setval(arc_can_portray,t),print(Term)). +pp(Term):- az_ansi(pp_no_nl(Term)),!,nl_if_needed_ansi. + +/* +ptcol(P):- wants_html,!,ptcol_html(P). +ptcol(call(P)):- callable(P),!,call(P). +ptcol(P):- pp(P). +*/ + +%ptcol_html(P):- ptcol_html_0(P). +ptcol_html(P):- ptcol_html_scrollable_0(P). +ptcol_html_scrollable(P):- with_tag_ats(div,scrollable,ptcol_html_scrollable_0(P)). + + +ptcol_html_0(P):- with_tag(pre,ptcol_html_wo_pre(P)). +ptcol_html_wo_pre(call(P)):- callable(P),!, in_pp_html(call(P)). +ptcol_html_wo_pre(P):- in_pp_html(print_tree_no_nl(P)). +ptcol_html_scrollable_0(P):- ptcol_html_wo_pre(P). + + +pp_wcg(G):- wants_html,!,ptcol_html_scrollable(G). +pp_wcg(G):- pp_safe(call((locally(nb_setval(arc_can_portray,t),print(G))))),!. + +wqln(Term):- ppnl(Term). +wqnl(G):- pp_safe(call((locally(nb_setval(arc_can_portray,nil),print(G))))),!. + +pp_safe(_):- nb_current(pp_hide,t),!. +pp_safe(call(W)):- !, nl_if_needed,nl_now,call(W),nl_now. +pp_safe(W):- nl_if_needed,nl_now,writeq(W),nl_now. +pp_safe(C,W):- color_print(C,call(pp_safe(W))). + + +%p_p_t_no_nl(Term):- is_toplevel_printing(Term), !, print_tree_no_nl(Term). + +p_p_t_no_nl(P):- \+ ansi_main, wants_html,!,ptcol_html(P). +p_p_t_no_nl(Term):- az_ansi(print_tree_no_nl(Term)). + +ppt_no_nl(P):- \+ ansi_main, wants_html,!,ptcol_html(P). +ppt_no_nl(P):- tersify(P,Q),!,pp_no_nl(Q). + +is_toplevel_printing(_):- \+ is_string_output, line_position(current_output,N), N<2, fail. + +pp_no_nl(P):- var(P),!,pp(var_pt(P)),nop((dumpST,ibreak)). +pp_no_nl(S):- term_is_ansi(S), !, write_keeping_ansi_mb(S). +pp_no_nl(P):- atom(P),atom_contains(P,'~'),!,format(P). +pp_no_nl(G):- is_vm_map(G), !, write_map(G,'pp'). +%pp_no_nl(S):- term_is_ansi(S), !, write_keeping_ansi_mb(S). +pp_no_nl(P):- \+ \+ (( pt_guess_pretty(P,GP),ptw(GP))). +%pp(P):-!,writeq(P). +%ptw(P):- quietlyd(p_p_t_nl(P)),!. +%ptw(_):- nl_if_needed,fail. +ptw(P):- var(P),!,ptw(var_ptw(P)),nop((dumpST,ibreak)). +ptw(G):- is_vm_map(G), !, write_map(G,'ptw'). +ptw(S):- term_is_ansi(S), !, write_keeping_ansi_mb(S). +ptw(P):- p_p_t_no_nl(P),!. + +%ptw(P):- quietlyd(write_term(P,[blobs(portray),quoted(true),quote_non_ascii(false), portray_goal(print_ansi_tree),portray(true)])),!. +print_ansi_tree(S,_):- term_is_ansi(S), !, write_keeping_ansi_mb(S). +print_ansi_tree(P,_):- catch(arc_portray(P),_,(never_let_arc_portray_again,fail)),!. +print_ansi_tree(P,_OL):- catch(p_p_t_no_nl(P),_,(never_let_arc_portray_again,fail)),!. + +%p_p_t_nl(T):- az_ansi(print_tree_nl(T)). +%p_p_t(T):- az_ansi(print_tree(T)). + +pt_guess_pretty(P,O):- \+ nb_current(in_pt_guess_pretty,t), locally(nb_setval(in_pt_guess_pretty,t),pt_guess_pretty_1(P,O)). +pt_guess_pretty(O,O). + +upcase_atom_var_l(IntL,NameL):- upcase_atom_var(IntL,NameL). +upcase_atom_var_l(IntL,NameL):- is_list(IntL),!,my_maplist(upcase_atom_var_l,IntL,NameL). + +pt_guess_pretty_1(P,O):- copy_term(P,O,_), + ignore((sub_term(Body,O), compound(Body), Body=was_once(InSet,InVars),upcase_atom_var_l(InSet,InVars))), + ignore(pretty1(O)),ignore(pretty_two(O)),ignore(pretty_three(O)),ignore(pretty_final(O)),!, + ((term_singletons(O,SS),numbervars(SS,999999999999,_,[attvar(skip),singletons(true)]))). + +:- dynamic(pretty_clauses:pp_hook/3). +:- multifile(pretty_clauses:pp_hook/3). +:- module_transparent(pretty_clauses:pp_hook/3). +pretty_clauses:pp_hook(FS,Tab,S):- \+ current_prolog_flag(never_pp_hook, true), nb_current(arc_can_portray,t), notrace(catch(arc_pp_hook(FS,Tab,S),_,fail)). + +arc_pp_hook(_,Tab,S):- term_is_ansi(S), !,prefix_spaces(Tab), write_keeping_ansi_mb(S). +%arc_pp_hook(_,Tab,S):- is_vm(S),!,prefix_spaces(Tab),!,write('..VM..'). +%arc_pp_hook(_, _,_):- \+ \+ current_prolog_flag(never_pp_hook, true), nb_current(arc_can_portray,t),!,fail. +arc_pp_hook(FS,_ ,G):- \+ current_prolog_flag(never_pp_hook, true), nb_current(arc_can_portray,t), + current_predicate(is_group/1), + locally(b_setval(pp_parent,FS), + print_with_pad(pp_hook_g(G))),!. + +pp_parent(PP):- nb_current(pp_parent,PP),!. +pp_parent([]):-!. + +%:- meta_predicate(lock_doing(+,+,0)). +:- meta_predicate(lock_doing(+,+,:)). +lock_doing(Lock,G,Goal):- + (nb_current(Lock,Was);Was=[]), !, + \+ ((member(E,Was),E==G)), + locally(nb_setval(Lock,[G|Was]),Goal). + +never_let_arc_portray_again:- set_prolog_flag(never_pp_hook, true),!. +arc_can_portray:- \+ current_prolog_flag(never_pp_hook, true), nb_current(arc_can_portray,t). + +arcp:will_arc_portray:- + \+ current_prolog_flag(never_pp_hook, true), + \+ nb_current(arc_can_portray,f), + %nb_current(arc_can_portray,t), + current_prolog_flag(debug,false), + \+ tracing, + flag(arc_portray_current_depth,X,X),X<3, + current_predicate(bfly_startup/0). + +user:portray(Grid):- + arcp:will_arc_portray, \+ \+ catch(quietly(arc_portray(Grid)),_,fail),!, flush_output. + + +pp_hook_g(S):- term_is_ansi(S), !, write_keeping_ansi_mb(S). +pp_hook_g(_):- \+ \+ current_prolog_flag(never_pp_hook, true), nb_current(arc_can_portray,t),!,fail. +pp_hook_g(S):- term_contains_ansi(S), !, write_nbsp, pp_hook_g0(S). +pp_hook_g(G):- \+ plain_var(G), lock_doing(in_pp_hook_g,G,pp_hook_g0(G)). + +pp_hook_g0(S):- term_is_ansi(S), !, write_nbsp, write_keeping_ansi_mb(S). +pp_hook_g0(_):- \+ \+ current_prolog_flag(never_pp_hook, true), nb_current(arc_can_portray,t),!,fail. +pp_hook_g0(_):- in_pp(bfly),!,fail. +pp_hook_g0(G):- wots_hs(S,in_bfly(f,pp_hook_g10(G))),write(S). + +mass_gt1(O1):- into_obj(O1,O2),mass(O2,M),!,M>1. + +% Pretty printing +pp_hook_g10(G):- \+ plain_var(G), current_predicate(pp_hook_g1/1), lock_doing(in_pp_hook_g10,G,pp_hook_g1(G)). + +%as_grid_string(O,SSS):- is_grid(O),wots_vs(S,print_grid(O)), sformat(SSS,'{ ~w}',[S]). +as_grid_string(O,SSS):- wots_vs(S,show_indiv(O)), sformat(SSS,'{ ~w}',[S]). +as_pre_string(O,SS):- wots_hs(S,show_indiv(O)), strip_vspace(S,SS). + + +pretty_grid(O):- + catch( + (wots_hs(S,print_grid(O)),strip_vspace(S,SS), + ptc(orange,(format('" ~w "',[SS])))), + _,fail),!. +/* +pretty_grid(O):- + catch( + (wots_hs(S,print_grid(O)),strip_vspace(S,SS), + ptc(orange,(format('" ~w "',[SS])))), + _,(never_let_arc_portray_again,fail)). +*/ +pp_hook_g1(O):- plain_var(O), !, fail. + +pp_hook_g1(O):- attvar(O), !, is_colorish(O), data_type(O,DT), writeq('...'(DT)),!. +pp_hook_g1(S):- term_is_ansi(S), !, write_nbsp, write_keeping_ansi_mb(S). +%pp_hook_g1(S):- term_contains_ansi(S), !, fail, write_nbsp, write_keeping_ansi_mb(S). +pp_hook_g1(rhs(O)):- write_nbsp,nl,bold_print(print(r_h_s(O))),!. + +pp_hook_g1(iz(O)):- compound(O), O = info(_),underline_print(print(izz(O))),!. +pp_hook_g1(O):- is_grid(O), /* \+ (sub_term(E,O),compound(E),E='$VAR'(_)), */ pretty_grid(O). + + +pp_hook_g1(O):- is_object(O), into_solid_grid(O,G), wots(SS,pretty_grid(G)),write(og(SS)),!. + +pp_hook_g1(shape_rep(grav,O)):- is_points_list(O), as_grid_string(O,S), wotsq(O,Q), print(shape_rep(grav,S,Q)),!. +pp_hook_g1(vals(O)):- !, writeq(vals(O)),!. +%pp_hook_g1(l2r(O)):- into_solid_grid_strings(l2r(O),Str),Str\=@=l2r(O),print_term_no_nl(Str),!. +pp_hook_g1(localpoints(O)):- is_points_list(O), as_grid_string(O,S), wotsq(O,Q), print(localpoints(S,Q)),!. +pp_hook_g1(C):- compound(C), compound_name_arguments(C,F,[O]),is_points_list(O), length(O,N),N>2, as_grid_string(O,S), compound_name_arguments(CO,F,[S]), print(CO),!. + +pp_hook_g1(O):- is_points_list(O),as_grid_string(O,S),write(S),!. +pp_hook_g1(O):- is_real_color(O), color_print(O,call(writeq(O))),!. +pp_hook_g1(O):- is_colorish(O), data_type(O,DT), writeq('...'(DT)),!. + +pp_hook_g1(_):- \+ in_pp(ansi),!, fail. + + +pp_hook_g1(Grp):- current_predicate(pp_ilp/1),is_rule_mapping(Grp),pp_ilp(Grp),!. + +pp_hook_g1(O):- atom(O), atom_contains(O,'o_'), pp_parent([LF|_]), \+ (LF==lf;LF==objFn), + resolve_reference(O,Var), O\==Var, \+ plain_var(Var),!, + write_nbsp, writeq(O), write(' /* '), show_indiv(Var), write(' */ '). + +pp_hook_g1(O):- is_object(O),pp_no_nl(O), !. +pp_hook_g1(O):- is_group(O),pp_no_nl(O), !. + +%pp_hook_g1(change_obj(N,O1,O2,Sames,Diffs)):- showdiff_objects5(N,O1,O2,Sames,Diffs),!. + +pp_hook_g1(O):- is_vm_map(O),data_type(O,DT), writeq('..map.'(DT)),!. +pp_hook_g1(O):- is_gridoid(O),show_indiv(O), !. +%pp_hook_g1(O):- O = change_obj( O1, O2, _Same, _Diff), with_tagged('h5',w_section(object,[O1, O2],pp(O))). +%pp_hook_g1(O):- O = change_obj( O1, O2, _Same, _Diff), w_section(showdiff_objects(O1,O2)),!. +%pp_hook_g1(O):- O = change_obj( O1, O2, _Same, _Diff), w_section(object,[O1, O2],with_tagged('h5',pp(O))). +%pp_hook_g1(O):- O = diff(A -> B), (is_gridoid(A);is_gridoid(B)),!, p_c_o('diff', [A, '-->', B]),!. +pp_hook_g1(O):- O = showdiff( O1, O2), !, showdiff(O1, O2). +%pp_hook_g1(O):- compound(O),wqs1(O), !. +pp_hook_g1(O):- \+ compound(O),fail. +pp_hook_g1(G):- '@'(pp_hook_g1a(G),user). + +pp_hook_g1a(G):- \+ current_prolog_flag(debug,true), + current_predicate(pp_hook_g2/1), lock_doing(in_pp_hook_g3,any,pp_hook_g2(G)),!. +pp_hook_g1a(G):- fch(G),!. + +%pp_hook_g2(O):- current_predicate(colorize_oterms/2),colorize_oterms(O,C), notrace(catch(fch(C),_,fail)),! . + +fch(O):- wqs1(O). +%fch(O):- pp_no_nl(O). +%fch(O):- print(O). +%fch(O):- p_p_t_no_nl(O). + +wotsq(O,Q):- wots_hs(Q,wqnl(O)). +has_goals(G):- term_attvars(G,AV),AV\==[]. +has_goals(G):- term_variables(G,TV),term_singletons(G,SV),TV\==SV. + +maybe_term_goals(Term,TermC,Goals):- + term_attvars(Term,Attvars), Attvars\==[],!, + term_variables(Term,Vars), + include(not_in(Attvars),Vars,PlainVars), + copy_term((Attvars+PlainVars+Term),(AttvarsC+PlainVarsC+TermC),Goals), + numbervars(PlainVarsC,10,Ten1,[singletons(true),attvar(skip)]), + numbervars(AttvarsC+Goals,Ten1,_Ten,[attvar(bind),singletons(false)]). + +maybe_replace_vars([],SGoals,TermC,SGoals,TermC):-!. +maybe_replace_vars([V|VarsC],SGoals,TermC,RSGoals,RTermC):- + my_partition(sub_var(V),SGoals,Withvar,WithoutVar), + Withvar=[OneGoal], + freeze(OneGoal,(OneGoal\==null,OneGoal \== @(null))), + findall(_,sub_var(V,TermC),LL),LL=[_],!, + subst([WithoutVar,TermC],V,{OneGoal},[SGoalsM,TermCM]), + maybe_replace_vars(VarsC,SGoalsM,TermCM,RSGoals,RTermC). +maybe_replace_vars([_|VarsC],SGoals,TermC,RSGoals,RTermC):- + maybe_replace_vars(VarsC,SGoals,TermC,RSGoals,RTermC). + + +src_sameish(Orig,Find):- copy_term(Orig,COrig),Find=Orig,Orig=@=COrig. + +number_vars_calc_goals(Term,SSRTermC,[1|SRSGoals]):- + term_singletons(Term,Singles), + term_attvars(Term,Vars), + copy_term(Term+Vars+Singles,TermC+VarsC+SinglesC,Goals), + notrace(catch(numbervars(TermC+Goals,0,_Ten1,[singletons(false),attvar(skip)]),_,fail)), + sort_goals(Goals,VarsC,SGoals), + maybe_replace_vars(VarsC,SGoals,TermC,RSGoals,RTermC), + include(not_sub_var(RSGoals),SinglesC,KSingles), + length(KSingles,SL),length(VSingles,SL),my_maplist(=('$VAR'('__')),VSingles), + subst_2L(KSingles,VSingles,[RTermC,RSGoals],[SRTermC,SRSGoals]), + subst_1L_p2(src_sameish,[ + {dif('$VAR'('__'),RED)}=dif(RED), + {cbg('$VAR'('__'))}=cbg], + SRTermC,SSRTermC),!. + +number_vars_calc_goals(Term,SRTermC,[2|RSGoals]):- + term_attvars(Term,AVars), + copy_term(Term+AVars,TermC+VarsC,GoalsI), + term_attvars(GoalsI,GAttvars), copy_term(GoalsI+GAttvars,_+GAttvarsC,GoalsGoals), + append(GoalsI,GoalsGoals,Goals), + append([VarsC,GAttvarsC,AVars,GAttvars],SortVars), + numbervars(TermC+Goals,0,_Ten1,[singletons(false),attvar(bind)]), + sort_goals(Goals,SortVars,SGoals), + maybe_replace_vars(SortVars,SGoals,TermC,RSGoals,RTermC), + subst_1L_p2(src_sameish,[ + {dif('$VAR'('___'),RED)}=dif(RED), + {cbg('$VAR'('___'))}=cbg], + RTermC,SRTermC),!. + +number_vars_calc_goals(Term,SSRTermC,[3|SRSGoals]):- + term_singletons(Term,Singles), + term_attvars(Term,Vars), + copy_term(Term+Vars+Singles,TermC+VarsC+SinglesC,Goals), + numbervars(TermC+Goals,0,_Ten1,[singletons(false),attvar(bind)]), + sort_goals(Goals,VarsC,SGoals), + maybe_replace_vars(VarsC,SGoals,TermC,RSGoals,RTermC), + include(not_sub_var(RSGoals),SinglesC,KSingles), + length(KSingles,SL),length(VSingles,SL),my_maplist(=('$VAR'('__')),VSingles), + subst_2L(KSingles,VSingles,[RTermC,RSGoals],[SRTermC,SRSGoals]), + subst(SRTermC,{cbg('_')},cbg,SSRTermC),!. + +number_vars_calc_goals(Term,TermC,[4|SGoals]):- + term_variables(Term,Vars), + term_attvars(Term,Attvars), + copy_term(Term+Vars+Attvars,TermC+VarsC+AttvarsC,Goals), + notrace(catch(numbervars(TermC+Goals,0,_Ten1,[singletons(true)]),_,fail)), + append([AttvarsC,VarsC,AttvarsC,Vars],Sorted), + sort_goals(Goals,Sorted,SGoals),!. + +number_vars_calc_goals(Term,TermC,[5|SGoals]):- + term_variables(Term,Vars), + term_attvars(Term,Attvars), + copy_term(Term+Vars+Attvars,TermC+VarsC+AttvarsC,Goals), + numbervars(TermC+Goals,0,_Ten1,[singletons(false),attvar(skip)]), + append([AttvarsC,VarsC,Attvars,Vars],Sorted), + sort_goals(Goals,Sorted,SGoals),!. + + + +writeg(Term):- ignore( \+ notrace(catch(once(writeg0(Term);ppa(Term)),E,(pp(E),ppa(Term))))),!. + +writeg0(Term):- term_attvars(Term,Attvars),Attvars\==[],!, + must_det_ll(((number_vars_calc_goals(Term,TermC,Goals), + writeg5(TermC)),!, + if_t(Goals\==[],(nl_if_needed, + write(' goals='), call_w_pad_prev(3,az_ansi(print_tree_no_nl(Goals))))))),!. + +writeg0(Term):- \+ ground(Term), + \+ \+ must_det_ll(( + numbervars(Term,0,_Ten1,[singletons(true),attvar(skip)]), writeg5(Term))). +writeg0(Term):- writeg5(Term),!. + +writeg5(X):- is_ftVar(X),!,write_nbsp,write_nbsp,print(X),write_nbsp. +writeg5(N=V):- is_simple_2x2(V),!,print_grid(N,V),writeln(' = '),call_w_pad_prev(2,writeg9(V)). +writeg5(N=V):- is_gridoid(V),!,print_grid(N,V),writeln(' = '),call_w_pad_prev(2,writeg9(V)). +writeg5(N=V):- nl_if_needed,nonvar(N), pp_no_nl(N),writeln(' = '), !, call_w_pad_prev(2,writeg5(V)). +writeg5(_):- write_nbsp, fail. +writeg5(V):- writeg9(V). + +writeg8(X):- is_ftVar(X),!,print(X). +writeg8(X):- var(X),!,print(X). +writeg8(X):- writeq(X). + +writeg9(V):- is_simple_2x2(V),!,print_simple_2x2(writeg8,V). +writeg9(V):- is_list(V),nl_if_needed,write('['),!,my_maplist(writeg5,V),write(']'). +writeg9(_):- write_nbsp,write(' \t '),fail. +writeg9(X):- is_ftVar(X),!,write_nbsp,write_nbsp,print(X). +writeg9(V):- pp_no_nl(V). + + +/* +writeg5(V):- is_simple_2x2(V),!,print_simple_2x2(writeg8,V). +writeg5(V):- is_gridoid(V),!,call_w_pad_prev(2,writeg9(V)). +writeg5(V):- is_list(V),nl_if_needed,write('['),my_maplist(writeg5,V),write(']'). +*/ +arg1_near(Vars,Goal,Nth):- tc_arg(1,Goal,PreSort),nth1(Nth,Vars,E),E==PreSort,!. +arg1_near(_VarsC,Goal,PreSort):- tc_arg(1,Goal,PreSort),!. +arg1_near(_VarsC,Goal,Goal). + +sort_goals(Goals,VarsC,SGoals):- predsort(sort_on(arg1_near(VarsC)),Goals,SGoals). + +/* + +writeg0(Obj):- is_object(Obj),pp(Obj),!. +writeg0(O):- writeg00(O). + +writeg00(Term):- + maybe_term_goals(Term,TermC,Goals), + writeg00(TermC), call_w_pad(2,writeg00(Goals)),!. +writeg00(N=V):- nl_if_needed,nonvar(N), pp_no_nl(N),writeln(' = '), !, call_w_pad(2,writeg00(V)). +writeg00(O):- compound(O),compound_name_arguments(O,F,[A]),!,call_w_pad(2,((writeq(F),write('('),writeg3(A),write(')')))). +writeg00(S):- term_contains_ansi(S), !, write_keeping_ansi_mb(S). +writeg00([H|T]):- compound(H),H=(_=_), my_maplist(writeg0,[H|T]). +writeg00([H|T]):- is_list(T),call_w_pad(2,((nl,write('['),writeg2(H),my_maplist(writeg0,T),write(']'),nl))). +%writeg0(Term):- \+ ground(Term),!, \+ \+ (numbervars(Term,99799,_,[singletons(true)]), +% subst(Term,'$VAR'('_'),'$VAR'('_____'),TermO), writeg0(TermO)). +%writeg0(V):- \+ is_list(V),!,writeq(V),nl_now. +writeg00(V):- \+ is_list(V),!,pp(V). +writeg00(X):- call_w_pad(2,pp(X)). + +writeg1(N=V):- is_gridoid(V),!,print_grid(N,V),call_w_pad(2,(my_maplist(writeg1,V))). +writeg1(X):- nl_if_needed,writeg2(X),!,write_nbsp,!. +writeg2(S):- term_contains_ansi(S), !, write_keeping_ansi_mb(S). +writeg2(X):- is_ftVar(X),!,print(X). +writeg2(X):- write_term(X,[quoted(true),quote_non_ascii(true),portrayed(false),nl(false),numbervars(true)]),!. +%writeg2(X):- write_term(X,[quoted(true),quote_non_ascii(true),portrayed(false),nl(false),numbervars(false)]),!. +%writeg1(X):- nl_if_needed,writeg(X). +writeg2(S):- term_is_ansi(S), !, write_keeping_ansi_mb(S). +writeg2(X):- writeq(X),!. +writeg3(X):- is_list(X),X\==[],X=[_,_|_],!,writeg(X). +writeg3(X):- writeg2(X). +*/ + +% Nov 9th, 1989 +/* +pp_hook_g1(T):- + nb_current('$portraying',Was) + -> ((member(E,Was), T==E) -> ptv2(T) ; locally(b_setval('$portraying',[T|Was]),ptv0(T))) + ; locally(b_setval('$portraying',[T]),ptv0(T)). +*/ + +%pp_hook_g(G):- compound(G),ppt(G),!. +%pp_hook_g(G):- ppt(G),!. + + +strip_vspace(S,Stripped):- string_concat(' ',SS,S),!,strip_vspace(SS,Stripped). +strip_vspace(S,Stripped):- string_concat(SS,' ',S),!,strip_vspace(SS,Stripped). +strip_vspace(S,Stripped):- string_concat('\n',SS,S),!,strip_vspace(SS,Stripped). +strip_vspace(S,Stripped):- string_concat(SS,'\n',S),!,strip_vspace(SS,Stripped). +strip_vspace(S,Stripped):- string_concat('\t',SS,S),!,strip_vspace(SS,Stripped). +strip_vspace(S,Stripped):- string_concat(SS,'\t',S),!,strip_vspace(SS,Stripped). + +strip_vspace(S,Stripped):- replace_in_string([" \n"="\n","( "="( ","(\n"="( "],S,S2),S2\==S,!,strip_vspace(S2,Stripped). +%strip_vspace(S,Stripped):- split_string(S, "", "\t\r\n", [Stripped]). +strip_vspace(S,S). + + +print_nl(P):- nl_if_needed, wots_hs(SS,pp_no_nl(P)), maybe_color(SS,P),nl_if_needed. + +color_write(S):- term_is_ansi(S), !, write_keeping_ansi_mb(S). +color_write(P):- wots_hs(SS,write(P)), maybe_color(SS,P). + +write_keeping_ansi_mb(P):- is_maybe_bold(P,write_keeping_ansi(P)). + +is_maybe_bold(P):- sformat(S,'~w',[P]),atom_contains(S,'stOF'). + +is_maybe_bold(P,G):- is_maybe_bold(P),!, underline_print(bold_print(G)). +is_maybe_bold(_P,G):- call(G). + +pp_msg_color(P,C):- compound(P),pc_msg_color(P,C),!. +pp_msg_color(P,C):- must_det_ll(mesg_color(P,C)). +pc_msg_color(iz(P),C):- pp_msg_color(P,C). +pc_msg_color(link(P,_,_),C):- pp_msg_color(P,C). +pc_msg_color(link(P,_),C):- pp_msg_color(P,C). +pc_msg_color((_->P),C):- pp_msg_color(P,C). +pc_msg_color([P|_],C):- pp_msg_color(P,C). +pc_msg_color(diff(P),C):- pp_msg_color(P,C). + +%:- meta_predicate(wots_hs(0)). +%wots_hs(G):- wots_hs(S,G),write(S). + +:- meta_predicate(wots_ansi(-,0)). +wots_ansi(S,Goal):- wots(S,woto_ansi(Goal)). +:- meta_predicate(wots_ansi(-,0)). +wots_html(S,Goal):- wots(S,woto_html(Goal)). + +:- meta_predicate(woto_ansi(0)). +woto_ansi(Goal):- with_toplevel_pp(ansi,Goal). +:- meta_predicate(woto_html(0)). +woto_html(Goal):- with_toplevel_pp(http,Goal). + +:- meta_predicate(wots_hs(-,0)). +%wots_hs(S,G):- \+ wants_html,!,wots(S,G). +%wots_hs(S,G):- wots(S,G),!. +wots_hs(S,G):- wots(SS,G),notrace(remove_huge_spaces(SS,S)). +:- meta_predicate(wots_vs(-,0)). +wots_vs(OOO,G):- wots(S,G),notrace(fix_vspace(S,OOO)). + +fix_vspace(S,OOO):- + strip_vspace(S,SS), (atom_contains(SS,'\n') -> + wots_hs(SSS,(nl_now,write(' '),write(SS),nl_now));SSS=SS), + remove_huge_spaces(SSS,OOO). + + +write_tall(L):- is_list(L),!,my_maplist(write_tall,L). +write_tall(E):- wots_vs(S,wqs_c(E)),writeln(S). +write_wide(L):- is_list(L),!,my_maplist(write_wide,L). +write_wide(E):- wots_vs(S,wqs_c(E)),write(S),write_nbsp. + +p_to_br(S,SS):- fix_br_nls(S,S0), + cr_to_br(S0,SSS), + replace_in_string(['

'='
','
'='
','

'=' ','

'='
','

'='
'],SSS,SSSS), + cr_to_br(SSSS,SS). + +cr_to_br(S,SSS):- wants_html,!,cr_to_br_html(S,SSS). +cr_to_br(S,SSS):- cr_to_br_ansi(S,SSS). + +cr_to_br_html(S,SSS):- replace_in_string(['\r\n'='
','\r'='
','\n'='
'],S,SSS). +cr_to_br_ansi(S,SSS):- replace_in_string(['
'='\n',' '=' '],S,SSS). + +fix_br_nls(S,O):- replace_in_string( + ['
\n'='
','
\n'='
','

\n'='

','

\n'='

','

\n'='

', + '\n
'='
','\n
'='
','\n

'='

','\n

'='

','\n

'='

'],S,O). + +remove_huge_spaces(S,O):- notrace((fix_br_nls(S,SS),!,p_to_br(SS,O))),!. +/* +remove_huge_spaces(S,O):- fix_br_nls(S,S0), + replace_in_string([' '=' ', + ' '=' ', + ' '=' ', + ' '=' ', + ' '=' ', + ' '=' ', + ' '=' ', + '\t'=' ', + ' '=' '],S0,SS),p_to_br(SS,O). +*/ + + +wqs_l(H):- \+ is_list(H),!, wqs(H). +wqs_l(H):- wqs(H). + +wqs(P):- wots_hs(SS,wqs0(P)), maybe_color(SS,P). +wqs(C,P):- ansicall(C,wqs0(P)),!. + +wqs0(X):- plain_var(X), wqs(plain_var(X)),!. +wqs0(X):- plain_var(X), !, wqs(plain_var(X)), ibreak. +wqs0(S):- term_is_ansi(S), !, write_keeping_ansi_mb(S). +wqs0(C):- is_colorish(C),color_print(C,C),!. +wqs0(G):- is_vm_map(G), !, write_map(G,'wqs'). +wqs0(X):- var(X), !, get_attrs(X,AVs),!,writeq(X),write('/*{'),print(AVs),write('}*/'). +wqs0(X):- attvar(X), !, wqs(attvar(X)). +wqs0(nl_now):- !, nl_now. wqs0(X):- X=='', !. wqs0(X):- X==[], !. +wqs0(X):- is_grid(X), !, print_grid(X). +wqs0(G):- compound(G), G = call(C),callable(C),!,call(C). +wqs0([T]):- !, wqs(T). +wqs0([H|T]):- string(H), !, write(H), write_nbsp, wqs(T). +wqs0([H|T]):- compound(H),skip(_)=H, !,wqs(T). +wqs0([H|T]):- wqs(H), need_nl(H,T), wqs(T), !. +wqs0(X):- is_object(X), tersify1(X,Q), X\==Q,!, wqs(Q). +wqs0(X):- is_object(X), show_shape(X),!. +wqs0(X):- string(X), atom_contains(X,'~'), catch((sformat(S,X,[]),color_write(S)),_,fail),!. +wqs0(X):- string(X), !, color_write(X). +%wqs([H1,H2|T]):- string(H1),string(H2),!, write(H1),write_nbsp, wqs([H2|T]). +%wqs([H1|T]):- string(H1),!, write(H1), wqs(T). +%wqs([H|T]):- compound(H),!, writeq(H), wqs(T). + +wqs0(call(C)):- !, call(C). +wqs0(X):- \+ compound(X),!, write_nbsp, write(X). +wqs0(C):- compound(C),wqs1(C),!. +wqs0(C):- wqs2(C). +%wqs(S):- term_contains_ansi(S), !, write_nbsp, write_keeping_ansi_mb(S). + +wqs2(S):- term_contains_ansi(S), !, write_nbsp, write_keeping_ansi_mb(S). +%wqs2(P):- wants_html,!,pp(P). + +:- thread_local(t_l:wqs_fb/1). +wqs2(X):- t_l:wqs_fb(P1),call(P1,X),!. +%wqs2(X):- with_wqs_fb(writeq,X). +wqs2(X):- with_wqs_fb(writeq,print(X)),!. +%wqs2(X):- with_wqs_fb(writeq,((write_nbsp,write_term(X,[quoted(true)])))). + +with_wqs_fb(FB,Goal):- + locally(t_l:wqs_fb(FB),Goal). + + +as_arg_str(C,S):- wots_vs(S,print(C)). + +arg_string(S):- string(S),!. +arg_string(S):- term_contains_ansi(S),!. + +wqs1(C):- \+ compound(C),!,wqs0(C). +wqs1(S):- term_is_ansi(S), !, write_keeping_ansi_mb(S). + +wqs1(format(C,N)):- catch((sformat(S,C,N),color_write(S)),_,fail),!. +wqs1(writef(C,N)):- !, writef(C,N). +wqs1(q(C)):- \+ arg_string(C),wots_hs(S,writeq(C)),color_write(S),!. +wqs1(g(C)):- \+ arg_string(C),wots_vs(S,bold_print(wqs1(C))),print(g(S)),!. +wqs1(print_ss(C)):- \+ arg_string(C), wots_vs(S,print_ss(C)),wqs1(print_ss(S)),!. +wqs1(b(C)):- \+ arg_string(C), wots_vs(S,bold_print(wqs1(C))),color_write(S). +wqs1(T):- \+ is_list(T), term_contains_ansi(T),!,write_keeping_ansi_mb(T). +wqs1(norm(C)):- writeq(norm(C)),!. +wqs1(grid_rep(norm,C)):- writeq(grid_rep(norm,C)),!. +wqs1(grid(C)):- writeq(grid(C)),!. +wqs1(rhs(RHS)):- nl_now,wqnl(rhs(RHS)),nl_now. +%wqs1(grid_ops(norm,C)):- writeq(norm(C)),!. +%norm_grid + +wqs1(pp(P)):- wots_vs(S,pp_no_nl(P)),write((S)). +wqs1(ppt(P)):- wots_vs(S,ppt_no_nl(P)),write((S)). +wqs1(wqs(P)):- wots_vs(S,wqs(P)),write((S)). +wqs1(wqs(C,P)):- wots_vs(S,wqs(P)),color_print(C,S). + +wqs1(vals(C)):- writeq(vals(C)),!. +%wqs1(colors_cc(C)):- \+ arg_string(C), as_arg_str(C,S),wqs(colorsz(S)). +wqs1(io(C)):- \+ arg_string(C),wots_vs(S,bold_print(wqs(C))),write(io(S)). + +wqs1(uc(C,W)):- !, write_nbsp, color_print(C,call(underline_print(format("\t~@",[wqs(W)])))). +wqs1(cc(C,N)):- is_color(C),!,color_print(C,call(writeq(cc(C,N)))). +wqs1(write_nav_cmd(C,N)):- !, write_nav_cmd(C,N). + +wqs1(-(C,N)):- is_color(C),!,color_print(C,call(writeq(C))), write('-'), wqs(N). +wqs1(cc(C,N)):- N\==0,attvar(C), get_attrs(C,PC), !, wqs(ccc(PC,N)). +wqs1(cc(C,N)):- N\==0,var(C), sformat(PC,"~p",[C]), !, wqs(ccc(PC,N)). +wqs1(cc(C,N)):- \+ arg_string(C), wots_hs(S,color_print(C,C)), wqs(cc(S,N)). +wqs1(color_print(C,X)):- is_color(C), !, write_nbsp, color_print(C,X). +wqs1(color_print(C,X)):- \+ plain_var(C), !, write_nbsp, color_print(C,X). +wqs1(X):- into_f_arg1(X,_,Arg),is_gridoid(Arg),area_or_len(Arg,Area),Area<5,writeq(X),!. +% wqs1(C):- callable(C), is_wqs(C),wots_vs(S,catch(C,_,fail)),write((S)). +wqs1(X):- is_gridoid_arg1(X), print_gridoid_arg1(X). + +into_f_arg1(X,F,Arg):- compound(X), compound_name_arguments(X,F,[Arg]), compound(Arg). + +is_gridoid_arg1(X):- into_f_arg1(X,_F,Arg),is_gridoid(Arg). +print_gridoid_arg1(X):- into_f_arg1(X,F,Arg),print_gridoid_arg1(F,Arg). + +print_gridoid_arg1(F,Arg):- \+ wants_html,!, wots_vs(VS,wqs(Arg)), writeq(F),write('(`'),!, print_with_pad(write(VS)),write('`)'). +print_gridoid_arg1(F,Arg):- wots_vs(VS,wqs(Arg)), + with_tag_style(span,"display: inline; white-space: nowrap",(writeq(F),write('({'),!,write(VS),write('})'))). + + +nl_needed(N):- line_position(current_output,L1),L1>=N. + +nl_now :- wants_html,!,nl_if_needed_ansi. +nl_now :- nl. + +ansi_in_pre:- current_predicate(in_pre/0),in_pre. +nl_if_needed :- ansi_main,!, format('~N'). +nl_if_needed :- ansi_in_pre,ignore((nl_needed(11),write('
'))),!. +nl_if_needed :- wants_html,!,ignore((nl_needed(11),write('
\n'))). +nl_if_needed :- format('~N'). +nl_if_needed_ansi :- \+ ansi_main, wants_html,!. +nl_if_needed_ansi :- nl_if_needed. + +write_nbsp:- ansi_main,!,write(' '). +write_nbsp:- wants_html,!,write(' '). +write_nbsp:- write(' '). + +is_breaker(P):- compound(P),functor(P,_,A), A>=3. + +last_f(H,F):- \+ compound(H),data_type(H,F). +last_f(H,F/A):- compound(H),!,functor(H,F,A). + +need_nl(_,_):- line_position(current_output,L1),L1<40,!. +need_nl(_,_):- line_position(current_output,L1),L1>160,!,nl_if_needed. +need_nl(H0,[H1,H2|_]):- H1\=cc(_,_), last_f(H0,F0),last_f(H1,F1),last_f(H2,F2), F0\==F1, F1==F2,!,format('~N '). +%need_nl(H0,[H1|_]):- last_f(H0,F0),last_f(H1,F1), F0==F1, !, write_nbsp. +need_nl(_,_). +/* +need_nl(_Last,[H|_]):- last_f(H,F), + once(nb_current(last_h,cc(LF,C));(LF=F,C=0)), + (LF==F-> (write_nbsp, plus(C,1,CC), nb_setval(last_h,cc(F,CC))) ; ((C>2 -> nl_now ; write_nbsp), nb_setval(last_h,cc(F,0)))). + +need_nl(_,_):- wants_html,!,write_nbsp. +%need_nl(_,_):- !,write_nbsp. +need_nl(H,[P|_]):- \+ is_breaker(H),is_breaker(P),line_position(user_output,L1),L1>80,nl_now,bformatc1('\t\t'). +need_nl(_,_):- line_position(user_output,L1),L1>160,nl_now,bformatc1('\t\t'). +need_nl(_,_). +*/ + +dash_chars:- wants_html,!,section_break. +dash_chars:- dash_chars(40),!. + +dash_chars(_):- wants_html,!,section_break. +dash_chars(H):- integer(H), dash_border(H). +dash_chars(S):- nl_if_needed,dash_chars(60,S),nl_if_needed_ansi. +dash_chars(_,_):- wants_html,!,section_break. +dash_chars(H,_):- H < 1,!. +dash_chars(H,C):- forall(between(0,H,_),bformatc1(C)). + +%section_break:- wants_html,!,write('

'). +section_break. +%dash_uborder_no_nl_1:- line_position(current_output,0),!, bformatc1('\u00AF\u00AF\u00AF '). +%dash_uborder_no_nl_1:- line_position(current_output,W),W==1,!, bformatc1('\u00AF\u00AF\u00AF '). +dash_uborder_no_nl_1:- bformatc1('\u00AF\u00AF\u00AF '). +dash_uborder_no_nl_1:- uborder(Short,Long),!, bformatc1(Short),bformatc1(Long),write_nbsp. +dash_uborder_no_nl(1):- !, dash_uborder_no_nl_1. +dash_uborder_no_nl(Width):- WidthM1 is Width-1, uborder(Short,Long),write_nbsp, write(Short),dash_chars(WidthM1,Long),!. +dash_uborder_no_nl(Width):- WidthM1 is Width-1, write_nbsp, bformat('\u00AF'),dash_chars(WidthM1,'\u00AF\u00AF'),!. +dash_uborder_no_nl(Width):- nl_if_needed, WidthM1 is Width-1, bformatc1(' \u00AF'),dash_chars(WidthM1,'\u00AF\u00AF'). + +dash_uborder(Width):- nl_if_needed,dash_uborder_no_nl(Width),nl_now. + +uborder('-','--'):- stream_property(current_output,encoding(utf8)),!. +uborder('\u00AF','\u00AF\u00AF'):- !. %stream_property(current_output,encoding(text)). +%uborder('-','--'). + +dash_border_no_nl_1:- line_position(current_output,0),!, bformatc1(' ___ '). +dash_border_no_nl_1:- line_position(current_output,W),W==1,!, bformatc1('___ '). +dash_border_no_nl_1:- bformatc1(' ___ '). + +%dash_border_no_nl(Width):- write(''),dash_chars(Width,'_'),write_nbsp,!. + +dash_border_no_nl(Width):- nl_if_needed, WidthM1 is Width-1, bformatc1(' _'),dash_chars(WidthM1,'__'). + +dash_border(Width):- !, dash_border_no_nl(Width),nl_now,!. + +functor_test_color(pass,green). +functor_test_color(fail,red). +functor_test_color(warn,yellow). + +arcdbg(G):- is_vm_map(G), !, write_map(G,'arcdbg'). +arcdbg(G):- compound(G), compound_name_arity(G,F,_),functor_test_color(F,C), + wots_hs(S,print(G)),color_print(C,S),!,nl_if_needed_ansi. +arcdbg(G):- u_dmsg(G). + + +%user:portray(Grid):- ((\+ tracing, is_group(Grid),print_grid(Grid))). +%user:portray(Grid):- quietlyd((is_object(Grid),print_grid(Grid))). +n_times(N,Goal):- forall(between(1,N,_),ignore(Goal)). +banner_lines(Color):- banner_lines(Color,1). +banner_lines(Color,N):- wants_html,!,format('\n
\n',[N,Color]),!. +banner_lines(Color,N):- + must_det_ll((nl_if_needed, + n_times(N,color_print(Color,'-------------------------------------------------')),nl_now, + n_times(N,color_print(Color,'=================================================')),nl_now, + n_times(N,color_print(Color,'-------------------------------------------------')),nl_now, + n_times(N,color_print(Color,'=================================================')),nl_now, + n_times(N,color_print(Color,'-------------------------------------------------')),nl_now)),!. + +print_sso(A):- ( \+ compound(A) ; \+ (sub_term(E,A), is_gridoid(E))),!, u_dmsg(print_sso(A)),!. +print_sso(A):- grid_footer(A,G,W),writeln(print_sso(W)), print_grid(W,G),!. +print_sso(A):- must_det_ll(( nl_if_needed, into_ss_string(A,SS),!, + SS = ss(L,Lst), + writeln(print_sso(l(L))), + forall(member(S,Lst),writeln(S)),nl_if_needed)),!. + +var_or_number(V):- var(V),!. +var_or_number(V):- integer(V),!. + + +find_longest_len(SL,L):- find_longest_len(SL,10,L),!. +find_longest_len([],L,L). +find_longest_len([S|SS],N,L):- print_length(S,N2),max_min(N,N2,NM,_), + find_longest_len(SS,NM,L). + +:- meta_predicate( print_with_pad(0)). +:- export( print_with_pad/1). +/*print_with_pad(Goal):- + + (line_position(current_output,O);O=0),!, + O1 is O+1, + call_w_pad(O1,Goal). +*/ +print_with_pad(Goal):-(line_position(current_output,O);O=0),!, O1 is O+1,wots(S,Goal),print_w_pad(O1,S). + + +into_s(Text,S):- notrace(catch(text_to_string(Text,S),_,fail)),!. +into_s(Obj,S):- wots_hs(S,pp(Obj)),!. + +print_w_pad(Pad,Text):- into_s(Text,S), atomics_to_string(L,'\n',S)-> my_maplist(print_w_pad0(Pad),L). +print_w_pad0(Pad,S):- nl_if_needed,dash_chars(Pad,' '), write(S). + + +:- meta_predicate(call_w_pad_prev(+,0)). +call_w_pad_prev(Pad,Goal):- wots_hs(S,Goal), print_w_pad(Pad,S). + +%call_w_pad(N,Goal):- wants_html,!,format('',[N]),call_cleanup(call(Goal),write('')). +:- meta_predicate(call_w_pad(+,0)). +call_w_pad(_N,Goal):- wants_html,!,format('',[]),call_cleanup(call(Goal),write('')). +call_w_pad(N,Goal):- nl_if_needed,wots_hs(S,dash_chars(N,' ')),!,pre_pend_each_line(S,Goal). +maybe_print_pre_pended(Out,Pre,S):- atomics_to_string(L,'\n',S), maybe_print_pre_pended_L(Out,Pre,L). +maybe_print_pre_pended_L(Out,_,[L]):- write(Out,L),!,flush_output(Out). +maybe_print_pre_pended_L(Out,Pre,[H|L]):- write(Out,H),nl(Out),!,write(Out,Pre),maybe_print_pre_pended_L(Out,Pre,L). + +%pre_pend_each_line(_,Goal):- !,ignore(Goal). +:- meta_predicate(pre_pend_each_line(+,0)). +pre_pend_each_line(Pre,Goal):- write(Pre),pre_pend_each_line0(Pre,Goal). +pre_pend_each_line0(Pre,Goal):- + current_output(Out), + current_predicate(predicate_streams:new_predicate_output_stream/2),!, + call(call,predicate_streams:new_predicate_output_stream([Data]>>maybe_print_pre_pended(Out,Pre,Data),Stream)), + arc_set_stream(Stream,tty(true)), + %arc_set_stream(Stream,buffer(false)), + %undo(ignore(catch(close(Stream),_,true))),!, + setup_call_cleanup(true, + (with_output_to_each(Stream,once(Goal)),flush_output(Stream)), + ignore(catch(close(Stream),_,true))),!. +pre_pend_each_line0(Pre,Goal):- + with_output_to_each(string(Str),Goal)*->once((maybe_print_pre_pended(current_output,Pre,Str),nl_if_needed)). + + + +end_of_file. + + + +run_source_code(ShareVars, SourceCode, Vs, QQ):- + QQ = source_buffer(SourceCode,Vs),!, + %print(term=Sourcecode -> vs=Vs), + maplist(share_vars(Vs),ShareVars), + (\+ is_list(SourceCode) + -> mort(SourceCode) + ; maplist(mort,SourceCode)). + +run_source_code(ShareVars, Vs, QQ):- + QQ = source_buffer(SourceCode,Vs),!, + %print(term=Sourcecode -> vs=Vs), + maplist(share_vars(Vs),ShareVars), + (\+ is_list(SourceCode) + -> mort(SourceCode) + ; maplist(mort,SourceCode)). + + +%vars_to_dictation([_=Value|Gotten],TIn,TOut):- is_vm_map(Value),!, vars_to_dictation(Gotten,TIn,TOut). + +vars_to_dictation([Name=Value|Gotten],TIn,TOut):- !, + my_assertion(atom(Name)), + vars_to_dictation(Gotten,TIn,TMid), + to_prop_name(Name,UName), + tio_tersify(Value,ValueT),!, + put_dict(UName,TMid,ValueT,TOut). + +vars_to_dictation([NameValue|Gotten],TIn,TOut):- !, + vars_to_dictation(Gotten,TIn,TMid), + to_prop_name(NameValue,UName), + tio_tersify(NameValue,ValueT),!, + put_dict(UName,TMid,ValueT,TOut). + +vars_to_dictation([NameValue|Gotten],TIn,TOut):- compound(NameValue),compound_name_arguments(NameValue,Name,Value),!, + vars_to_dictation([Name=Value|Gotten],TIn,TOut). + +vars_to_dictation([],T,T). + +tio_tersify(Value,ValueT):- is_grid(Value),!,ValueT=_. +tio_tersify(Value,Value). +:- export(copy_qq_//1). + +copy_qq_([]) --> []. +copy_qq_([C|Cs]) --> [C], copy_qq_(Cs). + +:- export(copy_qq//1). +muarc:copy_qq(A) --> copy_qq_(Cs), {atom_codes(A, Cs)}. + +to_prop_name(Name=_,UName):- nonvar(Name),!,to_prop_name(Name,UName). +to_prop_name(Name,UName):- compound(Name),compound_name_arity(Name,F,_),!,to_prop_name(F,UName). +to_prop_name(Name,UName):- to_case_breaks(Name,Breaks),xtis_to_atomic(Breaks,UName). + +xtis_to_atomic([xti(Str,upper),xti(StrL,lower)|Breaks],StrO):- string_upper(Str,Str), + symbol_chars(Str,CharsList),append(Left,[U],CharsList), + name(S1,Left),symbolic_list_concat([S1,'_',U,StrL],'',StrUL),!, + xtis_to_atomic([xti(StrUL,lower)|Breaks],StrO). +xtis_to_atomic([],''). +xtis_to_atomic([xti(Str,_)],Lower):- downcase_atom(Str,Lower). +xtis_to_atomic([XTI|Breaks],Atomic):- + xtis_to_atomic([XTI],S1),xtis_to_atomic(Breaks,S2),!,symbolic_list_concat([S1,S2],'_',Atomic). + +share_vars(Vs,Name=Value):- member(VName=VValue,Vs),VName==Name,!,(Value=VValue->true;trace_or_throw(cant(share_vars(Vs,Name=Value)))). +share_vars(_,Name=_):- string_concat('_',_,Name),!. % Hide some vars +share_vars(V,Name=Value):- fbug(missing(share_vars(V,Name=Value))),!. + + + +parse_expansions(_,Vs,Vs,Src,Src):- \+ compound(Src),!. +parse_expansions(_,Vs0,Vs,dont_include(Var),nop(dont_include(Var))):- + dont_include_var(Vs0,Vs,Var),!. +parse_expansions(F, Vs0,Vs,[Src0|Sourcecode0],[Src|Sourcecode]):- !, + parse_expansions(F, Vs0, Vs1, Src0, Src), + parse_expansions(F, Vs1, Vs, Sourcecode0, Sourcecode). +parse_expansions(FF, Vs0, Vs, Cmpd0, Cmpd):- + compound_name_arguments(Cmpd0,F,Args0), + parse_expansions([F|FF], Vs0, Vs, Args0,Args), + compound_name_arguments(Cmpd,F,Args). + +dont_include_var(Vs0,Vs,Var):- select(_=VV,Vs0,Vs),VV==Var,!. +dont_include_var(Vs,Vs,_). + +append_sets(Sets,Set):- append(Sets,List),list_to_set(List,Set). +append_sets(Set1,Set2,Set):- append(Set1,Set2,List),list_to_set(List,Set). +flatten_sets(Sets,Set):- flatten(Sets,List),list_to_set(List,Set). + +print_prop_val(N=V):- to_prop_name(N,P),format('~N\t\t'),print(P=V),nl. + + +ignore_numvars(Name='$VAR'(Name)). + + diff --git a/.Attic/canary_docme/swi_support.pl b/.Attic/canary_docme/swi_support.pl new file mode 100644 index 00000000000..2fdf60dc0e1 --- /dev/null +++ b/.Attic/canary_docme/swi_support.pl @@ -0,0 +1,190 @@ + +:- set_prolog_flag(verbose_autoload, false). +:- set_prolog_flag(verbose, silent). +:- set_prolog_flag(verbose_load, silent). +:- assert((user:'$exported_op'(_,_,_):- fail)). +:- abolish((system:'$exported_op'/3)). +:- assert((system:'$exported_op'(_,_,_):- fail)). + +fbug(_):- is_compatio,!. +fbug(P) :- format("~N"), current_predicate(write_src/1), + with_output_to(user_error,in_cmt(write_src(P))),!. +fbug(N=V) :- nonvar(N), !, fbdebug1(N:-V). +fbug(V) :- compound(V),functor(V,F,_A),!,fbdebug1(F:-V). +fbug(V) :- fbdebug1(debug:-V). +fbdebug1(Message) :- + % ISO Standard: flush_output/1 + flush_output(user_output), + flush_output(user_error), + catch(portray_clause(user_error,Message,[]),_,catch_ignore(format(user_error, "~n/* ~q. */~n", [Message]))), + %format(user_error, "~n/* ~p. */~n", [Message]), + flush_output(user_error). + + +swi_only(_):- is_scryer,!,fail. +swi_only(G):- call(G). +is_scryer:- \+ current_prolog_flag(libswipl,_). + + +:- create_prolog_flag(max_per_file,inf,[keep(true),access(read_write),type(term)]). +:- create_prolog_flag(max_disk_cache,inf,[keep(true),access(read_write),type(term)]). +:- create_prolog_flag(samples_per_million,inf,[keep(true),access(read_write),type(term)]). + +with_cwd(Dir,Goal):- Dir == '.',!,setup_call_cleanup(working_directory(X, X), Goal, + working_directory(_,X)). +with_cwd(Dir,Goal):- var(Dir),X=Dir,!,setup_call_cleanup(working_directory(X, X), Goal, + working_directory(_,X)). + +with_cwd(Dir,Goal):- \+ exists_directory(Dir),!,throw(with_cwd(Dir,Goal)),!. +with_cwd(Dir,Goal):- setup_call_cleanup(working_directory(X, Dir), Goal, working_directory(_,X)). + +with_option([],G):-!,call(G). +with_option([H|T],G):- !, with_option(H,with_option(T,G)). +with_option(N=V,G):-!, with_option(N,V,G). +with_option(NV,G):- compound(NV), NV =..[N,V],!,with_option(N,V,G). +with_option(N,G):- with_option(N,true,G). + +with_option(N,V,G):- (was_option_value(N,W)->true;W=[]), + setup_call_cleanup(set_option_value(N,V),G, set_option_value(N,W)). + + +was_option_value(N,V):- current_prolog_flag(N,VV),!,V=VV. +was_option_value(N,V):- prolog_load_context(N,VV),!,V=VV. +was_option_value(N,V):- nb_current(N,VV), VV\==[],!,V=VV. + +option_else(N,V,Else):- notrace((option_else0(N,VV,Else),p2mE(VV,V))). +option_else0( N,V,_Else):- was_option_value(N,VV),!,VV=V. +option_else0(_N,V, Else):- !,V=Else. + +%option_value( N,V):- var(V), !, notrace(once(((option_value0(N,V))))). +option_value(N,V):- var(V), !, was_option_value( N,VV), once((p2mE(VV,V2),p2mE(V,V1))), V1=V2. +option_value(N,V):- V==true,option_value0(N,'True'),!. +option_value(N,V):- V==false,option_value0(N,'False'),!. +option_value(N,V):- notrace(option_value0(N,V)). + + +option_value0( N,V):- was_option_value( N,VV), once((p2mE(VV,V2),p2mE(V,V1))), V1=V2. +option_value0(_N,[]). + +p2mE(NA,NA):- \+ atom(NA),!. +p2mE(false,'False'). +p2mE(true,'True'). +p2mE(E,E). +set_option_value(N,V):- + set_option_value0(N,V). +set_option_value0(N,V):- + p2mE(V,VV),!, + catch(nb_setval(N,VV),E,fbug(E)), + p2mE(PV,VV),!, + catch(create_prolog_flag(N,PV,[keep(false),access(read_write), type(term)]),E2,fbug(E2)), + catch(set_prolog_flag(N,PV),E3,fbug(E3)),!. + +kaggle_arc:- \+ exists_directory('/opt/logicmoo_workspace/packs_sys/logicmoo_agi/prolog/kaggle_arc/'), + !. +%kaggle_arc:- !. +kaggle_arc:- + with_option(argv,['--libonly'], + with_cwd('/opt/logicmoo_workspace/packs_sys/logicmoo_agi/prolog/kaggle_arc/', + ensure_loaded(kaggle_arc))). + +%:- ensure_loaded((read_obo2)). + +%:- kaggle_arc. + + +all_upper_symbol(A):-all_upper_atom(A). +any_to_symbol(A,B):-any_to_atom(A,B). +concat_symbol(A,B,C):-concat_atom(A,B,C). +downcase_symbol(A,B):-downcase_atom(A,B). +non_empty_symbol(A):-non_empty_atom(A). +string_to_symbol(A,B):-string_to_atom(A,B). +sub_string_or_symbol(A,B,C,D,E):-sub_string_or_atom(A,B,C,D,E). +sub_symbol(A,B,C,D,E):-sub_atom(A,B,C,D,E). + +symbol(A):- atom(A). +symbol_chars(A,B):- atom_chars(A,B). +symbol_codes(A,B):-atom_codes(A,B). +symbol_concat(A,B,C):- atom_concat(A,B,C). +symbol_contains(A,B):- atom_contains(A,B). +symbol_length(A,B):- atom_length(A,B). +symbol_number(A,B):- atom_number(A,B). +symbol_string(A,B):- atom_string(A,B). +symbol_upper(A,B):- upcase_atom(A,B). +symbolic(A):-atomic(A). +symbolic_concat(A,B,C):-atomic_concat(A,B,C). +symbolic_concat(A,B,C,D):-atomic_concat(A,B,C,D). +symbolic_list_concat(A,B):-atomic_list_concat(A,B). +symbolic_list_concat(A,B,C):- atomic_list_concat(A,B,C). +symbolic_to_string(A,B):-atomic_to_string(A,B). +symbolics_to_string(A,B):-atomics_to_string(A,B). +symbolics_to_string(A,B,C):-atomics_to_string(A,B,C). +upcase_symbol(A,B):-upcase_atom(A,B). +:- prolog_load_context(directory, File), + ignore(( + absolute_file_name('../../data/ftp.flybase.org/releases/current/',Dir,[relative_to(File), + file_type(directory), file_errors(fail)]), + asserta(ftp_data(Dir)))). + +:- prolog_load_context(file, File), + absolute_file_name('./',Dir,[relative_to(File),file_type(directory)]), + asserta(pyswip_dir(Dir)). + + +:- prolog_load_context(directory, Dir), + asserta(user:library_directory(Dir)), + asserta(pyswip_metta_dir(Dir)). + +metta_python:- ensure_loaded(library(metta_python)). +:- if( (fail, \+ current_predicate(must_det_ll/1))). +% Calls the given Goal and throws an exception if Goal fails. +% Usage: must_det_ll(+Goal). +must_det_ll(M:Goal) :- !, must_det_ll(M,Goal). +must_det_ll(Goal) :- must_det_ll(user,Goal). + +must_det_ll(_M,Goal) :- var(Goal),!,throw(var_must_det_ll(Goal)),!. +must_det_ll(M,Goal) :- var(M),!,strip_module(Goal,M,NewGoal),!,must_det_ll(M,NewGoal). +must_det_ll(M,(GoalA,GoalB)) :- !, must_det_ll(M,GoalA), must_det_ll(M,GoalB). +must_det_ll(M,(GoalA->GoalB;GoalC)) :- !, (call_ll(M,GoalA)-> must_det_ll(M,GoalB) ; must_det_ll(M,GoalC)). +must_det_ll(M,(GoalA*->GoalB;GoalC)) :- !, (call_ll(M,GoalA)*-> must_det_ll(M,GoalB) ; must_det_ll(M,GoalC)). +must_det_ll(M,(GoalA->GoalB)) :- !, (call_ll(M,GoalA)-> must_det_ll(M,GoalB)). +must_det_ll(_,M:Goal) :- !, must_det_ll(M,Goal). +must_det_ll(M,Goal) :- + % Call Goal, succeed with true if Goal succeeds. + M:call(Goal) -> true ; % If Goal fails, throw an exception indicating that Goal failed. + throw(failed(Goal)). + +call_ll(_M,Goal):- var(Goal),!,throw(var_call_ll(Goal)),!. +call_ll(M,Goal):- var(M),!,strip_module(Goal,M,NewGoal),!,call_ll(M,NewGoal). +call_ll(M,Goal):- M:call(Goal). + +:- endif. + + +:- if( \+ current_predicate(if_t/2)). +if_t(If,Then):- call(If)->call(Then);true. +:-endif. + +:- if( \+ current_predicate(atom_contains/2)). +atom_contains(Atom1, SubAtom) :- sub_atom(Atom1, _Before, _, _After, SubAtom). +:- endif. + +:- if( \+ current_predicate(nop/1)). +nop(_). +:- endif. + +:- if( \+ current_predicate(catch_ignore/1)). +catch_ignore(G):- ignore(catch(G,E,catch_i((nl,writeq(causes(G,E)),nl)))). +:- endif. + +:- if( \+ current_predicate(catch_i/1)). +catch_i(G):- ignore(catch(G,_,true)). +:- endif. + +:- if( \+ current_predicate(add_history1/1)). +add_history1(_). +:- endif. + +:- if( \+ current_predicate(add_history/1)). +add_history(_). +:- endif. + diff --git a/.Attic/metta_lang/metta_mizer.pl b/.Attic/metta_lang/metta_mizer.pl index e9dde743a4a..fdebabb4b28 100755 --- a/.Attic/metta_lang/metta_mizer.pl +++ b/.Attic/metta_lang/metta_mizer.pl @@ -316,6 +316,10 @@ did_optimize_conj(Head,B1,B2,B12), must_optimize_body(Head,(B12,B3),BN),!. %optimize_conjuncts(Head,(B1,B2),BN1):- optimize_conj(Head,B1,B2,BN1). + + + + optimize_conjuncts(Head,(B1,B2),BN1):- did_optimize_conj(Head,B1,B2,BN1),!. optimize_conjuncts(Head,(B1*->B2),(BN1*->BN2)):- !, optimize_conjuncts(Head,B1,BN1), From e617f38e907be1889bf2a4e74a107c614dcb88a9 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Fri, 30 Aug 2024 06:09:04 -0700 Subject: [PATCH 69/77] once_writeq_nl --- .Attic/metta_lang/metta_interp.pl | 10 +++++----- .Attic/metta_lang/metta_loader.pl | 2 -- .Attic/metta_lang/metta_pfc_base.pl | 2 +- .Attic/metta_lang/metta_printer.pl | 10 +++++++--- .Attic/metta_lang/metta_space.pl | 22 +++++++++++++++++++++- 5 files changed, 34 insertions(+), 12 deletions(-) diff --git a/.Attic/metta_lang/metta_interp.pl b/.Attic/metta_lang/metta_interp.pl index aa087700ebc..55af8a4433f 100755 --- a/.Attic/metta_lang/metta_interp.pl +++ b/.Attic/metta_lang/metta_interp.pl @@ -129,15 +129,15 @@ :-dynamic(user:loaded_into_kb/2). :- dynamic(user:is_metta_dir/1). -once_writeq_ln(_):- \+ clause(pfcTraceExecution,true),!. -once_writeq_ln(P):- nb_current('$once_writeq_ln',W),W=@=P,!. -once_writeq_ln(P):- +once_writeq_nl(_):- \+ clause(pfcTraceExecution,true),!. +once_writeq_nl(P):- nb_current('$once_writeq_ln',W),W=@=P,!. +once_writeq_nl(P):- \+ \+ (numbervars(P,444,_,[attvar(skip),singletons(true)]), ansi_format([fg(cyan)],'~N~q.~n',[P])),nb_setval('$once_writeq_ln',P),!. % TODO uncomment this next line but it is breaking the curried chainer % pfcAdd_Now(P):- pfcAdd(P),!. -pfcAdd_Now(P):- current_predicate(pfcAdd/1),!, once_writeq_ln(pfcAdd(P)),pfcAdd(P). -pfcAdd_Now(P):- once_writeq_ln(asssert(P)),assert(P). +pfcAdd_Now(P):- current_predicate(pfcAdd/1),!, once_writeq_nl(pfcAdd(P)),pfcAdd(P). +pfcAdd_Now(P):- once_writeq_nl(asssert(P)),assert(P). %:- endif. system:copy_term_g(I,O):- ground(I),!,I=O. diff --git a/.Attic/metta_lang/metta_loader.pl b/.Attic/metta_lang/metta_loader.pl index 5f2a0b50767..dec81a69e0f 100755 --- a/.Attic/metta_lang/metta_loader.pl +++ b/.Attic/metta_lang/metta_loader.pl @@ -461,8 +461,6 @@ format(user_error,'~N; Done translating ~w forms: ~q.', [TF,asserted_metta_pred(MangleP2,Filename)]))). -write_src_woi(Term):- with_indents(false,write_src(Term)). - % write comments write_metta_datalog_term(Output,'$COMMENT'(Term,_,_),_MangleP2,_Lineno):- format(Output,"/* ~w */~n",[Term]). diff --git a/.Attic/metta_lang/metta_pfc_base.pl b/.Attic/metta_lang/metta_pfc_base.pl index aad619a51fe..14c8ccda24e 100755 --- a/.Attic/metta_lang/metta_pfc_base.pl +++ b/.Attic/metta_lang/metta_pfc_base.pl @@ -1278,7 +1278,7 @@ pfc_eval_rhs1(Assertion,Support) :- % an assertion to be added. - once_writeq_ln(pfcRHS(Assertion)), + once_writeq_nl(pfcRHS(Assertion)), (must_ex(pfcPost1(Assertion,Support))*->true ; pfcWarn("Malformed rhs of a rule: ~p",[Assertion])). diff --git a/.Attic/metta_lang/metta_printer.pl b/.Attic/metta_lang/metta_printer.pl index 74979ba1e02..bcd3060da41 100755 --- a/.Attic/metta_lang/metta_printer.pl +++ b/.Attic/metta_lang/metta_printer.pl @@ -145,9 +145,13 @@ py_is_enabled:- predicate_property(py_ppp(_),defined), asserta((py_is_enabled:-!)). %write_src(V):- !, \+ \+ quietly(pp_sex(V)),!. -write_src(V):- \+ \+ notrace(pp_sex(V)),!. -write_src_woi_ln(X):- - format('~N'),write_src_woi(X),format('~N'). +write_src(V):- \+ \+ notrace(( + guess_metta_vars(V),pp_sex(V))),!. +write_src_woi(Term):- + notrace((with_indents(false,write_src(Term)))). +write_src_woi_nl(X):- \+ \+ + notrace((guess_metta_vars(X), + format('~N'),write_src_woi(X),format('~N'))). pp_sex(V):- pp_sexi(V),!. diff --git a/.Attic/metta_lang/metta_space.pl b/.Attic/metta_lang/metta_space.pl index fc96c1a295b..73b66412c21 100755 --- a/.Attic/metta_lang/metta_space.pl +++ b/.Attic/metta_lang/metta_space.pl @@ -553,7 +553,7 @@ has_type(S,Type):- sub_atom(S,0,4,Aft,FB),flybase_identifier(FB,Type),!,Aft>0. -call_sexpr(S):- once_writeq_ln(call_sexpr(S)). +call_sexpr(S):- once_writeq_nl(call_sexpr(S)). %call_sexpr(Space,Expr,Result):- :- dynamic(fb_pred/2). @@ -666,4 +666,24 @@ symbolic_list_concat(A,B):- atomic_list_concat(A,B). symbol_contains(T,TT):- atom_contains(T,TT). */ +search_for1(X):- + forall((metta_atom(_Where,What),contains_var(X,What)), + write_src_nl(What)). +search_for2(X):- + forall((metta_src(_Where,What),contains_var(X,What)), + write_src_woi_nl(What)). + + +metta_src(Where,What):- + loaded_into_kb(Where,File), metta_file_buffer(_,What,Vars,File,_Loc), + ignore(maplist(name_the_var,Vars)). + + +name_the_var(N=V):- ignore((atom_concat('_',NV,N),V='$VAR'(NV))). +guess_metta_vars(What):- + ignore(once((metta_file_buffer(_,What0,Vars,_File,_Loc), + alpha_unif(What,What0), + maplist(name_the_var,Vars)))). + +alpha_unif(What,What0):- What=@=What0,What=What0. From 746c1a2a304dd765233567eab650501dd8f069c1 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Fri, 30 Aug 2024 06:36:03 -0700 Subject: [PATCH 70/77] nb_setval(self_space,MSpace) --- .Attic/canary_docme/metta_server.pl | 10 +++++++--- .Attic/metta_lang/metta_space.pl | 15 ++++++++------- 2 files changed, 15 insertions(+), 10 deletions(-) diff --git a/.Attic/canary_docme/metta_server.pl b/.Attic/canary_docme/metta_server.pl index bfa1233315b..9dc100ae641 100644 --- a/.Attic/canary_docme/metta_server.pl +++ b/.Attic/canary_docme/metta_server.pl @@ -55,7 +55,7 @@ :- use_module(library(thread)). % Provides predicates for multi-threading % Predicate to execute a goal and determine if it was deterministic -%! call_wdet(+Goal, -WasDet) is semidet. +%! call_wdet(+Goal, -WasDet) is nondet. % % Calls the given Goal and checks if it was deterministic. % @@ -125,12 +125,14 @@ % Start the VSpace service with the generated Alias, MSpace, and Port start_vspace_service(Alias,MSpace,Port). -% Skip starting the service if it is already running -%! start_vspace_service(+Alias, +_Space, +_Port) is det. +%! start_vspace_service(+Alias, +Space, +Port) is det. % % Starts the VSpace service only if it is not already running under the given Alias. % % @arg Alias is the alias to check for an existing service. + + +% Skip starting the service if it is already running start_vspace_service(Alias,_Space,_Port):- % If the service is already running under Alias, do nothing service_running(Alias), @@ -219,6 +221,8 @@ setup_call_cleanup( % Open the socket as a stream tcp_open_socket(RemoteFd, Stream), + % Generate a unique symbol for the thread alias + nb_setval(self_space,MSpace), % Handle the connection by processing incoming goals ignore(handle_vspace_peer(Stream)), % Ensure the stream is closed when done diff --git a/.Attic/metta_lang/metta_space.pl b/.Attic/metta_lang/metta_space.pl index 73b66412c21..a8a02d48c9a 100755 --- a/.Attic/metta_lang/metta_space.pl +++ b/.Attic/metta_lang/metta_space.pl @@ -668,22 +668,23 @@ */ search_for1(X):- forall((metta_atom(_Where,What),contains_var(X,What)), - write_src_nl(What)). + (nl,write_src_nl(What))). search_for2(X):- - forall((metta_src(_Where,What),contains_var(X,What)), - write_src_woi_nl(What)). + forall((metta_file_src(_Where,What),contains_var(X,What)), + (nl,write_src_nl(What))). -metta_src(Where,What):- +metta_file_src(Where,What):- loaded_into_kb(Where,File), metta_file_buffer(_,What,Vars,File,_Loc), ignore(maplist(name_the_var,Vars)). -name_the_var(N=V):- ignore((atom_concat('_',NV,N),V='$VAR'(NV))). guess_metta_vars(What):- ignore(once((metta_file_buffer(_,What0,Vars,_File,_Loc), - alpha_unif(What,What0), + alpha_unify(What,What0), maplist(name_the_var,Vars)))). +name_the_var(N=V):- ignore((atom_concat('_',NV,N),V='$VAR'(NV))). + +alpha_unify(What,What0):- What=@=What0,(nonvar(What)->What=What0;What==What0). -alpha_unif(What,What0):- What=@=What0,What=What0. From f7ca17c1630642e885097e761f5668c8f5e90e32 Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 30 Aug 2024 11:46:44 -0500 Subject: [PATCH 71/77] include actual times in junit.xml --- scripts/into_junit.py | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/scripts/into_junit.py b/scripts/into_junit.py index a45466ba2fd..ca54182317c 100644 --- a/scripts/into_junit.py +++ b/scripts/into_junit.py @@ -37,6 +37,7 @@ def parse_test_line(line): stdout = parts[4].strip() # The fifth field contains the assertion got = parts[5].strip() # The sixth field contains the actual result expected = parts[6].strip() # The seventh field contains the expected result + time = parts[7].strip() # The eighth field contains how long it took to run the test try: # Split the identifier into the package, class, and test names @@ -45,8 +46,6 @@ def parse_test_line(line): raise ValueError("Test package or test name is empty after splitting.") except ValueError as e: raise ValueError(f"Identifier does not contain the expected format: {full_identifier}. Error: {str(e)}") - - time = '.01' # bogus time until tests actually note their runtime return testpackage, testname, stdout, full_identifier, got, expected, status, url, time From cf39c58ec65e71e0e8580daa775d7e2817eec76d Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 30 Aug 2024 12:12:02 -0500 Subject: [PATCH 72/77] include run number in pages URL --- .github/workflows/ci.yml | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index a8bffaedc70..2acb9da3155 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -176,9 +176,12 @@ jobs: environment: # environment created automatically by GitHub name: github-pages - url: ${{ steps.deployment.outputs.page_url }} + url: ${{ steps.change-page-url.outputs.new_page_url }} steps: - name: Deploy to GitHub Pages id: deployment - uses: actions/deploy-pages@v4 \ No newline at end of file + uses: actions/deploy-pages@v4 + - name: Override page_url + id: change-page-url + run: echo "new_page_url=${{ steps.deployment.outputs.page_url }}${{ github.run_number }}/" >> $GITHUB_OUTPUT \ No newline at end of file From 31a889a2fd4da23effad48d05facef3d52355165 Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 30 Aug 2024 12:32:25 -0500 Subject: [PATCH 73/77] Revert "include run number in pages URL" This reverts commit 788a7ad2ba8f3d03ebc050c29c5d318f15a0836c. --- .github/workflows/ci.yml | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 2acb9da3155..a8bffaedc70 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -176,12 +176,9 @@ jobs: environment: # environment created automatically by GitHub name: github-pages - url: ${{ steps.change-page-url.outputs.new_page_url }} + url: ${{ steps.deployment.outputs.page_url }} steps: - name: Deploy to GitHub Pages id: deployment - uses: actions/deploy-pages@v4 - - name: Override page_url - id: change-page-url - run: echo "new_page_url=${{ steps.deployment.outputs.page_url }}${{ github.run_number }}/" >> $GITHUB_OUTPUT \ No newline at end of file + uses: actions/deploy-pages@v4 \ No newline at end of file From e4ef6ab2ba835882cc1ab25f2edbd749a9432e9f Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 30 Aug 2024 12:49:42 -0500 Subject: [PATCH 74/77] remove previous junit handling --- .github/workflows/ci.yml | 25 ------------------------- 1 file changed, 25 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index a8bffaedc70..987430618b9 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -97,28 +97,6 @@ jobs: reporter: 'java-junit' fail-on-error: false - - name: Download Previous JUnit Results - continue-on-error: true - uses: actions/download-artifact@v4 - with: - name: junit-report - path: previous-junit.xml - - - name: Install ReportGenerator - run: | - dotnet tool install -g dotnet-reportgenerator-globaltool - - - name: Compare JUnit Test Results with ReportGenerator - run: | - reportgenerator -reports:"previous-junit.xml;junit.xml" -targetdir:"./comparison-report" -reporttypes:"HtmlSummary;HtmlChart" - - - name: Upload JUnit Comparison Report - continue-on-error: true - uses: actions/upload-artifact@v4 - with: - name: junit-comparison-html-report - path: ./comparison-report - - name: Install Allure run: | curl -sLo allure-2.17.2.tgz https://github.com/allure-framework/allure2/releases/download/2.17.2/allure-2.17.2.tgz @@ -130,9 +108,6 @@ jobs: run: | mkdir -p ./allure-results cp junit.xml ./allure-results/ - if [ -f "previous-junit.xml" ]; then - cp previous-junit.xml ./allure-results/ - fi python scripts/generate_allure_environment.py ${{ github.sha }} ${{ github.ref_name }} > ./allure-results/environment.properties python scripts/generate_allure_executor.py ${{ github.server_url }} ${{ github.repository }} ${{ github.run_id }} > ./allure-results/executor.json From b32e9438ea39eef91d72281b4d4d04c46eba42b6 Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 30 Aug 2024 13:52:59 -0500 Subject: [PATCH 75/77] try using allure-report-action approach --- .github/workflows/ci.yml | 80 +++++++++++++++------------------------- 1 file changed, 30 insertions(+), 50 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 987430618b9..a2bbb3f4112 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -97,63 +97,43 @@ jobs: reporter: 'java-junit' fail-on-error: false - - name: Install Allure - run: | - curl -sLo allure-2.17.2.tgz https://github.com/allure-framework/allure2/releases/download/2.17.2/allure-2.17.2.tgz - tar -zxvf allure-2.17.2.tgz - sudo mv allure-2.17.2 /opt/allure - sudo ln -s /opt/allure/bin/allure /usr/bin/allure - - - name: Prepare Allure Results Directory + - name: Provide Report Links run: | - mkdir -p ./allure-results - cp junit.xml ./allure-results/ - python scripts/generate_allure_environment.py ${{ github.sha }} ${{ github.ref_name }} > ./allure-results/environment.properties - python scripts/generate_allure_executor.py ${{ github.server_url }} ${{ github.repository }} ${{ github.run_id }} > ./allure-results/executor.json + echo "JUnit reports are available as artifacts." - - name: Generate Allure Report - run: | - allure generate --clean --output ./allure-report ./allure-results + - name: Get Allure history + uses: actions/checkout@v4 + with: + ref: test-results + path: test-results - - name: Upload Allure Report as Artifact - continue-on-error: true - uses: actions/upload-artifact@v4 + - name: Download JUnit XML Results + uses: actions/download-artifact@v4 with: - name: allure-html-report - path: ./allure-report + name: junit-report + path: build/allure-results - - name: Provide Report Links - run: | - echo "JUnit reports, Allure report, and test comparison reports are available as artifacts." + - name: Generate Allure Report + uses: simple-elf/allure-report-action@master + if: always() + id: allure-report + with: + allure_results: build/allure-results + gh_pages: test-results + allure_report: allure-report + allure_history: allure-history + keep_reports: 20 + + - name: Deploy report to Github Pages + if: always() + uses: peaceiris/actions-gh-pages@v3 + env: + PERSONAL_TOKEN: ${{ secrets.GITHUB_TOKEN }} + PUBLISH_BRANCH: test-results + PUBLISH_DIR: allure-history - name: Auto-Approve the Pull Request if: github.event_name == 'pull_request_target' uses: hmarr/auto-approve-action@v4 with: - github-token: ${{ secrets.GITHUB_TOKEN }} - - - name: Setup Pages - uses: actions/configure-pages@v4 - - - name: Upload Allure Report as Pages Artifact - uses: actions/upload-pages-artifact@v3 - with: - path: ./allure-report - - deploy-allure-report: - runs-on: ubuntu-latest - needs: generate-reports - - permissions: - pages: write # Allow deployment to GitHub Pages - id-token: write - - environment: - # environment created automatically by GitHub - name: github-pages - url: ${{ steps.deployment.outputs.page_url }} - - steps: - - name: Deploy to GitHub Pages - id: deployment - uses: actions/deploy-pages@v4 \ No newline at end of file + github-token: ${{ secrets.GITHUB_TOKEN }} \ No newline at end of file From 09904b10b9485588c2b0d29970a9f828ef2a0546 Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 30 Aug 2024 13:59:54 -0500 Subject: [PATCH 76/77] update action version and tokens --- .github/workflows/ci.yml | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index a2bbb3f4112..63925c4c669 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -126,11 +126,12 @@ jobs: - name: Deploy report to Github Pages if: always() - uses: peaceiris/actions-gh-pages@v3 - env: - PERSONAL_TOKEN: ${{ secrets.GITHUB_TOKEN }} - PUBLISH_BRANCH: test-results - PUBLISH_DIR: allure-history + uses: peaceiris/actions-gh-pages@v4 + with: + github_token: ${{ secrets.GITHUB_TOKEN }} + personal_token: ${{ secrets.GITHUB_TOKEN }} + publish_branch: test-results + publish_dir: allure-history - name: Auto-Approve the Pull Request if: github.event_name == 'pull_request_target' From 4e9356f82d012d475ac17a17beb6160ac54529a6 Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Fri, 30 Aug 2024 14:20:01 -0500 Subject: [PATCH 77/77] include environment properties --- .github/workflows/ci.yml | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 63925c4c669..ca4b4c7fb48 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -101,6 +101,16 @@ jobs: run: | echo "JUnit reports are available as artifacts." + - name: Generate environment.properties + run: | + python scripts/generate_allure_environment.py ${{ github.sha }} ${{ github.ref_name }} > environment.properties + + - name: Upload environment.properties + uses: actions/upload-artifact@v4 + with: + name: environment + path: environment.properties + - name: Get Allure history uses: actions/checkout@v4 with: @@ -113,6 +123,12 @@ jobs: name: junit-report path: build/allure-results + - name: Include environment properties + uses: actions/download-artifact@v4 + with: + name: environment + path: build/allure-results + - name: Generate Allure Report uses: simple-elf/allure-report-action@master if: always()