diff --git a/dist/bin/index.js b/dist/bin/index.js index 7ee521bb..cd49df8d 100755 --- a/dist/bin/index.js +++ b/dist/bin/index.js @@ -13,7 +13,7 @@ async function mainFunc() { let args = process.argv.slice(2); const fn = process.argv.includes('--image-only') ? generateImageFile : generateLoadedImageFile; - args = args.filter(elem => elem !== '--image-only'); + args = args.filter(elem => elem !== '--image-only' && !elem.startsWith('--copy-dir')); if (args.length !== 2) { throw new Error('Expected exactly 2 inputs, input prolog (.pl) file and output file'); diff --git a/dist/generateImage.ts b/dist/generateImage.ts index 550c6e20..b7befe41 100644 --- a/dist/generateImage.ts +++ b/dist/generateImage.ts @@ -3,6 +3,7 @@ import SWIPL from './swipl/swipl-bundle'; import fs from 'fs'; import { fetch } from '@inrupt/universal-fetch'; +import { readFileSync } from 'fs-extra'; function Uint8ToString(u8a: Uint8Array) { const CHUNK_SZ = 0x8000; @@ -14,12 +15,21 @@ function Uint8ToString(u8a: Uint8Array) { return c.join(''); } -export async function generateImageBuffer(prolog: string | Buffer): Promise { +interface Options { + name?: string; + copyDir?: string; +} + +export async function generateImageBuffer(prolog: string | Buffer, options?: Options): Promise { const Module = await SWIPL({ - arguments: ['-q', '-f', 'prolog.pl'], + arguments: ['-q', '-f', options?.name ?? 'prolog.pl'], // eslint-disable-next-line @typescript-eslint/ban-ts-comment // @ts-ignore - preRun: [(module: SWIPLModule) => { module.FS.writeFile('prolog.pl', prolog) }], + preRun: [(module: SWIPLModule) => { + module.FS. + + module.FS.writeFile(options?.name ?? 'prolog.pl', prolog) + }], }); Module.prolog.query("qsave_program('prolog.pvm')").once(); diff --git a/examples/generation/package.json b/examples/generation/package.json index 3ac2f138..a7351534 100644 --- a/examples/generation/package.json +++ b/examples/generation/package.json @@ -10,7 +10,7 @@ }, "keywords": [], "author": "", - "license": "ISC", + "license": "MIT", "dependencies": { "swipl-wasm": "file:../.." }, diff --git a/examples/multi-file-generation/.gitignore b/examples/multi-file-generation/.gitignore new file mode 100644 index 00000000..f651338d --- /dev/null +++ b/examples/multi-file-generation/.gitignore @@ -0,0 +1 @@ +dist/max.ts diff --git a/examples/multi-file-generation/dist/main.ts b/examples/multi-file-generation/dist/main.ts new file mode 100644 index 00000000..85a90131 --- /dev/null +++ b/examples/multi-file-generation/dist/main.ts @@ -0,0 +1,11 @@ +import SWIPL from './max'; + +async function main() { + const Module = await SWIPL(); + const res = Module.prolog.query('myMax(A, B, C).', { A: 1, B: 2 }); + if ((res.once() as { C: number }).C !== 2) { + throw new Error('Failed to find max') + } +} + +main(); diff --git a/examples/multi-file-generation/package-lock.json b/examples/multi-file-generation/package-lock.json new file mode 100644 index 00000000..08b3aa46 --- /dev/null +++ b/examples/multi-file-generation/package-lock.json @@ -0,0 +1,408 @@ +{ + "name": "generation", + "version": "1.0.0", + "lockfileVersion": 2, + "requires": true, + "packages": { + "": { + "name": "generation", + "version": "1.0.0", + "license": "ISC", + "dependencies": { + "swipl-wasm": "file:../.." + }, + "devDependencies": { + "ts-node": "^10.9.1" + } + }, + "../..": { + "version": "3.1.0", + "license": "BSD-2-Clause", + "bin": { + "swipl-generate": "dist/bin/index.js" + }, + "devDependencies": { + "@octokit/rest": "^19.0.7", + "@qiwi/semantic-release-gh-pages-plugin": "^5.2.5", + "@types/emscripten": "^1.39.6", + "@types/fs-extra": "^11.0.1", + "@types/node": "^20.0.0", + "@typescript-eslint/eslint-plugin": "^5.59.2", + "@typescript-eslint/parser": "^5.59.2", + "cross-fetch": "^3.1.5", + "eslint": "^8.39.0", + "fs-extra": "^11.1.1", + "http-server": "^14.1.1", + "mocha": "^10.2.0", + "node-static": "^0.7.11", + "npm-run-all": "^4.1.5", + "puppeteer": "^20.1.1", + "semantic-release": "^19.0.5", + "ts-node": "^10.9.1", + "typescript": "^5.0.4", + "webpack": "^5.82.0", + "webpack-cli": "^5.0.2" + }, + "peerDependencies": { + "@types/emscripten": "^1.39.6" + } + }, + "node_modules/@cspotcode/source-map-support": { + "version": "0.8.1", + "resolved": "https://registry.npmjs.org/@cspotcode/source-map-support/-/source-map-support-0.8.1.tgz", + "integrity": "sha512-IchNf6dN4tHoMFIn/7OE8LWZ19Y6q/67Bmf6vnGREv8RSbBVb9LPJxEcnwrcwX6ixSvaiGoomAUvu4YSxXrVgw==", + "dev": true, + "dependencies": { + "@jridgewell/trace-mapping": "0.3.9" + }, + "engines": { + "node": ">=12" + } + }, + "node_modules/@jridgewell/resolve-uri": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/@jridgewell/resolve-uri/-/resolve-uri-3.1.0.tgz", + "integrity": "sha512-F2msla3tad+Mfht5cJq7LSXcdudKTWCVYUgw6pLFOOHSTtZlj6SWNYAp+AhuqLmWdBO2X5hPrLcu8cVP8fy28w==", + "dev": true, + "engines": { + "node": ">=6.0.0" + } + }, + "node_modules/@jridgewell/sourcemap-codec": { + "version": "1.4.14", + "resolved": "https://registry.npmjs.org/@jridgewell/sourcemap-codec/-/sourcemap-codec-1.4.14.tgz", + "integrity": "sha512-XPSJHWmi394fuUuzDnGz1wiKqWfo1yXecHQMRf2l6hztTO+nPru658AyDngaBe7isIxEkRsPR3FZh+s7iVa4Uw==", + "dev": true + }, + "node_modules/@jridgewell/trace-mapping": { + "version": "0.3.9", + "resolved": "https://registry.npmjs.org/@jridgewell/trace-mapping/-/trace-mapping-0.3.9.tgz", + "integrity": "sha512-3Belt6tdc8bPgAtbcmdtNJlirVoTmEb5e2gC94PnkwEW9jI6CAHUeoG85tjWP5WquqfavoMtMwiG4P926ZKKuQ==", + "dev": true, + "dependencies": { + "@jridgewell/resolve-uri": "^3.0.3", + "@jridgewell/sourcemap-codec": "^1.4.10" + } + }, + "node_modules/@tsconfig/node10": { + "version": "1.0.9", + "resolved": "https://registry.npmjs.org/@tsconfig/node10/-/node10-1.0.9.tgz", + "integrity": "sha512-jNsYVVxU8v5g43Erja32laIDHXeoNvFEpX33OK4d6hljo3jDhCBDhx5dhCCTMWUojscpAagGiRkBKxpdl9fxqA==", + "dev": true + }, + "node_modules/@tsconfig/node12": { + "version": "1.0.11", + "resolved": "https://registry.npmjs.org/@tsconfig/node12/-/node12-1.0.11.tgz", + "integrity": "sha512-cqefuRsh12pWyGsIoBKJA9luFu3mRxCA+ORZvA4ktLSzIuCUtWVxGIuXigEwO5/ywWFMZ2QEGKWvkZG1zDMTag==", + "dev": true + }, + "node_modules/@tsconfig/node14": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/@tsconfig/node14/-/node14-1.0.3.tgz", + "integrity": "sha512-ysT8mhdixWK6Hw3i1V2AeRqZ5WfXg1G43mqoYlM2nc6388Fq5jcXyr5mRsqViLx/GJYdoL0bfXD8nmF+Zn/Iow==", + "dev": true + }, + "node_modules/@tsconfig/node16": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/@tsconfig/node16/-/node16-1.0.3.tgz", + "integrity": "sha512-yOlFc+7UtL/89t2ZhjPvvB/DeAr3r+Dq58IgzsFkOAvVC6NMJXmCGjbptdXdR9qsX7pKcTL+s87FtYREi2dEEQ==", + "dev": true + }, + "node_modules/@types/node": { + "version": "18.14.0", + "resolved": "https://registry.npmjs.org/@types/node/-/node-18.14.0.tgz", + "integrity": "sha512-5EWrvLmglK+imbCJY0+INViFWUHg1AHel1sq4ZVSfdcNqGy9Edv3UB9IIzzg+xPaUcAgZYcfVs2fBcwDeZzU0A==", + "dev": true, + "peer": true + }, + "node_modules/acorn": { + "version": "8.8.2", + "resolved": "https://registry.npmjs.org/acorn/-/acorn-8.8.2.tgz", + "integrity": "sha512-xjIYgE8HBrkpd/sJqOGNspf8uHG+NOHGOw6a/Urj8taM2EXfdNAH2oFcPeIFfsv3+kz/mJrS5VuMqbNLjCa2vw==", + "dev": true, + "bin": { + "acorn": "bin/acorn" + }, + "engines": { + "node": ">=0.4.0" + } + }, + "node_modules/acorn-walk": { + "version": "8.2.0", + "resolved": "https://registry.npmjs.org/acorn-walk/-/acorn-walk-8.2.0.tgz", + "integrity": "sha512-k+iyHEuPgSw6SbuDpGQM+06HQUa04DZ3o+F6CSzXMvvI5KMvnaEqXe+YVe555R9nn6GPt404fos4wcgpw12SDA==", + "dev": true, + "engines": { + "node": ">=0.4.0" + } + }, + "node_modules/arg": { + "version": "4.1.3", + "resolved": "https://registry.npmjs.org/arg/-/arg-4.1.3.tgz", + "integrity": "sha512-58S9QDqG0Xx27YwPSt9fJxivjYl432YCwfDMfZ+71RAqUrZef7LrKQZ3LHLOwCS4FLNBplP533Zx895SeOCHvA==", + "dev": true + }, + "node_modules/create-require": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/create-require/-/create-require-1.1.1.tgz", + "integrity": "sha512-dcKFX3jn0MpIaXjisoRvexIJVEKzaq7z2rZKxf+MSr9TkdmHmsU4m2lcLojrj/FHl8mk5VxMmYA+ftRkP/3oKQ==", + "dev": true + }, + "node_modules/diff": { + "version": "4.0.2", + "resolved": "https://registry.npmjs.org/diff/-/diff-4.0.2.tgz", + "integrity": "sha512-58lmxKSA4BNyLz+HHMUzlOEpg09FV+ev6ZMe3vJihgdxzgcwZ8VoEEPmALCZG9LmqfVoNMMKpttIYTVG6uDY7A==", + "dev": true, + "engines": { + "node": ">=0.3.1" + } + }, + "node_modules/make-error": { + "version": "1.3.6", + "resolved": "https://registry.npmjs.org/make-error/-/make-error-1.3.6.tgz", + "integrity": "sha512-s8UhlNe7vPKomQhC1qFelMokr/Sc3AgNbso3n74mVPA5LTZwkB9NlXf4XPamLxJE8h0gh73rM94xvwRT2CVInw==", + "dev": true + }, + "node_modules/swipl-wasm": { + "resolved": "../..", + "link": true + }, + "node_modules/ts-node": { + "version": "10.9.1", + "resolved": "https://registry.npmjs.org/ts-node/-/ts-node-10.9.1.tgz", + "integrity": "sha512-NtVysVPkxxrwFGUUxGYhfux8k78pQB3JqYBXlLRZgdGUqTO5wU/UyHop5p70iEbGhB7q5KmiZiU0Y3KlJrScEw==", + "dev": true, + "dependencies": { + "@cspotcode/source-map-support": "^0.8.0", + "@tsconfig/node10": "^1.0.7", + "@tsconfig/node12": "^1.0.7", + "@tsconfig/node14": "^1.0.0", + "@tsconfig/node16": "^1.0.2", + "acorn": "^8.4.1", + "acorn-walk": "^8.1.1", + "arg": "^4.1.0", + "create-require": "^1.1.0", + "diff": "^4.0.1", + "make-error": "^1.1.1", + "v8-compile-cache-lib": "^3.0.1", + "yn": "3.1.1" + }, + "bin": { + "ts-node": "dist/bin.js", + "ts-node-cwd": "dist/bin-cwd.js", + "ts-node-esm": "dist/bin-esm.js", + "ts-node-script": "dist/bin-script.js", + "ts-node-transpile-only": "dist/bin-transpile.js", + "ts-script": "dist/bin-script-deprecated.js" + }, + "peerDependencies": { + "@swc/core": ">=1.2.50", + "@swc/wasm": ">=1.2.50", + "@types/node": "*", + "typescript": ">=2.7" + }, + "peerDependenciesMeta": { + "@swc/core": { + "optional": true + }, + "@swc/wasm": { + "optional": true + } + } + }, + "node_modules/typescript": { + "version": "4.9.5", + "resolved": "https://registry.npmjs.org/typescript/-/typescript-4.9.5.tgz", + "integrity": "sha512-1FXk9E2Hm+QzZQ7z+McJiHL4NW1F2EzMu9Nq9i3zAaGqibafqYwCVU6WyWAuyQRRzOlxou8xZSyXLEN8oKj24g==", + "dev": true, + "peer": true, + "bin": { + "tsc": "bin/tsc", + "tsserver": "bin/tsserver" + }, + "engines": { + "node": ">=4.2.0" + } + }, + "node_modules/v8-compile-cache-lib": { + "version": "3.0.1", + "resolved": "https://registry.npmjs.org/v8-compile-cache-lib/-/v8-compile-cache-lib-3.0.1.tgz", + "integrity": "sha512-wa7YjyUGfNZngI/vtK0UHAN+lgDCxBPCylVXGp0zu59Fz5aiGtNXaq3DhIov063MorB+VfufLh3JlF2KdTK3xg==", + "dev": true + }, + "node_modules/yn": { + "version": "3.1.1", + "resolved": "https://registry.npmjs.org/yn/-/yn-3.1.1.tgz", + "integrity": "sha512-Ux4ygGWsu2c7isFWe8Yu1YluJmqVhxqK2cLXNQA5AcC3QfbGNpM7fu0Y8b/z16pXLnFxZYvWhd3fhBY9DLmC6Q==", + "dev": true, + "engines": { + "node": ">=6" + } + } + }, + "dependencies": { + "@cspotcode/source-map-support": { + "version": "0.8.1", + "resolved": "https://registry.npmjs.org/@cspotcode/source-map-support/-/source-map-support-0.8.1.tgz", + "integrity": "sha512-IchNf6dN4tHoMFIn/7OE8LWZ19Y6q/67Bmf6vnGREv8RSbBVb9LPJxEcnwrcwX6ixSvaiGoomAUvu4YSxXrVgw==", + "dev": true, + "requires": { + "@jridgewell/trace-mapping": "0.3.9" + } + }, + "@jridgewell/resolve-uri": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/@jridgewell/resolve-uri/-/resolve-uri-3.1.0.tgz", + "integrity": "sha512-F2msla3tad+Mfht5cJq7LSXcdudKTWCVYUgw6pLFOOHSTtZlj6SWNYAp+AhuqLmWdBO2X5hPrLcu8cVP8fy28w==", + "dev": true + }, + "@jridgewell/sourcemap-codec": { + "version": "1.4.14", + "resolved": "https://registry.npmjs.org/@jridgewell/sourcemap-codec/-/sourcemap-codec-1.4.14.tgz", + "integrity": "sha512-XPSJHWmi394fuUuzDnGz1wiKqWfo1yXecHQMRf2l6hztTO+nPru658AyDngaBe7isIxEkRsPR3FZh+s7iVa4Uw==", + "dev": true + }, + "@jridgewell/trace-mapping": { + "version": "0.3.9", + "resolved": "https://registry.npmjs.org/@jridgewell/trace-mapping/-/trace-mapping-0.3.9.tgz", + "integrity": "sha512-3Belt6tdc8bPgAtbcmdtNJlirVoTmEb5e2gC94PnkwEW9jI6CAHUeoG85tjWP5WquqfavoMtMwiG4P926ZKKuQ==", + "dev": true, + "requires": { + "@jridgewell/resolve-uri": "^3.0.3", + "@jridgewell/sourcemap-codec": "^1.4.10" + } + }, + "@tsconfig/node10": { + "version": "1.0.9", + "resolved": "https://registry.npmjs.org/@tsconfig/node10/-/node10-1.0.9.tgz", + "integrity": "sha512-jNsYVVxU8v5g43Erja32laIDHXeoNvFEpX33OK4d6hljo3jDhCBDhx5dhCCTMWUojscpAagGiRkBKxpdl9fxqA==", + "dev": true + }, + "@tsconfig/node12": { + "version": "1.0.11", + "resolved": "https://registry.npmjs.org/@tsconfig/node12/-/node12-1.0.11.tgz", + "integrity": "sha512-cqefuRsh12pWyGsIoBKJA9luFu3mRxCA+ORZvA4ktLSzIuCUtWVxGIuXigEwO5/ywWFMZ2QEGKWvkZG1zDMTag==", + "dev": true + }, + "@tsconfig/node14": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/@tsconfig/node14/-/node14-1.0.3.tgz", + "integrity": "sha512-ysT8mhdixWK6Hw3i1V2AeRqZ5WfXg1G43mqoYlM2nc6388Fq5jcXyr5mRsqViLx/GJYdoL0bfXD8nmF+Zn/Iow==", + "dev": true + }, + "@tsconfig/node16": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/@tsconfig/node16/-/node16-1.0.3.tgz", + "integrity": "sha512-yOlFc+7UtL/89t2ZhjPvvB/DeAr3r+Dq58IgzsFkOAvVC6NMJXmCGjbptdXdR9qsX7pKcTL+s87FtYREi2dEEQ==", + "dev": true + }, + "@types/node": { + "version": "18.14.0", + "resolved": "https://registry.npmjs.org/@types/node/-/node-18.14.0.tgz", + "integrity": "sha512-5EWrvLmglK+imbCJY0+INViFWUHg1AHel1sq4ZVSfdcNqGy9Edv3UB9IIzzg+xPaUcAgZYcfVs2fBcwDeZzU0A==", + "dev": true, + "peer": true + }, + "acorn": { + "version": "8.8.2", + "resolved": "https://registry.npmjs.org/acorn/-/acorn-8.8.2.tgz", + "integrity": "sha512-xjIYgE8HBrkpd/sJqOGNspf8uHG+NOHGOw6a/Urj8taM2EXfdNAH2oFcPeIFfsv3+kz/mJrS5VuMqbNLjCa2vw==", + "dev": true + }, + "acorn-walk": { + "version": "8.2.0", + "resolved": "https://registry.npmjs.org/acorn-walk/-/acorn-walk-8.2.0.tgz", + "integrity": "sha512-k+iyHEuPgSw6SbuDpGQM+06HQUa04DZ3o+F6CSzXMvvI5KMvnaEqXe+YVe555R9nn6GPt404fos4wcgpw12SDA==", + "dev": true + }, + "arg": { + "version": "4.1.3", + "resolved": "https://registry.npmjs.org/arg/-/arg-4.1.3.tgz", + "integrity": "sha512-58S9QDqG0Xx27YwPSt9fJxivjYl432YCwfDMfZ+71RAqUrZef7LrKQZ3LHLOwCS4FLNBplP533Zx895SeOCHvA==", + "dev": true + }, + "create-require": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/create-require/-/create-require-1.1.1.tgz", + "integrity": "sha512-dcKFX3jn0MpIaXjisoRvexIJVEKzaq7z2rZKxf+MSr9TkdmHmsU4m2lcLojrj/FHl8mk5VxMmYA+ftRkP/3oKQ==", + "dev": true + }, + "diff": { + "version": "4.0.2", + "resolved": "https://registry.npmjs.org/diff/-/diff-4.0.2.tgz", + "integrity": "sha512-58lmxKSA4BNyLz+HHMUzlOEpg09FV+ev6ZMe3vJihgdxzgcwZ8VoEEPmALCZG9LmqfVoNMMKpttIYTVG6uDY7A==", + "dev": true + }, + "make-error": { + "version": "1.3.6", + "resolved": "https://registry.npmjs.org/make-error/-/make-error-1.3.6.tgz", + "integrity": "sha512-s8UhlNe7vPKomQhC1qFelMokr/Sc3AgNbso3n74mVPA5LTZwkB9NlXf4XPamLxJE8h0gh73rM94xvwRT2CVInw==", + "dev": true + }, + "swipl-wasm": { + "version": "file:../..", + "requires": { + "@octokit/rest": "^19.0.7", + "@qiwi/semantic-release-gh-pages-plugin": "^5.2.5", + "@types/emscripten": "^1.39.6", + "@types/fs-extra": "^11.0.1", + "@types/node": "^20.0.0", + "@typescript-eslint/eslint-plugin": "^5.59.2", + "@typescript-eslint/parser": "^5.59.2", + "cross-fetch": "^3.1.5", + "eslint": "^8.39.0", + "fs-extra": "^11.1.1", + "http-server": "^14.1.1", + "mocha": "^10.2.0", + "node-static": "^0.7.11", + "npm-run-all": "^4.1.5", + "puppeteer": "^20.1.1", + "semantic-release": "^19.0.5", + "ts-node": "^10.9.1", + "typescript": "^5.0.4", + "webpack": "^5.82.0", + "webpack-cli": "^5.0.2" + } + }, + "ts-node": { + "version": "10.9.1", + "resolved": "https://registry.npmjs.org/ts-node/-/ts-node-10.9.1.tgz", + "integrity": "sha512-NtVysVPkxxrwFGUUxGYhfux8k78pQB3JqYBXlLRZgdGUqTO5wU/UyHop5p70iEbGhB7q5KmiZiU0Y3KlJrScEw==", + "dev": true, + "requires": { + "@cspotcode/source-map-support": "^0.8.0", + "@tsconfig/node10": "^1.0.7", + "@tsconfig/node12": "^1.0.7", + "@tsconfig/node14": "^1.0.0", + "@tsconfig/node16": "^1.0.2", + "acorn": "^8.4.1", + "acorn-walk": "^8.1.1", + "arg": "^4.1.0", + "create-require": "^1.1.0", + "diff": "^4.0.1", + "make-error": "^1.1.1", + "v8-compile-cache-lib": "^3.0.1", + "yn": "3.1.1" + } + }, + "typescript": { + "version": "4.9.5", + "resolved": "https://registry.npmjs.org/typescript/-/typescript-4.9.5.tgz", + "integrity": "sha512-1FXk9E2Hm+QzZQ7z+McJiHL4NW1F2EzMu9Nq9i3zAaGqibafqYwCVU6WyWAuyQRRzOlxou8xZSyXLEN8oKj24g==", + "dev": true, + "peer": true + }, + "v8-compile-cache-lib": { + "version": "3.0.1", + "resolved": "https://registry.npmjs.org/v8-compile-cache-lib/-/v8-compile-cache-lib-3.0.1.tgz", + "integrity": "sha512-wa7YjyUGfNZngI/vtK0UHAN+lgDCxBPCylVXGp0zu59Fz5aiGtNXaq3DhIov063MorB+VfufLh3JlF2KdTK3xg==", + "dev": true + }, + "yn": { + "version": "3.1.1", + "resolved": "https://registry.npmjs.org/yn/-/yn-3.1.1.tgz", + "integrity": "sha512-Ux4ygGWsu2c7isFWe8Yu1YluJmqVhxqK2cLXNQA5AcC3QfbGNpM7fu0Y8b/z16pXLnFxZYvWhd3fhBY9DLmC6Q==", + "dev": true + } + } +} diff --git a/examples/multi-file-generation/package.json b/examples/multi-file-generation/package.json new file mode 100644 index 00000000..9f7215ec --- /dev/null +++ b/examples/multi-file-generation/package.json @@ -0,0 +1,19 @@ +{ + "name": "generation", + "version": "1.0.0", + "description": "", + "main": "index.js", + "scripts": { + "build:image": "swipl-generate ./project/pack.pl ./dist/max.ts --copy-dir=./project", + "test": "ts-node dist/main.ts" + }, + "keywords": [], + "author": "", + "license": "MIT", + "dependencies": { + "swipl-wasm": "file:../.." + }, + "devDependencies": { + "ts-node": "^10.9.1" + } +} diff --git a/examples/multi-file-generation/project/pack.pl b/examples/multi-file-generation/project/pack.pl new file mode 100644 index 00000000..1379b4de --- /dev/null +++ b/examples/multi-file-generation/project/pack.pl @@ -0,0 +1,5 @@ +name(le). +version('0.0.2'). +title('Logical English Parser'). +author('Jacinto Dávila', 'jd@logicalcontracts.com'). +home('https://github.com/LogicalContracts/LogicalEnglish'). diff --git a/examples/multi-file-generation/project/prolog/api.pl b/examples/multi-file-generation/project/prolog/api.pl new file mode 100755 index 00000000..555e27b2 --- /dev/null +++ b/examples/multi-file-generation/project/prolog/api.pl @@ -0,0 +1,316 @@ +/* Copyright [2021] Initial copyright holders by country: +LodgeIT (AU), AORA Law (UK), Bob Kowalski (UK), Miguel Calejo (PT), Jacinto Dávila (VE) + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +*/ + +:- module(_ThisFileName,[start_api_server/0, set_le_program_module/1, le_program_module/1, hack_module_for_taxlog/1]). + +% API for client apps to use the reasoner and drafter + +% Adapted from https://github.com/SWI-Prolog/packages-pengines/blob/master/examples/server.pl : +:- use_module(library(http/thread_httpd)). +:- use_module(library(http/http_dispatch)). +:- use_module(library(http/http_server_files)). +:- use_module(library(http/http_files)). +:- use_module(library(pengines)). +:- use_module(pengine_sandbox:library(pengines)). +:- use_module(library(sandbox)). +%:- use_module(library(http/http_digest)). % to activate digest authorization options + +% :- multifile pengines:authentication_hook/3. + +% pengines:authentication_hook(_Request, _, User). + +% :- multifile http:authenticate_client/2. + +% http:authenticate_client("http://localhost:3050/pengine", Action) :- +% print_message(informational, " Authenticate client ~w "-[Action]). + +% previous modules + +:- multifile sandbox:safe_primitive/1. + +:- use_module(library(http/http_json)). +:- use_module(library(http/json)). +:- use_module(library(term_to_json)). +:- use_module(library(http/http_parameters)). + +:- use_module(reasoner). +:- use_module('spacy/spacy.pl'). +:- use_module(drafter). +:- use_module(kp_loader). +:- use_module(syntax). +:- use_module(reasoner,[taxlogWrapper/10]). +:- use_module(le_answer, [parse_and_query/5, prepare_query/6]). +:- use_module(le_input,[text_to_logic/2]). +:- use_module(library(prolog_stack)). + +:- if(current_module(swish)). %%%%% On SWISH: + +start_api_server :- print_message(informational,"No need to start API server, SWISH already running"-[]). + +:- else. % On command-line SWI-Prolog, no user restrictions: + +% Need to call thi to respond to REST API requests: +start_api_server :- start_api_server(3050). +start_api_server(Port) :- http_server(http_dispatch, [port(Port)]). +:- endif. + +% Session module management +:- thread_local le_program_module/1. % the default, "user" module, where module-less KRT files get loaded into +% May generate new module name: +set_le_program_module(M) :- var(M), !, gensym(leSessionModule, M), set_le_program_module(M). +set_le_program_module(M) :- + retractall(le_program_module(_)), assert(le_program_module(M)). + +safe_module(M) :- sub_atom(M,0,_,_,leSessionModule), !. + +safe_file(F) :- sub_atom(F,_,_,_,'/moreExamples/'). + +% handler for the original api +:- http_handler('/taxkbapi', handle_api, []). % this defines a web server endpoint +handle_api(Request) :- + http_read_json_dict(Request, Payload, [value_string_as(atom)]), + %asserta(my_request(Request)), % for debugging + %print_message(informational,"Request Payload: ~w"-[Payload]), + assertion(Payload.token=='myToken123'), + (entry_point(Payload,Result)->true;Result=_{error:"Goal failed"}), + %print_message(informational,"returning: ~w"-[Result]), + reply_json_dict(Result). + +:- discontiguous api:entry_point/2. + +% Define our adhoc REST API; more general Prolog querying at +% https://pengines.swi-prolog.org/docs/documentation.html (Javascript) or +% https://www.swi-prolog.org/pengines/PenginesFromPython.md (Python) +% Examples (resp: true, unknown, false): +% curl --header "Content-Type: application/json" --request POST --data '{"operation":"query", "theQuery":"a(1,Y)", "module":"http://tests.com"}' http://localhost:3050/taxkbapi +% curl --header "Content-Type: application/json" --request POST --data '{"operation":"query", "theQuery":"testForall([1,2])", "module":"http://tests.com"}' http://localhost:3050/taxkbapi +% curl --header "Content-Type: application/json" --request POST --data '{"operation":"query", "theQuery":"testForall([1,2,9])", "module":"http://tests.com"}' http://localhost:3050/taxkbapi +% Example with hypothetical facts: +% curl --header "Content-Type: application/json" --request POST --data '{"operation":"query", "theQuery":"a(13,Y)", "facts":["d(13)"], "module":"http://tests.com"}' http://localhost:3050/taxkbapi +% curl --header "Content-Type: application/json" --request POST --data '{"operation":"query", "theQuery":"a(13,Y)", "module":"http://tests.com"}' http://localhost:3050/taxkbapi + +% {operation: query, theQuery: "a(1,Y)", module:"https://tests.com"} --> {results:ResultsArray} +% each result is a {result: true/false/unknown, bindings:VarsValuesArray, unknowns: ArrayOfTerm, why: ExplanationTerm} +entry_point(R, _{results:Results}) :- get_dict(operation,R,query), !, + term_string(Query,R.theQuery,[variable_names(VarPairs_)]), + (get_dict(facts,R,Facts_) -> (is_list(Facts_) -> maplist(term_string,Facts,Facts_) ; Facts=Facts_) ; Facts=[]), + findall( _{bindings:VarPairs, unknowns:U, result:Result, why:E}, ( + query_with_facts(at(Query,R.module),Facts,unknowns(U_),taxlogExplanation(E_),Result), + makeBindingsDict(VarPairs_,VarPairs), + makeUnknownsArray(U_,U), + makeExplanationTree(E_,E) + ), Results). + +% Example: +% curl --header "Content-Type: application/json" --request POST --data '{"operation":"draft", "pageURL":"http://mysite/page1#section2", "content":[{"url":"http://mysite/page1#section2!chunk1", "text":"john flies by instruments"}, {"url":"http://mysite/page1#section2!chunk2", "text":"miguel drives with gusto"}]}' http://localhost:3050/taxkbapi +% {operation:draft, pageURL:U, content:Items} --> {pageURL:U, draft:PrologText} +% each item is a {url:..,text:...} +entry_point(R, _{pageURL:ThePage, draft:Draft}) :- get_dict(operation,R,draft), !, + load_content(R.content), + ThePage = R.pageURL, + draft_string(R.pageURL,Draft). + +% Example: see Javascript example in clientExample/ +% Translates a LE program to a Prolog program +entry_point(R, _{prolog:Program, kb:KB, + predicates:Predicates, examples:Examples, queries:Qs, target:Target}) :- get_dict(operation,R,le2prolog), !, + le2prologTerms(R.le,KB,Terms,Preds,Examples, _ExamplesProlog ,Queries,Target), + with_output_to(string(Program),forall(member(Term,Terms), portray_clause(Term) ) ), + with_output_to(string(Qs),forall(member(Qx,Queries), portray_clause(Qx) ) ), + findall(Pred,(member(Pred_,Preds), term_string(Pred_,Pred)),Predicates). + %print_message(informational,"le2prolog done\n"-[]). + +%TODO: verify if JD initializes parsed etc correctly; they may be prone to threading bugs under the web server thread pool +le2prologTerms(LE,KB,Clauses,Preds,ExamplesInJson, Examples, Queries,Target) :- + %print_message(informational,"le2prologTerms ~w \n"-[LE]), + text_to_logic(LE,X), + %print_message(informational,"text to logic ~w \n"-[X]), + (member(target(prolog),X) -> Target=prolog ; Target=taxlog), + findall(Prolog, ( + member(T,X), + (Target==prolog -> ( + semantics2prolog(T,_,Prolog_), + ( ( Prolog_=(Head:-RawBody), taxlogWrapper(RawBody,_,_,_,Body,_,_,_,_,_) ) -> + Prolog=(Head:-Body) ; + Prolog=Prolog_ ) + ) ; + taxlog2prolog(T,_,Prolog) + ) + ),Clauses), + (member(kbname(KB),X)->true;KB=null), + (member(predicates(Preds),X) -> true; Preds=[]), + %print_message(informational,"Clauses ~w \n"-[Clauses]), + % findall(_{name:QueryName, query: Query}, ( + % member(query(QueryName, Query_),X), QueryName\==null, term_string(Query_, Query) + % ),Queries), + findall(query(QueryName, Query), member(query(QueryName, Query),X), Queries), + findall(example(ExampleName, Scs), member(example(ExampleName,Scs),X), Examples), + %print_message(informational,"Queries ~w \n"-[Queries]), + %print_message(informational,"Examples ~w \n"-[Examples]), + findall(_{name:Name, scenarios:Scenarios}, ( + member(example(Name,Scenarios_),X), Name\==null, + findall( _{assertion:Assertion,clauses:ScenarioProgram},( + member(scenario(Clauses_,Assertion_),Scenarios_), + term_string(Assertion_,Assertion), + with_output_to(string(ScenarioProgram), forall(member(Clause_,Clauses_), portray_clause(Clause_))) + ), Scenarios) + ),ExamplesInJson). + %print_message(informational,"Scenarios ~w \n End of le2prologTerms\n"-[Examples]). + +entry_point(R, _{sessionModule:M, kb:KB, + predicates:Predicates, examples:ExamplesInJSON, + queries:QueriesInJSON, language:Lang, target:Target}) :- get_dict(operation,R,load), !, + set_le_program_module(M), + print_message(informational,"Created module ~w\n"-[M]), + + (get_dict(le,R,LE) -> ( + Lang=le, + le2prologTerms(LE,KB,Clauses,Preds,ExamplesInJSON, Examples, Queries,Target), + findall(Pred,(member(Pred_,Preds), toJSON(Pred_,Pred)),Predicates), + findall(QueryJSON,(member(Q_,Queries), toJSON(Q_,QueryJSON)),QueriesInJSON), + forall(member(Example,Examples),M:assert(Example)), + forall(member(Query,Queries),M:assert(Query)), + forall(member(Clause,Clauses),M:assert(Clause)) + %print_message(informational,"Asserted ~w and ~w "-[Queries, Clauses]) + ) ; ( + assertion(safe_file(R.file)), + (sub_atom(R.file,_,_,0,'le') -> ( + Lang=le, + read_file_to_string(R.file,LE,[]), + le2prologTerms(LE,KB,Clauses,Preds,ExamplesInJSON, Examples, Queries, Target), + findall(Pred,(member(Pred_,Preds), toJSON(Pred_,Pred)),Predicates), + findall(QueryJSON,(member(Q_,Queries), toJSON(Q_,QueryJSON)),QueriesInJSON), + forall(member(Example,Examples),M:assert(Example)), + forall(member(Query,Queries),M:assert(Query)), + forall(member(Clause,Clauses),M:assert(Clause)) + %print_message(informational,"Asserted from file ~w and ~w "-[Queries, Clauses]) + ) ; ( + Lang=prolog, Target=prolog, + load_files(R.file,[module(M)]) + ) + ) + ) + ), + M:assert(target_executor(Target)), + (Target==taxlog -> M:assert(myDeclaredModule_(M)) ; true), + % For LE, make predicates dynamic so we can query them all: + (nonvar(Preds) -> forall(member(Pred,Preds), (functor(Pred,F,N), M:dynamic(F/N))) ; true), + %with_output_to(string(Report), (listing(M:_), listing(le_input:_))), + print_message(informational,"load finished\n\n"-[]). + +hack_module_for_taxlog(M) :- + retractall(kp_loader:module_api_hack(_)), + assert(kp_loader:module_api_hack(M)). + +% adding an direct entry point +entry_point(R, _{answer:AnswerJSON, result:ok}) :- get_dict(operation,R,answeringQuery), !, %trace + print_message(informational,"answering Query: ~w with ~w\n"-[R.query, R.scenario]), + assertion(safe_module(R.sessionModule)), + term_string(Scenario, R.scenario), + call_answer(R.query, with(Scenario), R.sessionModule, Answer), !, + term_string(Answer, AnswerJSON). + % term_string(Requests, R.goal). + % print_message(informational,"Attending ~w"-[Request]), + % % assertion(safe_module(R.sessionModule)) -> assert(parsed), + % assert(le_input:parsed), + % le_input:answer(happy, with(one), Response), retractall(le_input:parsed). + +entry_point(R, _{facts:R.facts, goal: QVS, answers:Solutions, result:Result}) :- get_dict(operation,R,loadFactsAndQuery), !, + print_message(informational,"loadFactsAndQuery: ~w\n"-[R]), + assertion(safe_module(R.sessionModule)), + forall(member(Fact_,R.facts),( + term_string(Fact,Fact_), + assertion( \+ functor(Fact,':-',_) ), + R.sessionModule:assert(Fact) + )), + (get_dict(goal,R,Goal_) -> ( + assertion(is_list(R.vars)), + format(string(QVS),"(~a)-(~w)",[Goal_,R.vars]), term_string(Goal-Vars_,QVS), + (R.sessionModule:target_executor(prolog) -> ( + findall(_{bindings:Vars}, (R.sessionModule:Goal, toJSON(Vars_,Vars)), Solutions), + (Solutions=[] -> Result=false ; Result=true) + ) ;( + % taxlog: + hack_module_for_taxlog(R.sessionModule), + findall(Vars+Result+E, ( + query_with_facts(at(Goal,R.sessionModule),[/*??*/],unknowns(_),taxlog(taxlogExplanation(E_)),Result), + makeExplanationTree(E_,E), + toJSON(Vars_,Vars) + ),Pairs + ), + (member(_+unknown+_,Pairs) -> Result=unknown; Pairs=[] -> Result=false; Result=true), + findall(_{bindings:Vars,explanation:E},member(Vars+_+E,Pairs),Solutions) + ) + ) + ) ; true). + +call_answer(English, Arg, SwishModule, Command) :- %trace, + prepare_query(English, Arg, SwishModule,_Goal, Facts, Command), !, + print_message(informational, "call_answer: about to call ~w\n"-[Command]), + setup_call_catcher_cleanup(le_input:assert_facts(SwishModule, Facts), + % with_output_to(string(Out), listing(SwishModule:_)), + % catch_with_backtrace(Command, Error, print_message(error, Error)), + catch(Command, Error, ( print_message(error, Error), fail ) ), + _Result, + le_input:retract_facts(SwishModule, Facts)). + %le_input:translate_goal_into_LE(Goal, RawAnswer), le_input:name_as_atom(RawAnswer, EnglishAnswer). + +toJSON([T1|Tn],[J1|Jn]) :- !, toJSON(T1,J1), toJSON(Tn,Jn). +toJSON([],[]) :- !. +toJSON(T,J) :- atomic(T), !, T=J. +toJSON(D,J) :- is_dict(D), !, + dict_pairs(D,Tag,Pairs), + findall(Key-ValueJ,(member(Key-Value,Pairs), toJSON(Value,ValueJ)), JPairs), + dict_pairs(J,Tag,JPairs). +toJSON(T,J) :- term_string(T,J). + +%makeBindingsDict(+NameTermPairs,-NameTermDict) +makeBindingsDict(Pairs,Dict) :- + makeBindingsDict_(Pairs,NewPairs), dict_create(Dict,_,NewPairs). + +makeBindingsDict_([Name=T|Pairs],[Name=J|NewPairs]) :- !, + term_to_json(T,J), makeBindingsDict_(Pairs,NewPairs). +makeBindingsDict_([],[]). + +makeUnknownsArray([at(X,M)/_Clause|U],[_{goal:J, module:M}|NewU]) :- !, + term_to_json(X,J), makeUnknownsArray(U,NewU). +makeUnknownsArray([],[]). + +% keep in sync with reasoner.pl, namely expand_failure_trees and expand_explanation_refs +makeExplanationTree([Node|Nodes],[_{type:Type, literal:Gstring, module:M, source:Source, textOrigin:Origin, children:NewChildren}|NewNodes]) :- !, + Node=..[Type_,G,_Ref,M,Source,Origin,Children], + explanation_node_type(Type_,Type), + term_string(G,Gstring), + makeExplanationTree(Children,NewChildren), + makeExplanationTree(Nodes,NewNodes). +makeExplanationTree([],[]). + +:- http_handler('/taxkbapi/draft', handle_api_draft, []). % this defines a web server endpoint for https://github.com/mcalejo/my-highlighter +% receive content from our highlighter Chrome extension, digest it and open a new Prolog file with its "draft": +handle_api_draft(Request) :- + http_parameters(Request, [pageURL(PageURL,[]),content(Content_,[])]), + uri_encoded(query_value,Content,Content_), + open_string(Content,S), json_read_dict(S, ContentArray), close(S), + load_content(ContentArray), + draft_string(PageURL,Draft), + url_simple(PageURL,Filename_), atomic_list_concat([Filename_,".pl"],Filename), + update_gitty_file(Filename,PageURL,Draft), + format(string(NewEditor),"/p/~a",[Filename]), + http_redirect(see_other,NewEditor,Request). + +% sanbox:safe_primitive(le_input:dict(_,_,_)). +% sanbox:safe_primitive(user:current_module(_)). +% sanbox:safe_primitive(user:dict(_,_,_)). diff --git a/examples/multi-file-generation/project/prolog/drafter.pl b/examples/multi-file-generation/project/prolog/drafter.pl new file mode 100755 index 00000000..160fc450 --- /dev/null +++ b/examples/multi-file-generation/project/prolog/drafter.pl @@ -0,0 +1,179 @@ +/* Copyright [2021] Initial copyright holders by country: +LodgeIT (AU), AORA Law (UK), Bob Kowalski (UK), Miguel Calejo (PT), Jacinto Dávila (VE) + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +*/ + +:- module(_,[ + draft_string/2, draft_string_from_file/2, test_draft/2, + nameToWords/2, + predicateWords/3, printAllPredicateWords/1, uniquePredicateWords/2, uniqueArgSentences/2, uniquePredicateSentences/2]). + +:- use_module('spacy/spacy.pl'). +:- use_module(kp_loader). + +% Knowledge page drafting aids, assuming loaded content and using Spacy parses and known knowledge pages (modules) + +%! test_draft(+Text,-DraftedCode) +% Draft some source code from a given text string +test_draft(Text,DraftedCode) :- + load_content( [_{url:testURL,text:Text}] ), + draft_string(testURL,DraftedCode). + +% Draft some source code from a given text file +draft_string_from_file(File,DraftedCode) :- + load_content_from_text_file(File,URL), + draft_string(URL,DraftedCode). + +% Args is (for now..) a list of role names +% Why includes relevant sentences and tokens within the TextURL's text, Spacy extraction +:- thread_local predicate_draft/4. % TextURL,Functor,Args,Why + +draft_string(URL,S) :- + draft(URL,Tmp), read_file_to_string(Tmp,S,[]). + + +% draft(+URL,-TmpPrologFile) +draft(URL,TmpFile):- + must_be(atomic,URL), must_be(var,TmpFile), + retractall(predicate_draft(URL,_,_,_)), + refreshTokens(URL), + % Now that we've (re) parsed tokens, detect we shall: + forall(( + content_tokens_in(URL,SpecificURL,SI,Tokens,Extraction), + detected_predicate(Tokens,Functor,Args,Reason) + ), + %TODO: detect duplicates/variants + assert(predicate_draft(URL,Functor,Args,Extraction/SpecificURL/SI/Reason) + )), + % Now generate the Prolog code: + tmp_file_stream(TmpFile, S, [encoding(text),extension(pl)]), + format(S,":- module('~a',[]).~n~n",[URL]), + forall(predicate_draft(URL,Functor,Args_,Why),( + Why=_/SpecificURL/SI/_, + content_tokens(SpecificURL, SI, Tokens,_), sentence(Tokens,Sentence), + maplist(capitalize,Args_,Args), + Pred=..[Functor|Args], + format(S,"% ~w.~n% Why: ~w~n% To parse sentence:~n% parseAndSee('~a',SentenceI,Tokens,Tree).~n~n",[Pred,Why,Sentence]) + )), + close(S). + +% detected_predicate(+Tokens,-Functor,-Args,-Reason) +% See predicates and notes on tags etc. in spacy.pl +detected_predicate(Tokens,F,Args,VerbToken) :- + member_with([lemma=L_,tag=VerbTag,pos=verb,i=Vi_], VerbToken, Tokens), + VerbTag\=md, % must not be a modal auxiliary + (L_=="be" -> ( + member_with([head=Vi_,dep=acomp,lemma=RealL,i=Vi],Tokens), + atomic_list_concat([L_,'_',RealL],LL), atom_string(L,LL) + ) ; ( + L=L_, Vi=Vi_ + ) + ), + atom_string(F,L), + findall(Arg,( + ( + member_with([head=Vi,dep=nsubj],Tokens), Arg_="Subject" + ; member_with([head=Vi,dep=dobj],Tokens), Arg_="Object" + ; member_with([head=Vi,dep=prep,lemma=Arg_],Tokens)), + atom_string(Arg,Arg_) + ),Args). + +capitalize(X,NewX) :- + name(X,[First|Codes]), to_upper(First,U), name(NewX,[U|Codes]). + +%! nameToWords(PrologAtom,Words) is det +% Breaks a predicate or variable name into words, if detected via underscores or spaces or CamelCase +nameToWords(V,['ANONVAR']) :- var(V), !. +nameToWords('',[]) :- !. +nameToWords([X1|Xn],Words) :- !, + nameToWords(X1,W1), nameToWords(Xn,Wn), append(W1,Wn,Words). +nameToWords([],[]) :- !. +nameToWords(X,[Word]) :- \+ atomic(X), !, term_string(X,Word). +nameToWords(X,Words) :- atomics_to_string(Words_,'_',X), Words_=[_,_|_], !, nameToWords(Words_,Words). +nameToWords(X,Words) :- atomics_to_string(Words_,' ',X), Words_=[_,_|_], !, nameToWords(Words_,Words). +nameToWords(X,Words) :- camelsToList(X,Words_), Words_=[_,_|_], !, nameToWords(Words_,Words). +nameToWords(X,[X]). + +camelsToList(X,L) :- + must_be(atomic,X), assertion(X\==''), atom_codes(X,Codes), + %(code_type(C,upper)->Type=upper;code_type(C,lower)->Type=lower;Type=other), + camelsToList(Codes,white,[],L). + +% camelsToList(CharCodes,LastType,NextWordCharsSoFar,Words) +camelsToList([C|Codes],LastType,NextCodes,NewWords) :- + %Changers=[upper,digit], member(Changer,Changers), code_type(C,Changer), Type\=Changer, + code_type(C,Type), + LastType\=Type, + member(LastType-Type,[lower-upper,upper-digit,lower-digit,digit-lower,digit-upper]), + !, + (NextCodes=[]->NewWords=Words ; NewWords=[W|Words]), + atom_codes(W,NextCodes), camelsToList([C|Codes],Type,[],Words). +camelsToList([C|Codes],LastType,NextCodes,Words) :- !, + (code_type(C,LastType)->Type=LastType; + code_type(C,lower)->Type=lower; + code_type(C,upper)->Type=upper; + code_type(C,digit)->Type=digit; + once(code_type(C,Type))), + append(NextCodes,[C],NewNextCodes), + camelsToList(Codes,Type,NewNextCodes,Words). +camelsToList([],_,NextCodes,Words) :- + (NextCodes=[] -> Words=[] ; (atom_codes(W,NextCodes), Words=[W])). + +%! predicateWords(?KP,?Pred,-FunctorWords,-WordArgsList) +% Pred is a predicate literal template +% E.g. all_kps_loaded, predicateWords(KP,Pred,PredsWords), member(F/N/Fwords/Awords,PredsWords), atomics_to_string(Fwords,' ',Fstring), format("~w: ~a~n",[F/N,Fstring]), forall(member(A,Awords),(atomics_to_string(A,' ',Astring),format(" ~a~n",[Astring]))), fail. +predicateWords(KP,Pred,PredsWords) :- + all_kps_loaded(KP), + setof(F/Arity/Fwords/ArgsWords, How^Args^( + kp_predicate_mention(KP,Pred,How), + functor(Pred,F,Arity), nameToWords(F,Fwords), + predicate_literal(KP,Pred), Pred=..[F|Args], + findall(ArgWords, (member(Arg,Args), nameToWords(Arg,ArgWords)), ArgsWords) + ),PredsWords). + +printAllPredicateWords(KP) :- + predicateWords(KP,_Pred,PredsWords), + member(F/N/Fwords/Awords,PredsWords), atomics_to_string(Fwords,' ',Fstring), + format("~w: ~a~n",[F/N,Fstring]), + forall(member(A,Awords),(atomics_to_string(A,' ',Astring),format(" ~a~n",[Astring]))), + fail. +printAllPredicateWords(_). + +uniquePredicateSentences(KP,Sentences) :- + setof(PredsWords,Pred^predicateWords(KP,Pred,PredsWords),L), + append(L,All), + setof(Fwords, F^Arity^ArgsWords^member(F/Arity/Fwords/ArgsWords,All), Sentences). + +uniqueArgSentences(KP,Sentences) :- + setof(PredsWords,Pred^predicateWords(KP,Pred,PredsWords),L), + append(L,All), + setof(ArgsWords, F^Arity^Fwords^member(F/Arity/Fwords/ArgsWords,All), Sentences). + +% ignores one letter words +% e.g. ?- forall(uniquePredicateWords(KP,Words), format("~w~n ~w~n",[KP,Words])). +uniquePredicateWords(KP,Words) :- + setof(PredsWords,Pred^predicateWords(KP,Pred,PredsWords),L), + append(L,All), + setof(Word, F^Arity^Fwords^ArgsWords^ArgWords^C1^C2^Rest^( + member(F/Arity/Fwords/ArgsWords,All), + (member(Word,Fwords); member(ArgWords,ArgsWords), member(Word,ArgWords)), + atom_codes(Word,[C1,C2|Rest]) + ), Words). + + +%TODO: handle more verb patterns, e.g. have+dobj, etc. +%TODO: generate rules, extract nouns/concepts/class hierarchies, knowledge page/reference extractor + +:- multifile sandbox:safe_primitive/1. +sandbox:safe_primitive(drafter:predicateWords(_,_,_)). diff --git a/examples/multi-file-generation/project/prolog/kp_loader.pl b/examples/multi-file-generation/project/prolog/kp_loader.pl new file mode 100755 index 00000000..fb54e917 --- /dev/null +++ b/examples/multi-file-generation/project/prolog/kp_loader.pl @@ -0,0 +1,563 @@ +:- module(_,[ + loaded_kp/1, all_kps_loaded/0, all_kps_loaded/1, kp_dir/1, taxkb_dir/1, kp_location/3, kp/1, must_succeed/2, must_succeed/1, + shouldMapModule/2, module_api_hack/1, moduleMapping/2, myDeclaredModule/1, system_predicate/1, + discover_kps_in_dir/1, discover_kps_in_dir/0, discover_kps_gitty/0, setup_kp_modules/0, load_kps/0, + load_gitty_files/1, load_gitty_files/0, save_gitty_files/1, save_gitty_files/0, delete_gitty_file/1, update_gitty_file/3, + xref_all/0, xref_clean/0, print_kp_predicates/0, print_kp_predicates/1, reset_errors/0, my_xref_defined/3, url_simple/2, + kp_predicate_mention/3, predicate_literal/2,load_named_file/3, + edit_kp/1, swish_editor_path/2, knowledgePagesGraph/1, knowledgePagesGraph/2]). + +:- use_module(library(prolog_xref)). +:- use_module(library(broadcast)). + +:- multifile prolog:message//1. + +:- dynamic kp_dir/1, taxkb_dir/1. +:- prolog_load_context(directory, D), + retractall(taxkb_dir(_)), assert(taxkb_dir(D)), + retractall(kp_dir(_)), atomic_list_concat([D,'/kb'], KD), assert(kp_dir(KD)), + print_message(informational,"KB directory is ~a"-[KD]). + +/** Dynamic module loader. + +Scans a given set of Prolog files in SWISH storage or in a file system directpry, and identifies "knowledge pages", files which: +- are modules named with an URL +Can also export and import SWISH storage to/from a file system directory. +*/ + +:- dynamic kp_location/4. % URL,File,ModifiedTime,InGitty +kp_location(URL,File,InGitty) :- kp_location(URL,File,_,InGitty). + +kp(URL_) :- + (nonvar(URL_) -> atom_string(URL,URL_);URL=URL_), + kp_location(URL,_,_). + +%! discover_kps_in_dir(+Dir) is det. +% +discover_kps_in_dir(Dir) :- + retractall(kp_location(_,_,_,false)), + forall(directory_member(Dir,File,[extensions([pl])]), ( + time_file(File,Modified), + open(File,read,In), + process_file(In,File,Modified,false) + )). + +% This also RELOADS modules already loaded +discover_kps_in_dir :- + kp_dir(D), discover_kps_in_dir(D). + +process_file(In,File,Modified,InGitty) :- + must_be(boolean,InGitty), + setup_call_cleanup( true, ( + process_terms(In, LastTerm), + % (LastTerm=at(Name) -> ( + (LastTerm=(:-module(Name,_)) -> ( + ((kp_location(Name,PreviousFile,PreviousMod,InGitty), PreviousMod>=Modified) -> + print_message(warning,ignored_older_module(Name,PreviousFile,File)) ; + ( + (kp_location(Name,PreviousFile,_,InGitty) -> + print_message(warning,using_newer_module(Name,PreviousFile,File)) + ; true), + retractall(kp_location(Name,_,_,InGitty)), + assert(kp_location(Name,File,Modified,InGitty)), + % reload the module if it already exists: + (current_module(Name) -> load_named_file(File,Name,InGitty) ; true) + )) + ); true) + ), close(In)). + +prolog:message(ignored_older_module(Module,PreviousFile,File)) --> + ['Ignored older file ~a for module ~w; sticking to ~a'-[File,Module,PreviousFile]]. +prolog:message(using_newer_module(Module,PreviousFile,File)) --> + ['Forgot older file ~a for module ~w; using instead ~a'-[PreviousFile,Module,File]]. + +process_terms(In,Term) :- % actually gets only the first term, where the module declaration must be: + %repeat, + read_term(In, Term, [syntax_errors(fail)]), + ( Term==end_of_file, ! ; + Term= (:- module(URL,_)), is_absolute_url(URL), ! ; + true + %Term=at(Name), (ground(Name)->true; print_message(warning,'ignored'(at(Name))), fail) + ). + + +declare_our_metas(Module) :- + Module:meta_predicate(mainGoal(0,+)), + Module:meta_predicate(on(0,?)), + Module:meta_predicate(because(0,-)). + +% load_named_file(+File,+Module,+InGittyStorage) +load_named_file(File,Module,InGittyStorage) :- + load_named_file_(File,Module,InGittyStorage), + kp_file_modified(Module,Modified,InGittyStorage), + retractall(kp_location(Module,File,_,InGittyStorage)), + assert(kp_location(Module,File,Modified,InGittyStorage)), + (xref_source(Module,[silent(true)]) -> true ; print_message(warning,"failed xref_source"-[])). + +load_named_file_(File,Module,true) :- !, + %print_message(informational, "load File into Module ~w ~w\n"-[File, Module]), + use_gitty_file(Module:File,[/* useless: module(Module)*/]). +load_named_file_(File,Module,false) :- + load_files(File,[module(Module)]). + +load_kps :- + forall(kp_location(URL,File,InGitty), ( + load_named_file(File,URL,InGitty) + )). + +setup_kp_modules :- forall(kp(M), setup_kp_module(M) ). + +setup_kp_module(M) :- + M:discontiguous((if)/2), + M:discontiguous((on)/2), + M:discontiguous((because)/2), + M:discontiguous(question/2), M:discontiguous(question/3), + declare_our_metas(M). + +all_kps_loaded :- all_kps_loaded(_). + +all_kps_loaded(KP):- + print_message(informational,"Loading Knowledge Page(s)..(~w)"-[KP]), + forall(kp(KP),loaded_kp(KP)). + +:- thread_local module_api_hack/1. + +%! loaded_kp(++KnowledgePageName) is nondet. +% +% loads the knowledge page, failing if it cannot +loaded_kp(Name) :- module_api_hack(Name), !. +loaded_kp(Name) :- must_be(nonvar,Name), shouldMapModule(_,Name), !. % SWISH module already loaded +loaded_kp(Name) :- \+ kp_location(Name,_,_), !, + (\+ reported_missing_kp(Name) -> ( + assert(reported_missing_kp(Name)), print_message(error,"Unknown knowledge page: ~w"-[Name])) + ; true), + fail. +loaded_kp(Name) :- % some version already loaded: + module_property(Name,last_modified_generation(T)), T>0, + !, + once(( kp_file_modified(Name,FT,InGitty), kp_location(Name,File,LastModified,InGitty) )), + (FT>LastModified -> ( + load_named_file(File,Name,InGitty), + print_message(informational,"Reloaded ~w"-[Name]) + ) ; true). +loaded_kp(Name) :- kp_location(Name,File,InGitty), !, % first load: + load_named_file(File,Name,InGitty), + (\+ reported_loaded_kp(Name) -> ( + print_message(informational,loaded(Name,File)), assert(reported_loaded_kp(Name))) + ; true). +loaded_kp(Name) :- + \+ reported_missing_kp(Name), + print_message(error,no_kp(Name)), + assert(reported_missing_kp(Name)), fail. + +kp_file_modified(Name,Time,InGitty) :- + kp_location(Name,File,InGitty), + (InGitty==true -> (storage_meta_data(File, Meta), Time=Meta.time) ; time_file(File,Time)). + + +:-thread_local reported_missing_kp/1. +:-thread_local reported_loaded_kp/1. + +reset_errors :- + retractall(reported_missing_kp(_)), retractall(reported_loaded_kp(_)). + +prolog:message(loaded(Module,Path)) --> ['Loaded ~w from ~a'-[Module,Path]]. + + +% Support xref for gitty and file system files +:- multifile + prolog:xref_source_identifier/2, + prolog:xref_open_source/2, + prolog:xref_close_source/2, + prolog:xref_source_time/2, + prolog:meta_goal/2. + +prolog:xref_source_identifier(URL, URL) :- kp_location(URL,_,_). + +prolog:xref_open_source(URL, Stream) :- + kp_location(URL,File,InGitty), + (InGitty==true -> (storage_file(File,Data,_Meta), open_string(Data, Stream)) + ; (open(File,read,Stream))). + +prolog:xref_close_source(_, Stream) :- + close(Stream). + +prolog:xref_source_time(URL, Modified) :- + kp_location(URL,_File,Modified,_InGitty). + + +%! xref_all is det +% +% refresh xref database for all knowledge pages %TODO: report syntax errors properly +xref_all :- + forall(kp_location(URL,File,_), ( + print_message(informational,xreferencing(URL,File)), + xref_source(URL,[silent(true)]) % to avoid spurious warnings for mainGoal singleton vars + )). + +prolog:message(xreferencing(URL,File)) --> ['Xreferencing module ~w in file ~w'-[URL,File]]. +prolog:message(no_kp(Name)) --> ["Could not find knowledge page ~w"-[Name]]. + +xref_clean :- + forall(kp_location(URL,_,_), xref_clean(URL)). + + +% kp_predicate_mention(?Module,?PredicateTemplate,?How) How is called_by(KP)/defined +% Considers undefined predicates too; ignores mentions from example scenarios +kp_predicate_mention(KP,G,How) :- + (nonvar(KP) -> true ; kp(KP)), + ( xref_defined(KP,G,_), How=defined ; + xref_called(KP, Called, _By), (Called=_:G->true;Called=G), How=called_by(KP) + ), + \+ prolog:meta_goal(G,_), \+ system_predicate(G). + +%! predicate_argnames(+KP,?PredicateTemplate) is nondet. +% Grounds argument variables with their source names AS MUCH AS POSSIBLE, using system meta information from the clauses mentioning the predicate +% KP must be already loaded. Anonymous variables are not ground. +predicate_literal(M,Pred) :- must_be(nonvar,M), + (M:clause(Pred,Body,Ref) ; my_xref_called(M,Pred,By), clause(M:By,Body,Ref), \+ \+ contains_term(Pred,Body)), + clause_info(Ref,_,_,_,[variable_names(Names)]), + bind_vars_with_names(Pred:-Body,Names). +%TODO: should use a contains_term with variant/2 instead + +%! bind_vars_with_names(?Term,+VarNames) +% VarNames is a list of Name=Var +bind_vars_with_names(T,VN) :- bind_vars_with_names(T,VN,_). + +bind_vars_with_names(_,[],[]) :- !. +bind_vars_with_names(V,[Name=Var|VN],NewVN) :- var(V), !, + (var(Var) -> (Var=V,Name=Var,NewVN=VN) ; (bind_vars_with_names(V,VN,NewVN))). +bind_vars_with_names(X,VN,VN) :- atomic(X), !. +bind_vars_with_names([X1|Xn],VN1,VNn) :- !, bind_vars_with_names(X1,VN1,VN2), bind_vars_with_names(Xn,VN2,VNn). +bind_vars_with_names(X,VN1,VNn) :- compound_name_arguments(X,_,Args), bind_vars_with_names(Args,VN1,VNn). + +print_kp_predicates :- print_kp_predicates(_). + +% This also LOADS the modules, to access the examples: +print_kp_predicates(KP) :- %TODO: ignore subtrees of because/2 + all_kps_loaded, + forall(kp(KP),( + format("---~nKP: ~w~n",[KP]), + format(" Examples:~n"), + forall(catch(KP:example(Name,Scenarios),_,fail),( + aggregate(sum(N),( member(scenario(Facts,_Assertion),Scenarios), length(Facts,N)), Total), + format(" ~w: ~w facts~n",[Name,Total]) + )), + format(" Instance data:~n"), + forall(xref_defined(KP,G,thread_local(_)), ( + functor(G,F,N), format(" ~w~n",[F/N]) + )), + format(" Defined predicates:~n"), + forall((xref_defined(KP,G,How),How\=thread_local(_)), ( + functor(G,F,N), format(" ~w~n",[F/N]) + )), + format(" External predicates called:~n"), + forall(( + xref_called(KP, Called, _By), + Called=Other:G, Other\=KP, + (\+ prolog:meta_goal(G,_)) + ), + (functor(G,F,N), format(" ~w (~w)~n",[F/N,Other])) + ), + format(" UNDEFINED predicates:~n"), + forall(( + xref_called(KP, Called, _), + (Called=Other:G -> Other\=KP ; (Called=G,Other=KP)), + (\+ prolog:meta_goal(G,_)), + \+ my_xref_defined(Other,G,_), + \+ system_predicate(G) + ), + (functor(G,F,N), format(" ~w (~w)~n",[F/N,Other])) + ) + + )). + +% check that the source has already been xref'ed, otherwise xref would try to load it and cause an "iri_scheme" error: +my_xref_defined(M,G,Class) :- + xref_current_source(M), xref_defined(M,G,Class). +my_xref_called(M,Pred,By) :- + xref_current_source(M), xref_called(M,Pred,By). + +system_predicate(G) :- predicate_property(G,built_in). +system_predicate(G) :- kp_dir(D), predicate_property(G,file(F)), \+ sub_atom(F,_,_,_,D). +system_predicate(example(_,_)). +system_predicate(mainGoal(_,_)). +system_predicate(query(_,_)). +system_predicate(question(_,_)). +system_predicate(question(_,_,_)). +system_predicate(irrelevant_explanation(_)). +system_predicate(function(_,_)). + +url_simple(URL,Simple) :- \+ sub_atom(URL,_,_,_,'/'), !, + Simple=URL. +url_simple(URL,Simple) :- + parse_url(URL,L), memberchk(path(P),L), atomics_to_string(LL,'/',P), + ((last(LL,Simple),Simple\='') -> true ; + LL = [Simple] -> true; + append(_,[Simple,_],LL)), + !. +url_simple(URL,URL). + +:- meta_predicate(must_succeed(0,+)). +must_succeed(G,_) :- G, !. +must_succeed(G,M) :- throw("weird_failure_of of ~w: ~w"-[G,M]). + +must_succeed(G) :- must_succeed(G,''). + +:- thread_local myDeclaredModule_/1. % remembers the module declared in the last SWISH window loaded +% filters the SWISH declared module with known KPs; the term_expansion hack catches a lot of other modules too, such as 'http_stream' +myDeclaredModule(M) :- myDeclaredModule_(M), kp(M), !. + +swish_editor_path(KP,Path) :- must_be(nonvar,KP), + (kp_location(KP,File,true)->true;File=not_on_swish_storage), + format(string(Path),"/p/~a",[File]), !. + + +:- if(current_module(swish)). %%% only when running with the SWISH web server: +:- use_module(swish(lib/storage)). +:- use_module(swish(lib/gitty)). +:- use_module(library(pengines)). + +%! discover_kps_gitty is det. +% +% Scans all Prolog files in SWISH's gitty storage for knowledge pages. RELOADS +% already loaded modules, but does not delete "orphans" (modules no longer in gitty) +% TODO: use '$destroy_module'(M) on those? +discover_kps_gitty :- + retractall(kp_location(_,_,_,true)), + forall(storage_file_extension(File,pl),( + storage_file(File,Data,Meta), + open_string(Data, In), + process_file(In,File,Meta.time,true) + )). + +%! save_gitty_files(+ToDirectory) is det +% +% ERASES the directory and copies all gitty Prolog files into it +% MAKE SURE ToDirectory has source versioning control! +save_gitty_files(_ToDirectory) :- \+ storage_file_extension(_File,pl), !, + print_message(warning,"No gitty files to save"-[]). +save_gitty_files(ToDirectory) :- + (exists_directory(ToDirectory)->true; make_directory(ToDirectory)), + delete_directory_contents(ToDirectory), + forall(storage_file_extension(File,pl),( + storage_file(File,Data,Meta), + directory_file_path(ToDirectory,File,Path), + open(Path,write,S), write_term(S,Data,[]), close(S), + set_time_file(Path, _OldTimes, [modified(Meta.time)]) + )). + +save_gitty_files :- + kp_dir(D), save_gitty_files(D). + +%! load_gitty_files(+FromDirectory) is det +% +% Updates or creates (in gitty storage) all Prolog files from the given file system directory; sub-directories are ignored. +% Does not delete the other (pre-existing) gitty files +% Example: load_gitty_files('/Users/mc/git/TaxKB/kb'). +load_gitty_files(From) :- + forall(directory_member(From,Path,[extensions([pl])]),( + read_file_to_string(Path,Data,[]), + time_file(Path,Modified), + directory_file_path(_,File,Path), + update_gitty_file(File,Modified,From,Data) + )). + +load_gitty_files :- + kp_dir(D), load_gitty_files(D). + +% update_gitty_file(+Filename,+ModifiedTime,+Origin,+Text) +update_gitty_file(File,Modified,Origin,Data) :- + web_storage:open_gittystore(Store), + current_user(User,_Email), + (gitty_file(Store, File, OldHead) -> ( + storage_meta_data(File, Meta), + NewMeta = Meta.put([previous=OldHead, modify=[any, login, owner], (public)=true, time=Modified, author=User]), + gitty_update(Store, File, Data, NewMeta, _CommitRet) + ) ; ( + gitty_create(Store, File, Data, _{update_gitty_file:Origin, modify:[any, login, owner], public:true, time:Modified, author:User }, _CommitRet) + ) + ). + +update_gitty_file(File,Origin,Data) :- + get_time(Now), update_gitty_file(File,Now,Origin,Data). + +%! delete_gitty_file(+GittyFile) is det +% +% makes the file empty, NOT a proper delete +delete_gitty_file(File) :- + must_be(nonvar,File), + web_storage:open_gittystore(Store), + gitty_file(Store, File, OldHead), + % I was unable to effectively delete: + % gitty:delete_head(Store, OldHead), gitty:delete_object(Store, OldHead), % this is only effective after a SWISH restart + % broadcast(swish(deleted(File, OldHead))). % not doing anything, possibly missing something on the JS end + % ... instead this does roughly what the DELETE REST SWISH endpoint in storage.pl does: + storage_meta_data(File, Meta), + NewMeta = Meta.put([previous=OldHead]), + gitty_update(Store, File, "", NewMeta, _CommitRet). + +:- listen(swish(X),reactToSaved(X)). % note: do NOT use writes!, they would interfere with SWISH's internal REST API +/* +reactToSaved(created(GittyFile,Commit)) :- % discover and xref + storage_file(GittyFile,Data,Meta), process_file(Data,GittyFile,Meta.time,true), + reactToSaved(updated(GittyFile,Commit)). +reactToSaved(updated(GittyFile,_Commit)) :- % xref + kp_location(URL,GittyFile,true), + xref_source(URL,[silent(true)]). +*/ + +reactToSaved(created(GittyFile,Commit)) :- + reactToSaved(updated(GittyFile,Commit)). +reactToSaved(updated(GittyFile,_Commit)) :- % discover (module name may have changed...) and xref + %mylog(updated(GittyFile,_Commit)), + storage_file(GittyFile,Data,Meta), + open_string(Data,In), + must_succeed(process_file(In,GittyFile,Meta.time,true)), + (kp_location(URL,GittyFile,true) -> xref_source(URL,[silent(true)]) ; + print_message(warning,"Could not find URL for ~w"-[GittyFile])). + +%! edit_kp(URL) is det +% +% Open the current gitty version of the knowledge page in SWISH's editor +edit_kp(KP) :- + kp_location(KP,_File,InGitty), + (InGitty==(false) -> print_message(error,"~w is not in SWISH storage"-[KP]);( + swish_editor_path(KP,Path), + format(string(URL),"http://localhost:3050~a",[Path]), www_open_url(URL) + )). + +%%%% Knowledge pages graph + +:- multifile user:'swish renderer'/2. % to avoid SWISH warnings in other files +:- use_rendering(user:graphviz). + +knowledgePagesGraph(KP,dot(digraph([rankdir='LR'|Graph]))) :- + % xref_defined(KP, Goal, ?How) + setof(edge(From->To,[]), KP^Called^By^ByF^ByN^OtherKP^G^CalledF^CalledN^How^( + kp(KP), xref_called(KP, Called, By), + functor(By,ByF,ByN), From = at(ByF/ByN,KP), + (Called=OtherKP:G -> true ; ( once(xref_defined(KP,Called,How)), OtherKP=KP, G=Called)), + \+ prolog:meta_goal(G,_), + functor(G,CalledF,CalledN), To = at(CalledF/CalledN,OtherKP) + %term_string(From_,From,[quoted(false)]), term_string(To_,To,[quoted(false)]), url_simple(ArcRole_,ArcRole) + ),Edges), + setof(node(ID,[/*shape=Shape*/label=Label]), KP^Goal^How^GF^GN^From^EA^Pred^Abrev^( + ( + kp(KP), xref_defined(KP, Goal, How), + functor(Goal,GF,GN), + ID = at(GF/GN,KP) + ; + member(edge(From->ID,EA),Edges) % calls to undefined predicates + ), + ID=at(Pred,KP), url_simple(KP,Abrev), + format(string(Label),"~w at ~w",[Pred,Abrev]) + %(hypercube(R,ID) -> Shape=box3d ; Shape=ellipse) + ), Nodes), + append(Nodes,Edges,Items), + Graph=Items. + %(var(SizeInches) -> Graph=Items ; Graph = [size=SizeInches|Items]). + +knowledgePagesGraph(G) :- knowledgePagesGraph(_,G). + +:- multifile sandbox:safe_primitive/1. +sandbox:safe_primitive(kp_loader:knowledgePagesGraph(_,_)). +sandbox:safe_primitive(kp_loader:print_kp_predicates(_)). +sandbox:safe_primitive(kp_loader:load_gitty_files). %TODO: this should be restricted to power users +sandbox:safe_primitive(kp_loader:save_gitty_files). +sandbox:safe_primitive(kp_loader:all_kps_loaded). +sandbox:safe_primitive(web_storage:open_gittystore(_)). +sandbox:safe_primitive(gitty:gitty_file(_, _, _)). +sandbox:safe_primitive(gitty:load_commit(_,_,_)). +sandbox:safe_primitive(gitty:gitty_update(_, _, _, _, _)). +sandbox:safe_primitive(gitty:size_in_bytes(_,_)). +sandbox:safe_primitive(gitty:save_object(_,_,_,_)). +sandbox:safe_primitive(gitty:gitty_create(_,_,_,_,_)). + +%%%% assist editor navigation; cf. swish/web/js/codemirror/mode/prolog/prolog_server.js + +:- use_module(library(http/http_json)). +:- use_module(library(http/http_dispatch)). +:- use_module(library(http/http_parameters)). + +:- http_handler(codemirror(xref), token_references, []). +token_references(Request) :- + %http_read_json_dict(Request, Query, [value_string_as(atom)]), + http_parameters(Request, [arity(Arity,[integer]),text(Text,[]),type(Type,[]),file(Module,[optional(true)]),uuid(UUID,[optional(true)])]), + % UUID is the SWISH internal module for our current editor's text + % mylog(gotQuery/Type/Text/Arity/Module/UUID), + % asserta(my_request(Query)), % for debugging + (nonvar(UUID) -> (xref_module(UUID,MyModule), Ignorable=[UUID,MyModule]); Ignorable=[]), + catch(term_string(Term_,Text),_,fail), + functor(Term_,Functor,_), + (atom(Term_) -> functor(Term,Functor,Arity); Term=Term_), % hack to fix longclicks on body goals + (sub_atom(Type, 0, _, _, head) -> ( % a clause head + must_be(var,Module), + findall( _{title:Title,line:Line,file:File,target:Functor}, ( % regex built on the Javascript side from target + xref_called(OtherModule,_Mine:Term,By,_Cond,Line), functor(By,F,N), format(string(Title),"A call from ~w",[F/N]), + \+ member(OtherModule,Ignorable), + kp_location(OtherModule,File,_InGitty) + ),Locations) + ) ; + sub_atom(Type, 0, _, _, goal) -> ( % a goal in a clause body + findall( _{title:Title,line:Line,file:File,target:Functor}, ( + xref_defined(Module,Term,How), arg(1,How,Line), format(string(Title),"A definition for ~a",[Text]), + kp_location(Module,File,_InGitty) + ),Locations) + ) ; + throw(weird_token_type(Type)) + ), + %Solution = _{hello: "Good Afternoon!", functor:Functor, arity:Arity, module:File}, + reply_json_dict(Locations). + +% This at the end, as it activates the term expansion (no harm done otherwise, just some performance..): +user:term_expansion((:-module(M,L)),(:-module(M,L))) :- !, assert(myDeclaredModule_(M)). +:- multifile pengines:prepare_module/3. +:- thread_local myCurrentModule/1. % the new temporary SWISH module where our query runs +pengines:prepare_module(Module, swish, _Options) :- + % this seems to hold always, but commenting it out just in case...: assertion( \+ myCurrentModule(_)), + setup_kp_module(Module), + assert(myCurrentModule(Module)). + % should we perhaps use this_capsule...?? +% there is (just arrived from the SWISH editor) a fresher version To of the declared module From +% ...OR there WAS, although it no longer exists +shouldMapModule(From,To) :- myDeclaredModule(From), kp(From), myCurrentModule(To), !, + (moduleMapping(From,To)->true;(assert(moduleMapping(From,To)))). + +:- dynamic moduleMapping/2. % Nice module->transient SWISH module; remembers previous mappings, to support UI navigation later, e.g. from explanations + + +current_user(User,Email) :- + pengine_user(U), get_dict(user,U,User), Email=U.user_info.email, + !. +current_user(unknown_user,unknown_email). + +:- else. % vanilla SWI-Prolog + +current_user(unknown_user,unknown_email). + +shouldMapModule(_,_) :- fail. +moduleMapping(_,_) :- fail. + +%! edit_kp(URL) is det +% +% Open the filed version of the knowledge page in the user editor +edit_kp(URL) :- + kp_location(URL,File,InGitty), + (InGitty==(true) -> print_message(error,"That is in SWISH storage, not in the file system!");( + edit(file(File)) + )). + +discover_kps_gitty :- print_message(informational,'this only works on SWISH'-[]). +load_gitty_files :- throw('this only works on SWISH '). +load_gitty_files(_) :- throw('this only works on SWISH '). +save_gitty_files(_) :- throw('this only works on SWISH '). +save_gitty_files :- throw('this only works on SWISH '). +delete_gitty_file(_) :- throw('this only works on SWISH '). +update_gitty_file(_,_,_) :- throw('this only works on SWISH '). + +knowledgePagesGraph(_,_) :- throw('this only works on SWISH'). +knowledgePagesGraph(_) :- throw('this only works on SWISH'). +gitty_file(_,_,_) :- throw('this only works in SWISH gitty'). +gitty_update(_, _, _, _, _) :- throw('this only works in SWISH gitty'). +:- endif. \ No newline at end of file diff --git a/examples/multi-file-generation/project/prolog/le_answer.pl b/examples/multi-file-generation/project/prolog/le_answer.pl new file mode 100755 index 00000000..72357e98 --- /dev/null +++ b/examples/multi-file-generation/project/prolog/le_answer.pl @@ -0,0 +1,988 @@ +/* le_answer: a prolog module with predicates to handle queries in Logical English + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. + +Main predicate: answer/1, /2, /3, /4 + +which can be used on the new command interface of LE on SWISH +(e.g. answer/1 and others querying predicates): + +? answer("query one with scenario test"). + +*/ + +:- module(le_answer, + [le_taxlog_translate/4, + translate_goal_into_LE/2, + op(1000,xfy,user:and), % to support querying + op(800,fx,user:resolve), % to support querying + op(800,fx,user:answer), % to support querying + op(800,fx,user:répondre), % to support querying in french + op(850,xfx,user:with), % to support querying + op(850,xfx,user:avec), % to support querying in french + op(800,fx,user:risposta), % to support querying in italian + op(850,xfx,user:con), % to support querying in italian + op(800,fx,user:responde), % to support querying in spanish + %op(1150,fx,user:show), % to support querying + op(850,xfx,user:of), % to support querying + %op(850,fx,user:'#pred'), % to support scasp + %op(800,xfx,user:'::'), % to support scasp + op(950, xfx, ::), % pred not x :: "...". + op(1200, fx, #), + op(1150, fx, pred), + op(1150, fx, show), + op(1150, fx, abducible), + dump/4, dump/3, dump/2, dump_scasp/3, split_module_name/3, + prepare_query/6, assert_facts/2, retract_facts/2, parse_and_query/5, parse_and_query_and_explanation/5, + le_expanded_terms/2, show/1, source_lang/1, targetBody/6 + ]). + +%:- use_module(library(sandbox)). +:- use_module(library(pengines_sandbox)). + +% required for sCASP justification (from ~/git/swish/pack/sCASP/examples) + +% :- use_module(library(scasp)). +% :- use_module(library(scasp/html)). +% :- use_module(library(scasp/output)). +% :- use_module(library(scasp/json)). + +% :- use_module(library(http/http_server)). +% :- use_module(library(http/html_write)). +% :- use_module(library(http/js_write)). +% :- use_module(library(http/html_head)). +% :- use_module(library(http/http_path)). +% :- use_module(library(http/http_error)). +% :- use_module(library(http/jquery)). +% :- use_module(library(http/http_dispatch)). +% :- use_module(library(dcg/high_order)). +% :- use_module(library(http/term_html)). +% :- use_module(library(http/http_json)). +% :- use_module(library(http/http_client)). +% :- use_module(library(http/http_host)). + +%:- multifile sandbox:safe_primitive/1. +%:- multifile sandbox:safe_meta/2. + +:- use_module('le_input.pl'). +:- use_module('syntax.pl'). +:- use_module('api.pl'). +:- use_module('reasoner.pl'). +:- use_module('./tokenize/prolog/tokenize.pl'). + + +% html libs +:- use_module(library(http/html_write)). +:- use_module(library(http/term_html)). +:- use_module(library(http/js_write)). + +:- multifile http:location/3. +:- dynamic http:location/3. + +% Does justification tree needs this? + +%http:location(scasp, root(scasp), []). +%http:location(js, scasp(js), []). +%http:location(css, scasp(css), []). + +:- discontiguous statement/3, declaration/4, _:example/2, _:query/2, _:is_/2. + +/* --------------------------------------------------------------- meta predicates CLI */ + +is_it_illegal(English, Scenario) :- % only event as possibly illegal for the time being + (le_input:parsed -> true; fail), !, + translate_query(English, happens(Goal, T)), % later -->, Kbs), + %print_message(informational, "Goal Name: ~w"-[GoalName]),predef_ + this_capsule(SwishModule), %SwishModule:query(GoalName, Goal), + %extract_goal_command(Question, SwishModule, Goal, Command), + %copy_term(Goal, CopyOfGoal), + %translate_goal_into_LE(CopyOfGoal, RawGoal), name_as_atom(RawGoal, EnglishQuestion), + %print_message(informational, "Testing illegality: ~w"-[EnglishQuestion]), + %print_message(informational, "Scenario: ~w"-[Scenario]), + get_assumptions_from_scenario(Scenario, SwishModule, Assumptions), + setup_call_catcher_cleanup(assert_facts(SwishModule, Assumptions), + %catch(SwishModule:holds(Goal), Error, ( print_message(error, Error), fail ) ), + %catch(Command, Error, ( print_message(error, Error), fail ) ), + catch(SwishModule:it_is_illegal(Goal, T), Error, ( print_message(error, Error), fail ) ), + _Result, + retract_facts(SwishModule, Assumptions)), + translate_goal_into_LE(Goal, RawAnswer), name_as_atom(RawAnswer, EnglishAnswer), + print_message(informational, "Answers: ~w"-[EnglishAnswer]). + +% extract_goal_command/4 +% extract_goal_command(WrappedGoal, Module, InnerGoal, RealGoal) +extract_goal_command(Goal, M, InnerGoal, Command) :- nonvar(Goal), + extract_goal_command_(Goal, M, InnerGoal, Command). + +extract_goal_command_((A;B), M, (IA;IB), (CA;CB)) :- + extract_goal_command_(A, M, IA, CA), extract_goal_command_(B, M, IB, CB), !. +extract_goal_command_((A,B), M, (IA,IB), (CA,CB)) :- + extract_goal_command_(A, M, IA, CA), extract_goal_command_(B, M, IB, CB), !. +extract_goal_command_(holds(Goal,T), M, Goal, (holds(Goal,T);M:holds(Goal,T))) :- !. +extract_goal_command_(happens(Goal,T), M, Goal, (happens(Goal,T);M:happens(Goal,T))) :- !. +extract_goal_command_(Goal, M, Goal, M:Goal) :- !. + +get_assumptions_from_scenario(noscenario, _, []) :- !. +get_assumptions_from_scenario(Scenario, SwishModule, Assumptions) :- + SwishModule:example(Scenario, [scenario(Assumptions, _)]), !. + +translate_query(English_String, Goals) :- + tokenize(English_String, Tokens, [cased(true), spaces(true), numbers(false)]), + unpack_tokens(Tokens, UTokens), + clean_comments(UTokens, CTokens), + phrase(conditions(0, [], _, Goals), CTokens) -> true + ; ( error_notice(error, Me,Pos, ContextTokens), print_message(error, [Me,Pos,ContextTokens]), fail ). + +/* ----------------------------------------------------------------- Event Calculus */ +% holds/2 +holds(Fluent, T) :- + this_capsule(SwishModule), %trace, + SwishModule:happens(Event, T1), + rbefore(T1,T), + SwishModule:initiates(Event, Fluent, T1), + %(nonvar(T) -> rbefore(T1,T); T=(after(T1)-_)), % T1 is strictly before T 'cos T is not a variable + %(nonvar(T) -> rbefore(T1,T); true), + not(interrupted(T1, Fluent, T)). + +rbefore(T1, T) :- + nonvar(T1), nonvar(T), isbefore(T1, T). %, !. +%rbefore(T1, T) :- (var(T1); var(T)), !. % if anyone is a variable, don't compute +%rbefore(T1, (after(T2)-_)) :- +% nonvar(T1), nonvar(T2), before(T1, T2). + +% interrupted/3 +interrupted(T1, Fluent, T2) :- %trace, + this_capsule(SwishModule), + SwishModule:happens(Event, T), + rbefore(T, T2), + SwishModule:terminates(Event, Fluent, T), + (rbefore(T1, T); T1=T), !. + %(nonvar(T2) -> rbefore(T, T2) ; true ), !. + %(T2=(after(T1)-_)->T2=(after(T1)-before(T)); rbefore(T,T2)). + +/* ----------------------------------------------------------------- CLI English */ +% answer/1 +% answer(+Query or Query Expression) +answer(English) :- %trace, + answer(English, empty). + +% answer/2 +% answer(+Query, with(+Scenario)) +answer(English, Arg) :- %trace, + le_input:parsed, + prepare_query(English, Arg, SwishModule, Goal, Facts, Command), + ((SwishModule:just_saved_scasp(FileName, ModuleName), FileName\=null) -> + %print_message(informational, "To query file ~w in module ~w "-[FileName, ModuleName]), + load_file_module(FileName, ModuleName, true), + %print_message(informational, "loaded scasp ~w "-[FileName]), + setup_call_catcher_cleanup(assert_facts(ModuleName, Facts), + catch(ModuleName:scasp(Goal, [model(_M), tree(_T)]), Error, ( print_message(error, Error), fail ) ), + _Result, + retract_facts(ModuleName, Facts)) + ; %print_message(error, "no scasp"-[]), + setup_call_catcher_cleanup(assert_facts(SwishModule, Facts), + Command, + %call(Command), + %catch_with_backtrace(Command, Error, print_message(error, Error)), + %catch((true, Command), Error, ( print_message(error, Error), fail ) ), + _Result, + retract_facts(SwishModule, Facts)) + ), + %retractall(SwishModule:just_saved_scasp(_, _)), + show_answer(Goal). + +% answer/3 +% answer(+English, with(+Scenario), -Result) +answer(English, Arg, EnglishAnswer) :- %trace, + le_input:parsed, + prepare_query(English, Arg, SwishModule, Goal, Facts, Command), + % this_capsule(SwishModule), + % translate_command(SwishModule, English, _, Goal, PreScenario), % later -->, Kbs), + % %copy_term(Goal, CopyOfGoal), + % %translate_goal_into_LE(CopyOfGoal, RawGoal), name_as_atom(RawGoal, EnglishQuestion), + % ((Arg = with(ScenarioName), PreScenario=noscenario) -> Scenario=ScenarioName; Scenario=PreScenario), + % extract_goal_command(Goal, SwishModule, _InnerGoal, Command), + % (Scenario==noscenario -> Facts = [] ; SwishModule:example(Scenario, [scenario(Facts, _)])), + %module(SwishModule), + %print_message(informational, "Calling ~w with ~w on ~w "-[Command, Facts, SwishModule]), + setup_call_catcher_cleanup(assert_facts(SwishModule, Facts), + catch_with_backtrace(Command, Error, print_message(error, Error)), + %catch(Command, Error, ( print_message(error, Error), fail ) ), + _Result, + retract_facts(SwishModule, Facts)), + %print_message(informational, "The Answer is: ~w and the Result ~w"-[Command, Result]), + translate_goal_into_LE(Goal, RawAnswer), name_as_atom(RawAnswer, EnglishAnswer). + %reasoner:query_once_with_facts(Goal,Scenario,_,_E,Result). + +% answer/4 +% answer(+English, with(+Scenario), -Explanations, -Result) :- +% answer(at(English, Module), Arg, E, Result) :- %trace, +answer(English, Arg, E, Result) :- %trace, + le_input:parsed, %myDeclaredModule(Module), + this_capsule(SwishModule), + translate_command(SwishModule, English, _, Goal, PreScenario), + ((Arg = with(ScenarioName), PreScenario=noscenario) -> Scenario=ScenarioName; Scenario=PreScenario), + extract_goal_command(Goal, SwishModule, InnerGoal, _Command), + (Scenario==noscenario -> Facts = [] ; SwishModule:example(Scenario, [scenario(Facts, _)])), !, + setup_call_catcher_cleanup(assert_facts(SwishModule, Facts), + catch((true, reasoner:query(at(InnerGoal, SwishModule),_,E,Result)), Error, ( print_message(error, Error), fail ) ), + _Result, + retract_facts(SwishModule, Facts)). + +% prepare_query/6 +% prepare_query(+English, +Arguments, -Module, -Goal, -Facts, -Command) +% prepare_query(English, Arg, SwishModule, Goal, Facts, Command) :- %trace, +% %restore_dicts, +% pengine_self(SwishModule), +% (translate_command(SwishModule, English, GoalName, Goal, PreScenario) -> true +% ; ( print_message(error, "Don't understand this question: ~w "-[English]), !, fail ) ), % later -->, Kbs), +% copy_term(Goal, CopyOfGoal), +% translate_goal_into_LE(CopyOfGoal, RawGoal), name_as_atom(RawGoal, EnglishQuestion), +% ((Arg = with(ScenarioName), PreScenario=noscenario) -> Scenario=ScenarioName; Scenario=PreScenario), +% show_question(GoalName, Scenario, EnglishQuestion), +% %print_message(informational, "Scenario: ~w"-[Scenario]), +% (Scenario==noscenario -> Facts = [] ; +% (SwishModule:example(Scenario, [scenario(Facts, _)]) -> +% true; print_message(error, "Scenario: ~w does not exist"-[Scenario]))), +% %print_message(informational, "Facts: ~w"-[Facts]), +% extract_goal_command(Goal, SwishModule, _InnerGoal, Command), !. +% %print_message(informational, "Command: ~w"-[Command]). + +% prepare_query(+English, +Arguments, -Module, -Goal, -Facts, -Command) +prepare_query(English, Arg, SwishModule, Goal, Facts, Command) :- %trace, + %restore_dicts, + var(SwishModule), this_capsule(SwishModule), !, + %print_message(informational, "Module at prepare query ~w"-[SwishModule]), + translate_command(SwishModule, English, GoalName, Goal, PreScenario), + %print_message(informational, "SwisModule: ~w, English ~w, GoalName ~w, Goal ~w, Scenario ~w"-[SwishModule, English, GoalName, Goal, PreScenario]), + copy_term(Goal, CopyOfGoal), + translate_goal_into_LE(CopyOfGoal, RawGoal), name_as_atom(RawGoal, EnglishQuestion), + ((Arg = with(ScenarioName), PreScenario=noscenario) -> Scenario=ScenarioName; Scenario=PreScenario), + show_question(GoalName, Scenario, EnglishQuestion), + %print_message(informational, "Scenario: ~w"-[Scenario]), + (Scenario==noscenario -> Facts = [] ; + (SwishModule:example(Scenario, [scenario(Facts, _)]) -> + true; print_message(error, "Scenario: ~w does not exist"-[Scenario]))), + %print_message(informational, "Facts: ~w"-[Facts]), + extract_goal_command(Goal, SwishModule, _InnerGoal, Command), !. + %print_message(informational, "Command: ~w"-[Command]). + +% prepare_query(+English, +Arguments, +Module, -Goal, -Facts, -Command) +prepare_query(English, Arg, SwishModule, Goal, Facts, Command) :- %trace, + %restore_dicts, + nonvar(SwishModule), + %with_output_to(string(Report), listing(dict/3)), + %print_message(informational, "prepare_query (1): Dictionaries in memory ~w\n"-[Report]), + translate_command(SwishModule, English, GoalName, Goal, PreScenario), + copy_term(Goal, CopyOfGoal), + %print_message(informational, "prepare_query (2): translated ~w into goalname ~w goal ~w with scenario ~w\n "-[English,GoalName,Goal,PreScenario]), + translate_goal_into_LE(CopyOfGoal, RawGoal), name_as_atom(RawGoal, EnglishQuestion), + ((Arg = with(ScenarioName), PreScenario=noscenario) -> Scenario=ScenarioName; Scenario=PreScenario), + show_question(GoalName, Scenario, EnglishQuestion), + %print_message(informational, "prepare_query (3): Scenario: ~w"-[Scenario]), + (Scenario==noscenario -> Facts = [] ; + (SwishModule:example(Scenario, [scenario(Facts, _)]) -> + true; print_message(error, "Scenario: ~w does not exist"-[Scenario]))), + %print_message(informational, "prepare_query (4): Facts: ~w Goal: ~w Module: ~w\n "-[Facts, Goal, SwishModule]), + extract_goal_command(Goal, SwishModule, _InnerGoal, Command), !. + %print_message(informational, "prepare_query (5): Ready from ~w the command ~w\n"-[English, Command]). + +prepare_query(English, _, _, _, _, _) :- + print_message(error, "Don't understand this question: ~w "-[English]). + +show_question(GoalName, Scenario, NLQuestion) :- (this_capsule(M); current_module(M)), + (M:source_lang(en) -> print_message(informational, "Query ~w with ~w: ~w"-[GoalName, Scenario, NLQuestion]); true), + (M:source_lang(fr) -> print_message(informational, "La question ~w avec ~w: ~w"-[GoalName, Scenario, NLQuestion]); true), + (M:source_lang(it) -> print_message(informational, "Domanda ~w con ~w: ~w"-[GoalName, Scenario, NLQuestion]); true), + (M:source_lang(es) -> print_message(informational, "La pregunta ~w con ~w: ~w"-[GoalName, Scenario, NLQuestion]); true), + (\+(M:source_lang(_)) -> print_message(informational, "Query ~w with ~w: ~w"-[GoalName, Scenario, NLQuestion]); true), + !. + +show_answer(Goal) :- %trace, + this_capsule(M), + translate_goal_into_LE(Goal, RawAnswer), name_as_atom(RawAnswer, NLAnswer), + (M:source_lang(en) -> print_message(informational, "Answer: ~w"-[NLAnswer]); true), + (M:source_lang(fr) -> print_message(informational, "La réponse: ~w"-[NLAnswer]); true), + (M:source_lang(it) -> print_message(informational, "Risposta: ~w"-[NLAnswer]); true), + (M:source_lang(es) -> print_message(informational, "La respuesta: ~w"-[NLAnswer]); true), + (\+(M:source_lang(_)) -> print_message(informational, "Answer: ~w"-[NLAnswer]); true), % english as default + !. + +% translate_goal_into_LE/2 +% translate_goal_into_LE(+Goals_after_being_queried, -Goals_translated_into_LEnglish_as_answers) +translate_goal_into_LE((G,R), WholeAnswer) :- + translate_goal_into_LE(G, Answer), + translate_goal_into_LE(R, RestAnswers), !, + append(Answer, ['\n','\t',and|RestAnswers], WholeAnswer). +translate_goal_into_LE(aggregate_all(sum(V),Conditions,R), [R,is,the,sum,of,each,V,such,that,'\n', '\t'|Answer]) :- + translate_goal_into_LE(Conditions, Answer), !. +translate_goal_into_LE(not(G), [it,is,not,the,case,that,'\n', '\t'|Answer]) :- + translate_goal_into_LE(G, Answer), !. +translate_goal_into_LE(Goal, ProcessedWordsAnswers) :- + %print_message(informational, "translated_goal_into_LE: (meta) from ~w\n"-[Goal]), + Goal =.. [Pred|GoalElements], meta_dictionary([Pred|GoalElements], Types, WordsAnswer), + process_types_or_names(WordsAnswer, GoalElements, Types, ProcessedWordsAnswers), !. + %print_message(informational, "translated_goal_into_LE: from ~w to ~w "-[Goal, ProcessedWordsAnswers]). +translate_goal_into_LE(Goal, ProcessedWordsAnswers) :- + %print_message(informational, "translated_goal_into_LE: from ~w\n"-[Goal]), + Goal =.. [Pred|GoalElements], dictionary([Pred|GoalElements], Types, WordsAnswer), + process_types_or_names(WordsAnswer, GoalElements, Types, ProcessedWordsAnswers), !. + %print_message(informational, "translated_goal_into_LE: from ~w to ~w "-[Goal, ProcessedWordsAnswers]). +translate_goal_into_LE(happens(Goal,T), Answer) :- % simple goals do not return a list, just a literal + Goal =.. [Pred|GoalElements], dictionary([Pred|GoalElements], Types, WordsAnswer), + process_types_or_names(WordsAnswer, GoalElements, Types, ProcessedWordsAnswers), + process_time_term(T, TimeExplain), !, + Answer = ['At', TimeExplain, it, occurs, that|ProcessedWordsAnswers]. +translate_goal_into_LE(holds(Goal,T), Answer) :- + Goal =.. [Pred|GoalElements], dictionary([Pred|GoalElements], Types, WordsAnswer), + process_types_or_names(WordsAnswer, GoalElements, Types, ProcessedWordsAnswers), + process_time_term(T, TimeExplain), + Answer = ['At', TimeExplain, it, holds, that|ProcessedWordsAnswers], !. + +process_time_term(T,ExplainT) :- var(T), name_as_atom([a, time, T], ExplainT). % in case of vars +process_time_term(T,T) :- nonvar(T), atom(T), !. +process_time_term(T,Time) :- nonvar(T), number(T), T>100, unparse_time(T, Time), !. +process_time_term(T,Time) :- nonvar(T), number(T), T=<100, T=Time, !. % hack to avoid standard time transformation +process_time_term((after(T)-Var), Explain) :- var(Var), !, + process_time_term(T, Time), + name_as_atom([any, time, after, Time], Explain). +process_time_term((after(T1)-before(T2)), Explain) :- !, + process_time_term(T1, Time1), process_time_term(T2, Time2), + name_as_atom([any, time, after, Time1, and, before, Time2], Explain). + +%process_template_for_scasp/4 +%process_template_for_scasp(WordsAnswer, GoalElements, Types, +FormatElements, +ProcessedWordsAnswers) +process_template_for_scasp([], _, _, [], []) :- !. +process_template_for_scasp([Word|RestWords], Elements, Types, [' @(~p:~w) '|RestFormat], [Word, TypeName|RestPrintWords]) :- + var(Word), matches_type(Word, Elements, Types, Type), + process_template_for_scasp(RestWords, Elements, Types, RestFormat, RestPrintWords), + tokenize_atom(Type, NameWords), delete_underscore(NameWords, [TypeName]), escape_uppercased(TypeName, _), !. +process_template_for_scasp([Word|RestWords], Elements, Types, [' @(~p:~p) '|RestFormat], [Word, TypeName|RestPrintWords]) :- + var(Word), matches_type(Word, Elements, Types, Type), !, + process_template_for_scasp(RestWords, Elements, Types, RestFormat, RestPrintWords), + tokenize_atom(Type, NameWords), delete_underscore(NameWords, [TypeName]). +process_template_for_scasp([Word|RestWords], Elements, Types, RestFormat, RestPrintWords ) :- % skipping apostrofes by now + nonvar(Word), Word = '\'', !, + process_template_for_scasp(RestWords, Elements, Types, RestFormat, RestPrintWords). +process_template_for_scasp([Word|RestWords], Elements, Types, ['~p'|RestFormat], [Word|RestPrintWords] ) :- + op_stop(List), member(Word,List), !, + process_template_for_scasp(RestWords, Elements, Types, RestFormat, RestPrintWords). +process_template_for_scasp([Word|RestWords], Elements, Types, [' ~w '|RestFormat], [Word|RestPrintWords] ) :- + escape_uppercased(Word, _), !, + %name(Word, List), + %print_message(informational, "processing word ~p ~q"-[Word, List]), + process_template_for_scasp(RestWords, Elements, Types, RestFormat, RestPrintWords). +process_template_for_scasp([Word|RestWords], Elements, Types, [' ~p '|RestFormat], [Word|RestPrintWords] ) :- + process_template_for_scasp(RestWords, Elements, Types, RestFormat, RestPrintWords). + +escape_uppercased(Word, EscapedWord) :- + name(Word, [First|Rest]), First >= 65, First =< 90, + append([92, First|Rest], [92], NewCodes), + name(EscapedWord, NewCodes). + +assert_facts(_, []) :- !. +assert_facts(SwishModule, [F|R]) :- nonvar(F), % print_message(informational, "asserting: ~w"-[SwishModule:F]), + assertz(SwishModule:F), assert_facts(SwishModule, R). + +retract_facts(_, []) :- !. +retract_facts(SwishModule, [F|R]) :- nonvar(F), %print_message(informational, "retracting: ~w"-[SwishModule:F]), + retract(SwishModule:F), retract_facts(SwishModule, R). + +% translate_command/1 +translate_command(SwishModule, English_String, GoalName, Goals, Scenario) :- %trace, + tokenize(English_String, Tokens, [cased(true), spaces(true), numbers(false)]), + unpack_tokens(Tokens, UTokens), + clean_comments(UTokens, CTokens), + phrase(command_(GoalName, Scenario), CTokens), + %print_message(informational, "GoalName ~w SwishModule ~w"-[GoalName, SwishModule]), + ( SwishModule:query(GoalName, Goals) -> true; (print_message(informational, "No goal named: ~w"-[GoalName]), fail) ), !. + +translate_command(_, English_String, GoalName, Goals, Scenario) :- + tokenize(English_String, Tokens, [cased(true), spaces(true), numbers(false)]), + unpack_tokens(Tokens, UTokens), + clean_comments(UTokens, CTokens), Scenario=noscenario, GoalName=nonamed, + (phrase(conditions(0, [], _, Goals), CTokens) -> true ; + ( once(error_notice(error, Me,_, ContextTokens)), print_message(informational, "~w ~w"-[Me,ContextTokens]), CTokens=[], fail ) + ). + +command_(Goal, Scenario) --> + %order_, goal_(Goal), with_, scenario_name_(Scenario). + goal_(Goal), with_, scenario_name_(Scenario). +command_(Goal, noscenario) --> + goal_(Goal). + +%order_ --> [answer], spaces(_). +%order_ --> [run], spaces(_). +%order_ --> [solve], spaces(_). +%order_ --> [resolve], spaces(_). + +goal_(Goal) --> query_or_empty, extract_constant([with], GoalWords), spaces(_), + {name_as_atom(GoalWords, Goal)}. % goal by name + +query_or_empty --> query_. +query_or_empty --> []. + +with_ --> [with], spaces(_). + +scenario_name_(Scenario) --> scenario_or_empty_, extract_constant([], ScenarioWords), spaces(_), +{name_as_atom(ScenarioWords, Scenario)}. % Scenario by name + +scenario_or_empty_ --> [scenario], spaces(_). +scenario_or_empty_ --> spaces(_). + +% show/1 +show(prolog) :- + %print_message(informational, "About to show prolog code"), + show(metarules), + show(rules), + show(queries), + show(scenarios). + +show(rules) :- % trace, + this_capsule(SwishModule), + findall((Pred :- Body), + (dict(PredicateElements, _, _), PredicateElements\=[], Pred=..PredicateElements, + clause(SwishModule:Pred, Body_), unwrapBody(Body_, Body)), Predicates), + forall(member(Clause, [(is_(A,B) :- (nonvar(B), is(A,B)))|Predicates]), portray_clause_ind(Clause)). + +% +%(op2tokens(Pred, _, OpTokens) -> % Fixing binary predicates for scasp +%( append([X|_], [Y], GoalElements), +% append([X|OpTokens],[Y], RevGoalElements), +% print_message(informational, "binary op ~w"-[Pred]) ) +%; RevGoalElements = GoalElements +%), + +show(metarules) :- % trace, + this_capsule(SwishModule), + findall((Pred :- Body), + (meta_dict(PredicateElements, _, _), PredicateElements\=[], + Pred=..PredicateElements, clause(SwishModule:Pred, Body_), unwrapBody(Body_, Body)), Predicates), + forall(member(Clause, Predicates), portray_clause_ind(Clause)). + +show(queries) :- % trace, + this_capsule(SwishModule), + findall((query(A,B) :- true), + (clause(SwishModule:query(A,B), _)), Predicates), + forall(member(Clause, Predicates), portray_clause_ind(Clause)). + +show(scenarios) :- % trace, + this_capsule(SwishModule), + findall((example(A,B) :- true), + (clause(SwishModule:example(A,B), _)), Predicates), + forall(member(Clause, Predicates), portray_clause_ind(Clause)). + +show(templates) :- + findall(EnglishAnswer, + ( ( meta_dictionary([_|GoalElements], Types, WordsAnswer) ; + dictionary([_|GoalElements], Types, WordsAnswer)), + process_types_or_names(WordsAnswer, GoalElements, Types, ProcessedWordsAnswers), + name_as_atom(ProcessedWordsAnswers, EnglishAnswer)), Templates), + forall(member(T, Templates), print_message(informational, "~w"-[T])). + +show(templates_scasp) :- + findall(Term, + ( ( meta_dict([Pred|GoalElements], Types, WordsAnswer) ; + dict([Pred|GoalElements], Types, WordsAnswer)), + Goal =.. [Pred|GoalElements], + process_template_for_scasp(WordsAnswer, GoalElements, Types, FormatEl, LE), + atomic_list_concat(['#pred ~w ::\''|FormatEl], Format), + Elements = [Goal|LE], + numbervars(Elements, 1, _), + format(atom(Term), Format, Elements)), Templates), + forall(member(T, Templates), (atom_string(T, R), print_message(informational, "~w\'."-[R]))). + +show(types) :- + %findall(EnglishAnswer, + % ( dictionary([_|GoalElements], Types, _), + % member((Name-Type), Types), + % process_types_or_names([Type], GoalElements, Types, ProcessedWordsAnswers), + % name_as_atom(ProcessedWordsAnswers, EnglishAnswer)), Templates), + print_message(information, "Pre-defined Types:"-[]), + setof(Tpy, pre_is_type(Tpy), PreSet), + forall(member(Tp, PreSet),print_message(informational, '~a'-[Tp])), + print_message(informational, "Types defined in the current document:"-[]), + setof(Ty, is_type(Ty), Set), + forall(member(T, Set), print_message(informational, '~a'-[T])). + +show(scasp) :- + show(templates_scasp), + show(metarules), + show(rules). + +show(scasp, with(Q, S)) :- + show(scasp), + this_capsule(SwishModule), + clause(SwishModule:query(Q,Query), _), + clause(SwishModule:example(S, [scenario(Scenario, _)]), _), + %print_message(informational, "% scenario ~w ."-[List]), + forall(member(Clause, Scenario), portray_clause_ind(Clause)), + print_message(informational, "/** \n?- ? ~w .\n **/ "-[Query]). + +show(scasp, with(Q)) :- + show(scasp), + this_capsule(SwishModule), + clause(SwishModule:query(Q,Query), _), + print_message(informational, "/** \n?- ? ~w .\n **/ "-[Query]). + +unwrapBody(targetBody(Body, _, _, _, _, _), Body). + +% hack to bring in the reasoner for explanations. +targetBody(G, false, _, '', [], _) :- + this_capsule(SwishModule), extract_goal_command(G, SwishModule, _InnerG, Command), + %print_message(informational, "Reducing ~w to ~w"-[G,Command]), + call(Command). + +dump(templates, String) :- + findall(local_dict(Prolog, NamesTypes, Templates), (le_input:dict(Prolog, NamesTypes, Templates)), PredicatesDict), + with_output_to(string(String01), forall(member(Clause1, PredicatesDict), portray_clause_ind(Clause1))), + (PredicatesDict==[] -> string_concat("local_dict([],[],[]).\n", String01, String1); String1 = String01), + findall(local_meta_dict(Prolog, NamesTypes, Templates), (le_input:meta_dict(Prolog, NamesTypes, Templates)), PredicatesMeta), + with_output_to(string(String02), forall(member(Clause2, PredicatesMeta), portray_clause_ind(Clause2))), + (PredicatesMeta==[] -> string_concat("local_meta_dict([],[],[]).\n", String02, String2); String2 = String02), + string_concat(String1, String2, String). + +dump(templates_scasp, String) :- + findall(Pred/N, ( ( meta_dict([Pred|GoalElements], Types, WordsAnswer) ; + dict([Pred|GoalElements], _, _) ), + length(GoalElements, N) ), + Functors), + (Functors\=[] -> + write_functors_to_string(Functors, "", StringFunctors), + string_concat(":- dynamic ", StringFunctors, String0 ), + string_concat(String0, ".\n", String1) + ; String1 = "" + ), + findall(Term, + ( ( meta_dict([Pred|GoalElements], Types, WordsAnswer) ; + dict([Pred|GoalElements], Types, WordsAnswer)), + Goal =.. [Pred|GoalElements], + process_template_for_scasp(WordsAnswer, GoalElements, Types, FormatEl, LE), + atomic_list_concat(['#pred ~p :: \''|FormatEl], Format), + Elements = [Goal|LE], + numbervars(Elements, 1, _), + format(atom(Term), Format, Elements) ), Templates), + with_output_to(string(String2), forall(member(T, Templates), (atom_string(T, R),write(R),write("\'.\n")))), + string_concat(String1, String2, String). + +dump(source_lang, String) :- + le_input:source_lang(L) -> + with_output_to(string(String), portray_clause_ind(source_lang(L))) ; String="". + +dump(source_lang_scasp, String) :- + le_input:source_lang(L) -> + with_output_to(string(String), portray_clause_ind(:- set_prolog_flag(scasp_lang, L))) ; String="". + +% #abducible +dump(abducibles_scasp, List, String) :- + findall(Term, ( member( abducible(Abducible, _), List), Abducible\=true, format(string(Term), "#abducible ~p", [Abducible]) ), Abds), + with_output_to(string(String), forall(member(S, Abds), (term_string(T, S), portray_clause_ind(T)))). + + +dump(scasp_scenarios_queries, List, String) :- + findall( example(Name, Scenario), + (member( example(Name, Scenario), List)), Scenarios), + %print_message(informational, "Scenarios ~w"-[Scenarios]), + % example(one, [scenario( + % [(the_service_is_delivered_before(1654423200.0):-true), + % (the_service_recipient_maintains_all_communication_within_the_confines_of(domain):-true), + % (the_service_recipient_delivers_requested_information_before(1654077600.0):-true), + % (is_signed_by_the_service_provider(the_contract):-true), + % (is_also_signed_by_the_service_recipient(the_contract):-true) + % ], true)]). + with_output_to(string(StringScenarios), + ( forall(member(example(S, [scenario(Scenario, _)]), Scenarios), + ( write("/* Scenario "), write(S), write("\n"), % simple comment not for PlDoc + forall((member(Clause, Scenario),Clause\=(abducible(_,_) :- _)), portray_clause_ind(Clause)), + forall((member(Clause, Scenario),Clause=(abducible(Abd,_) :- _)), + (format(string(String), "#abducible ~p", [Abd]), term_string(Term, String), portray_clause_ind(Term))), + write("% */ \n") + ) + ) + ) + ), + with_output_to(string(String00), write("/** \n")), + findall( Query, (member( query(_, Query), List), Query\=true), Queries), + with_output_to(string(String01), forall(member(Q, Queries), ( write("?- ? "), writeq(Q), write(".\n") ))), + with_output_to(string(String0N), write("**/")), + string_concat(String00, String01, String02), + string_concat(String02, String0N, StringQueries), + string_concat(StringScenarios, StringQueries, String). + +dump(rules, List, String) :- %trace, + findall((Pred :- Body), + (member( (Pred :- Body_), List), unwrapBody(Body_, Body)), Predicates), + with_output_to(string(String), forall(member(Clause, Predicates), portray_clause_ind(Clause))). + +dump(queries, List, String) :- + findall( query(Name, Query), + (member( query(Name, Query), List)), Predicates), + with_output_to(string(String), forall(member(Clause, Predicates), portray_clause_ind(Clause))). + +dump(scenarios, List, String) :- + findall( example(Name, Scenario), + (member( example(Name, Scenario), List)), Predicates), + with_output_to(string(String), forall(member(Clause, Predicates), portray_clause_ind(Clause))). + +dump(all, Module, List, String) :- + %print_message(informational, " To dump all"), + dump(templates, StringTemplates), + %print_message(informational, " Templates ~w"-[StringTemplates]), + dump(rules, List, StringRules), + dump(scenarios, List, StringScenarios), + dump(queries, List, StringQueries), + string_concat(":-module(\'", Module, Module01), + string_concat(Module01, "\', []).\n", TopHeadString), + dump(source_lang, SourceLang), + string_concat(TopHeadString, SourceLang, TopMost), + string_concat(TopMost, StringTemplates, HeadString), + string_concat(HeadString, "prolog_le(verified).\n", String0), % it has to be here to set the context + string_concat(String0, StringRules, String1), + string_concat(String1, StringScenarios, String2), + string_concat(String2, StringQueries, String). + +dump_scasp(Module, List, String) :- + dump(templates_scasp, StringTemplates), + dump(rules, List, StringRules), + dump(scasp_scenarios_queries, List, StringQueriesScenarios), + dump(abducibles_scasp, List, StringAbds), + string_concat(":-module(\'", Module, Module01), + string_concat(Module01, "\', []).\n", TopHeadString), + dump(source_lang_scasp, SourceLang), + string_concat(TopHeadString, SourceLang, TopMost), + % headers for scasp + string_concat("% s(CASP) Programming \n:- use_module(library(scasp)).\n% Uncomment to suppress warnings\n:- style_check(-discontiguous).\n", + ":- style_check(-singleton).\n:- set_prolog_flag(scasp_forall, prev).\n", SCAPSHeader), + string_concat(TopMost, SCAPSHeader, Header), + string_concat(Header, StringTemplates, HeadString), + string_concat(HeadString, StringAbds, String0), + %string_concat(String1, "prolog_le(verified).\n", String2), % not need for scasp + string_concat(String0, StringRules, String1), + string_concat(String1, StringQueriesScenarios, String). + +restore_dicts :- %trace, + %print_message(informational, "dictionaries being restored"), + restore_dicts(DictEntries), + order_templates(DictEntries, OrderedEntries), + process_types_dict(OrderedEntries, Types), + append(OrderedEntries, Types, MRules), + assertall(MRules), !. % asserting contextual information + +restore_dicts(DictEntries) :- %trace, + %myDeclaredModule(SwishModule), + this_capsule(SwishModule), + %SwishModule=user, + %print_message(informational, "the dictionaries are being restored into module ~w"-[SwishModule]), + (SwishModule:local_dict(_,_,_) -> findall(dict(A,B,C), SwishModule:local_dict(A,B,C), ListDict) ; ListDict = []), + (SwishModule:local_meta_dict(_,_,_) -> findall(meta_dict(A,B,C), SwishModule:local_meta_dict(A,B,C), ListMetaDict); ListMetaDict = []), + %(local_dict(_,_,_) -> findall(dict(A,B,C), local_dict(A,B,C), ListDict) ; ListDict = []), + %(local_meta_dict(_,_,_) -> findall(meta_dict(A,B,C), local_meta_dict(A,B,C), ListMetaDict); ListMetaDict = []), + append(ListDict, ListMetaDict, DictEntries), + %print_message(informational, "the dictionaries being restored are ~w"-[DictEntries]), + collect_all_preds(SwishModule, DictEntries, Preds), + %print_message(informational, "the dictionaries being set dynamics are ~w"-[Preds]), + declare_preds_as_dynamic(SwishModule, Preds). + +% collect_all_preds/3 +collect_all_preds(_, DictEntries, ListPreds) :- + findall(AA, ((member(dict(A,_,_), DictEntries); member(meta_dict(A,_,_), DictEntries)), A\=[], AA =.. A, not(predicate_property(AA,built_in))), ListPreds). + +declare_preds_as_dynamic(_, []) :- !. +declare_preds_as_dynamic(M, [F|R]) :- functor(F, P, A), % facts are the templates now + dynamic([M:P/A], [thread(local), discontiguous(true)]), declare_preds_as_dynamic(M, R). + +%split_module_name(user, temporal, '') :- !. + +split_module_name(Name, Name, '') :- + \+ sub_atom(Name, _, _, _, '+'), + \+ sub_atom(Name, _, _, _, 'http'), !. + +split_module_name(Name, File, URL):- + sub_atom(Name,U,1,_,'+'), + sub_atom(Name,0,U,_,File), + UU is U+1, + sub_atom(Name,UU,_,0,URL), + !. + %print_message(informational, URL). + +split_module_name(Name, Name, Name) :- % dangerous. But it maybe needed for earlier taxlog examples. + sub_atom(Name, _, _, _, 'http'), !. + +write_functors_to_string([F/N], Previous, StringFunctors) :- !, + with_output_to(string(StringF), format("~p/~d", [F,N])), + string_concat(Previous, StringF, StringFunctors). +write_functors_to_string([F/N|R], Previous, StringFunctors) :- !, + write_functors_to_string(R, Previous, NextString), + with_output_to(string(StringF), format("~p/~d, ", [F,N])), + string_concat(StringF, NextString, StringFunctors). + +%%% ------------------------------------------------ Swish Interface to logical english +%% based on logicalcontracts' lc_server.pl + +:- multifile prolog_colour:term_colours/2. +prolog_colour:term_colours(en(_Text),lps_delimiter-[classify]). % let 'en' stand out with other taxlog keywords +prolog_colour:term_colours(en_decl(_Text),lps_delimiter-[classify]). % let 'en_decl' stand out with other taxlog keywords + + +user:(answer Query with Scenario):- + %print_message(informational,"le_answer:answer ~w with ~w"-[Query, Scenario]), + answer(Query,with(Scenario)). +user: (répondre Query avec Scenario):- + answer(Query,with(Scenario)). +user: (risposta Query con Scenario):- + answer(Query,with(Scenario)). +user: (responde Query con Scenario):- + answer(Query,with(Scenario)). +%:- discontiguous (with)/2. +%user:(Query with Scenario):- +% answer(Query,with(Scenario)). +%user:(Command1 and Command2) :- +% call(Command1), call(Command2). +user:answer( EnText) :- answer( EnText). +user:answer( EnText, Scenario) :- answer( EnText, Scenario). +user:answer( EnText, Scenario, Result) :- answer( EnText, Scenario, Result). +user:answer( EnText, Scenario, E, Result) :- answer( EnText, Scenario, E, Result). + +%user:(show Something) :- +% le_answer:show(Something). + +user:(show(Something, With) ):- + le_answer:show(Something, With). + +user:is_it_illegal( EnText, Scenario) :- is_it_illegal( EnText, Scenario). + +%user:query(Name, Goal) :- query(Name, Goal). + +user:holds(Fluent, Time) :- holds(Fluent, Time). + +user:has_as_head_before(List, Head, Rest) :- has_as_head_before(List, Head, Rest). + +% for term_expansion +%user:le_taxlog_translate( en(Text), Terms) :- le_taxlog_translate( en(Text), Terms).. +%user:le_taxlog_translate( en(Text), File, Base, Terms) :- le_taxlog_translate( en(Text), File, Base, Terms). + +user:op_stop(StopWords) :- op_stop(StopWords). + +%user:targetBody(G, B, X, S, L, R) :- targetBody(G, B, X, S, L, R). + +user:restore_dicts :- restore_dicts. + +% user:source_lang(L) :- source_lang(L). + +le_taxlog_translate( EnText, Terms) :- le_taxlog_translate( EnText, someFile, 1, Terms). + +% Baseline is the line number of the start of Logical English text +le_taxlog_translate( en(Text), File, BaseLine, Terms) :- + %print_message(informational,"en( ~w )"-[Text]), + le_input:text_to_logic(Text, Terms) -> true; showErrors(File,BaseLine). +le_taxlog_translate( fr(Text), File, BaseLine, Terms) :- + le_input:text_to_logic(Text, Terms) -> true; showErrors(File,BaseLine). +le_taxlog_translate( it(Text), File, BaseLine, Terms) :- + le_input:text_to_logic(Text, Terms) -> true; showErrors(File,BaseLine). +le_taxlog_translate( es(Text), File, BaseLine, Terms) :- + le_input:text_to_logic(Text, Terms) -> true; showErrors(File,BaseLine). +le_taxlog_translate( prolog_le(verified), _, _, prolog_le(verified)) :- %trace, % running from prolog file + assertz(le_input:parsed), this_capsule(M), + assertz(M:just_saved_scasp(null, null)), + including -> true; restore_dicts. + +combine_list_into_string(List, String) :- + combine_list_into_string(List, "", String). + +combine_list_into_string([], String, String). +combine_list_into_string([HS|RestS], Previous, OutS) :- + string_concat(Previous, HS, NewS), + combine_list_into_string(RestS, NewS, OutS). + +%user:showtaxlog :- showtaxlog. +%user:is_type(T) :- is_type(T). +%user:dict(A,B,C) :- dict(A,B,C). +%user:meta_dict(A,B,C) :- meta_dict(A,B,C). + +showtaxlog:- + % ????????????????????????????????????????? + % psyntax:lps_swish_clause(en(Text),Body,_Vars), + once(text_to_logic(_,Taxlog)), + showErrors(someFile,0), + writeln(Taxlog), + fail. +showtaxlog. + +% le_expanded_terms/2 is being used for term expansion in user_module_for_swish +le_expanded_terms(TaxlogTerms, ExpandedTerms) :- + %print_message(informational, " Translated ~w"-[TaxlogTerms]), + (TaxlogTerms\=[]-> + findall(PrologTerm, ( + member(TT_,TaxlogTerms), + (is_list(TT_)->member(TT,TT_);TT=TT_), % the LE translator generates a list of lists... and non lists + ((member(target(prolog),TaxlogTerms);member(target(scasp),TaxlogTerms)) -> + semantics2prolog(TT,_,PrologTerm);taxlog2prolog(TT,_,PrologTerm)) + ), ExpandedTerms_0) + ; ExpandedTerms_0 = []), + %print_message(informational, " First Expansion ~w"-[ExpandedTerms_0]), + % to save as a separated file + (member(target(prolog),TaxlogTerms) -> + ( myDeclaredModule(Name), % the module in the editor + split_module_name(Name, FileName, URL), + atomic_list_concat([FileName,'-prolog','.pl'], NewFileName), + (URL\=''->atomic_list_concat([FileName,'-prolog', '+', URL], NewModule); atomic_list_concat([FileName,'-prolog'], NewModule)), + %print_message(informational, " Processing module ~w filename ~w URL ~w"-[Name, FileName, URL]), + dump(all, NewModule, ExpandedTerms_0, String), + %print_message(informational, " To dump this ~w"-[String]), + update_file(NewFileName, URL, String), + ExpandedTerms_1 = [just_saved_scasp(null, null)|ExpandedTerms_0]) ; ExpandedTerms_1 = ExpandedTerms_0), + %print_message(informational, " Terms ~w"-[ExpandedTerms_1]), + (member(target(scasp),TaxlogTerms) -> + ( myDeclaredModule(Name), % the module in the editor + split_module_name(Name, FileName, URL), + atomic_list_concat([FileName,'-scasp','.pl'], NewFileName), + (URL\=''->atomic_list_concat([FileName,'-scasp', '+', URL], NewModule); atomic_list_concat([FileName,'-scasp'], NewModule)), + %print_message(informational, "sCASP module name ~w"-[NewModule]), + dump_scasp(NewModule, ExpandedTerms_0, String), + %print_message(informational, "sCASP content to assert: ~w \n"-[String]), + update_file(NewFileName, NewModule, String), + ExpandedTerms_2 = [just_saved_scasp(NewFileName, NewModule)|ExpandedTerms_1] ) ; ExpandedTerms_2 = ExpandedTerms_1), + ExpandedTerms = ExpandedTerms_2. + +:- multifile kp_loader:myDeclaredModule_/1. + +parse_and_query(File, Document, Question, Scenario, AnswerExplanation) :- + %print_message(informational, "parse_and_query ~w ~w ~w ~w"-[File, Document, Question, Scenario]), + %Answer = 'respuesta + explanation'. + %context_module(user), % LE programs are in the user module + %prolog_load_context(source,File), % atom_prefix(File,'pengine://'), % process only SWISH windows + %prolog_load_context(term_position,TP), stream_position_data(line_count,TP,Line), + le_taxlog_translate(Document, _, 1, TaxlogTerms), + %M = user, + this_capsule(M), + %api:set_le_program_module(M), + %M:assert(myDeclaredModule_(M)), + %print_message(informational, "Expanded to be asserted on ~w "-[M]), + non_expanded_terms(File, TaxlogTerms, ExpandedTerms), + %print_message(informational, "Expanded to be asserted on ~w this ~w"-[M, ExpandedTerms]), + %forall(member(T, ExpandedTerms), (assertz(M:T), print_message(informational, "Asserted ~w"-[M:T]))), % simulating term expansion + %kp_loader:assert(myDeclaredModule_(user)), + %myDeclaredModule(M), + forall(member(T, [(:-module(File,[]))|ExpandedTerms]), assertz(M:T)), % simulating term expansion + answer( Question, Scenario, AnswerExplanation). + +parse_and_query_and_explanation(File, Document, Question, Scenario, Answer) :- + %print_message(informational, "parse_and_query and explanation ~w ~w ~w ~w"-[File, Document, Question, Scenario]), + le_taxlog_translate(Document, _, 1, TaxlogTerms), + this_capsule(M), + non_expanded_terms(File, TaxlogTerms, ExpandedTerms), + %M:assertz(myDeclaredModule_(File)), % to enable the reasoner + %M:assertz(kp_loader:module_api_hack(M)), + M:assertz(myDeclaredModule_(File)), + forall(member(T, [(:-module(File,[]))|ExpandedTerms]), assertz(M:T)), % simulating term expansion + %forall(member(T, [is_a_dragon(bob), is_a_dragon(alice), is_a_parent_of(alice, bob)]), assertz(M:T)), % simulating facts addition + %kp_loader:loaded_kp(Answer). + hack_module_for_taxlog(M), + %reasoner:query(at(is_happy(A), M),_,le(LE_Explanation),_), + %print_message(informational, " Asserted ~w"-[ExpandedTerms]), + %answer( Question, Scenario, Answer). + answer( Question, Scenario, le(LE_Explanation), _Result), + %with_output_to(string(Answer), write(LE_Explanation)). + produce_html_explanation(LE_Explanation, Answer). + +% non_expanded_terms/2 is just as the one above, but with semantics2prolog2 instead of semantics2prolog that has many other dependencies. +non_expanded_terms(Name, TaxlogTerms, ExpandedTerms) :- + %print_message(informational, " Translated ~w"-[TaxlogTerms]), + (TaxlogTerms\=[]-> + findall(PrologTerm, ( + member(TT_,TaxlogTerms), + (is_list(TT_)->member(TT,TT_);TT=TT_), % the LE translator generates a list of lists... and non lists + ((member(target(prolog),TaxlogTerms);member(target(scasp),TaxlogTerms)) -> + semantics2prolog2(TT,_,PrologTerm); true) % disabling taxlog translation + ), ExpandedTerms_0) + ; ExpandedTerms_0 = []), + % member(target(prolog),TaxlogTerms), + %print_message(informational, " Expanded ~w"-[ExpandedTerms_0]), + %kp_loader:myDeclaredModule(Name), + %print_message(informational, " Module ~w "-[Name]), + % ExpandedTerms=ExpandedTerms_0. + % to save as a separated file + (member(target(prolog),TaxlogTerms) -> + ( %myDeclaredModule(Name), % the module in the editor + split_module_name(Name, FileName, URL), + atomic_list_concat([FileName,'-prolog','.pl'], NewFileName), + (URL\=''->atomic_list_concat([FileName,'-prolog', '+', URL], NewModule); atomic_list_concat([FileName,'-prolog'], NewModule)), + %print_message(informational, " Processing module ~w filename ~w URL ~w"-[Name, FileName, URL]), + dump(all, NewModule, ExpandedTerms_0, String), + %print_message(informational, " To dump this ~w"-[String]), + update_file(NewFileName, URL, String), + ExpandedTerms_1 = [just_saved_scasp(null, null)|ExpandedTerms_0]) ; ExpandedTerms_1 = ExpandedTerms_0), + %print_message(informational, " Terms ~w"-[ExpandedTerms_1]), + (member(target(scasp),TaxlogTerms) -> + ( %myDeclaredModule(Name), % the module in the editor + split_module_name(Name, FileName, URL), + atomic_list_concat([FileName,'-scasp','.pl'], NewFileName), + (URL\=''->atomic_list_concat([FileName,'-scasp', '+', URL], NewModule); atomic_list_concat([FileName,'-scasp'], NewModule)), + %print_message(informational, "sCASP module name ~w"-[NewModule]), + dump_scasp(NewModule, ExpandedTerms_0, String), + %print_message(informational, "sCASP content to assert: ~w \n"-[String]), + update_file(NewFileName, NewModule, String), + ExpandedTerms_2 = [just_saved_scasp(NewFileName, NewModule)|ExpandedTerms_1] ) ; ExpandedTerms_2 = ExpandedTerms_1), + ExpandedTerms = ExpandedTerms_2. + +clean_explanation([], []) :- !. +clean_explanation([s(P,_Ref, _Source, _, _, R)|RestConj], [s(P, RR)|NewConj]) :- + clean_explanation(R, RR), clean_explanation(RestConj, NewConj). +clean_explanation([f(P,_Ref, _Source, _, _, R)|RestConj], [f(P, RR)|NewConj]) :- + clean_explanation(R, RR), clean_explanation(RestConj, NewConj). + +produce_html_explanation(le_Explanation(Trees), Explanation) :- + explanationLEHTML(Trees,HTML), + % phrase(html( + % div([ 'data-render'('An explanation')],[ + % div([], ul(id="myUL", HTML)) + % ]) + % ), ExplanationInHtml), + phrase(html(HTML), ExplanationInHtml), + with_output_to(string(Explanation), print_html(ExplanationInHtml)). + +explanationLEHTML(s(G,_Ref,_,_,_,C),[li(title="Rule inference",[span(class=Class," "), b(G)|RestTree])]) :- + %Navigator=' a rule', + explanationLEHTML(C,CH), + (CH\=[] -> + ( RestTree = ul(class="nested", ['because'|CH]), Class = "box" ) + ; ( RestTree = [], Class = "leaf" ) + ). +explanationLEHTML(u(G,_Ref,_,_,_,[]),[li(title="Unknown",["~w ?"-[G],Navigator])]) :- Navigator=' a hypothesis'. +explanationLEHTML(f(G,_Ref,_,_,_,C),[li(title="Failed goal",[span(class=Class, " "), span(style="color:red","It cannot be proved that "), b(G)|RestTree])]) :- + %Navigator=' in the rules', + explanationLEHTML(C,CH), + %print_message(informational, "G vs C: ~w .. ~w ... ~w"-[G, C, CH]), + %(CH\=[] -> (C=[s(_,_,_,_,_,[])] -> Because = 'although' ; Because = 'because'); Because=''). % this is filtered out before (reasoner.pl) + (CH\=[] -> + ( RestTree = ul(class="nested", ['because'|CH]), Class = "box" ) + ; ( RestTree = [], Class = "leaf" ) + ). +explanationLEHTML([C1|Cn],CH) :- explanationLEHTML(C1,CH1), explanationLEHTML(Cn,CHn), (CHn\=[] -> Joint = ['and '|CHn]; Joint = CHn), append(CH1,Joint,CH). + %append(CH1,CHn,CH). +explanationLEHTML([],[]). + +%sandbox:safe_meta(term_singletons(X,Y), [X,Y]). + +sandbox:safe_primitive(le_answer:answer( _EnText)). +sandbox:safe_primitive(le_answer:show( _Something)). +sandbox:safe_primitive(le_answer:show( _Something, _With)). +sandbox:safe_primitive(le_answer:answer( _EnText, _Scenario)). +sandbox:safe_primitive(le_answer:answer( _EnText, _Scenario, _Result)). +sandbox:safe_primitive(le_answer:answer( _EnText, _Scenario, _Explanation, _Result)). +sandbox:safe_primitive(le_answer:le_taxlog_translate( _EnText, _File, _Baseline, _Terms)). +sandbox:safe_primitive(le_answer:translate_goal_into_LE(_,_)). +sandbox:safe_primitive(le_answer:dump_scasp(_,_,_)). +sandbox:safe_primitive(current_output(_)). +sandbox:safe_primitive(le_answer:(show _)). +sandbox:safe_primitive(le_answer:parse_and_query(_,_,_,_,_)). +sandbox:safe_primitive(le_answer:parse_and_query_and_explanation(_,_,_,_,_)). +sandbox:safe_primitive(kp_loader:module_api_hack(_)). + +%sandbox:safe_primitive(term_singletons(_,_)). % this would not work as term_singletons/2 is an undefined, C-based primitive \ No newline at end of file diff --git a/examples/multi-file-generation/project/prolog/le_input.pl b/examples/multi-file-generation/project/prolog/le_input.pl new file mode 100755 index 00000000..13e49274 --- /dev/null +++ b/examples/multi-file-generation/project/prolog/le_input.pl @@ -0,0 +1,2193 @@ +/* le_input: a prolog module with predicates to translate from an +extended version of Logical English into the Prolog or Taxlogtemplate_decl + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. + +Main predicate: text_to_logic(String to be translated, Translation) + +Main DCG nonterminal: document(Translation) + +See at the end the predicate le_taxlog_translate to be used from SWISH + +It assumes an entry with the following structure. One of these expressions: + +the meta predicates are: +the predicates are: +the templates are: +the timeless predicates are: +the event predicates are: +the fluents are: +the time-varying predicates are: + +followed by the declarations of all the corresponding predicates mentioned in the +knowledge base. + +Each declarations define a template with the variables and other words required to +describe a relevant relation. It is a comma separated list of templates which ends +with a period. + +After that period, one of the following statement introduces the knowledge base: + +the knowledge base includes: +the knowledge base includes: + +And it is followed by the rules and facts written in Logical English syntax. +Each rule must end with a period. + +Indentation is used to organize the and/or list of conditions by strict +observance of one condition per line with a level of indentation that +corresponds to each operator and corresponding conditions. + +Similarly, there may be sections for scenarios and queries, like: + +-- +scenario test2 is: + borrower pays an amount to lender on 2015-06-01T00:00:00. +-- + +and + +-- +query one is: +for which event: + the small business restructure rollover applies to the event. + +query two is: + which tax payer is a party of which event. + +query three is: + A first time is after a second time + and the second time is immediately before the first time. +-- + + which can then be used on the new command interface of LE on SWISH as defined in module le_answer.pl +(e.g. answer/1 and others querying predicates): + +? answer("query one with scenario test"). + +*/ + +:- module(le_input, + [document/3, text_to_logic/2, + predicate_decl/4, showErrors/2, + op(1000,xfy,user:and), % to support querying + op(800,fx,user:resolve), % to support querying + op(800,fx,user:answer), % to support querying + op(800,fx,user:répondre), % to support querying in french + op(850,xfx,user:with), % to support querying + op(850,xfx,user:avec), % to support querying in french + op(800,fx,user:risposta), % to support querying in italian + op(850,xfx,user:con), % to support querying in italian + op(800,fx,user:responde), % to support querying in spanish + %op(1150,fx,user:show), % to support querying + op(850,xfx,user:of), % to support querying + %op(850,fx,user:'#pred'), % to support scasp + %op(800,xfx,user:'::'), % to support scasp + op(950, xfx, ::), % pred not x :: "...". + op(1200, fx, #), + op(1150, fx, pred), + op(1150, fx, show), + op(1150, fx, abducible), + dictionary/3, meta_dictionary/3, dict/3, meta_dict/3, + parsed/0, source_lang/1, including/0, just_saved_scasp/2, + this_capsule/1, unpack_tokens/2, clean_comments/2, + query_/2, extract_constant/4, spaces/3, name_as_atom/2, process_types_or_names/4, + matches_name/4, matches_type/4, delete_underscore/2, add_determiner/2, proper_det/2, + portray_clause_ind/1, order_templates/2, process_types_dict/2, + assertall/1,asserted/1, + update_file/3, myDeclaredModule/1, conditions/6 + ]). + +:- multifile sandbox:safe_primitive/1. + +:- use_module('./tokenize/prolog/tokenize.pl'). + +:- if(current_module(swish)). +:- use_module('le_swish.pl'). % module to handle the gitty filesystem +:- else. +:- use_module('le_local.pl'). % module to handle the local filesystem +:- endif. + +:- use_module('reasoner.pl'). +:- use_module(library(prolog_stack)). +:- thread_local text_size/1, error_notice/4, dict/3, meta_dict/3, example/2, local_dict/3, local_meta_dict/3, + last_nl_parsed/1, kbname/1, happens/2, initiates/3, terminates/3, is_type/1, is_/2, + predicates/1, events/1, fluents/1, metapredicates/1, parsed/0, source_lang/1, including/0, just_saved_scasp/2. +:- discontiguous statement/3, declaration/4, _:example/2, _:query/2, _:is_/2. + +% Main clause: text_to_logic(+String,-Clauses) is det +% Errors are added to error_notice +% text_to_logic/2 +text_to_logic(String_, Translation) :- + % hack to ensure a newline at the end, for the sake of error reporting: + ((sub_atom(String_,_,1,0,NL), memberchk(NL,['\n','\r']) ) -> String=String_ ; atom_concat(String_,'\n',String)), + tokenize(String, Tokens, [cased(true), spaces(true), numbers(true)]), + retractall(last_nl_parsed(_)), asserta(last_nl_parsed(1)), % preparing line counting + unpack_tokens(Tokens, UTokens), + clean_comments(UTokens, CTokens), !, + %print_message(informational, "Tokens: ~w"-[CTokens]), + phrase(document(Translation), CTokens). + %print_message(informational, "Translation: ~w"-[Translation]). + %with_output_to(string(Report), listing(dict/3)), + %print_message(informational, "Dictionaries in memory after loading and parsing ~w\n"-[Report]). + %( phrase(document(Translation), CTokens) -> + % ( print_message(informational, "Translation: ~w"-[Translation]) ) + %; ( print_message(informational, "Translation failed: ~w"-[CTokens]), Translation=[], fail)). + +% document/3 (or document/1 in dcg) +document(Translation, In, Rest) :- + (parsed -> retractall(parsed); true), + (including -> retract(including); true), + (source_lang(_L) -> retractall(source_lang(_)) ; true), + phrase(header(Settings), In, AfterHeader), !, %print_message(informational, "Declarations completed: ~w"-[Settings]), + phrase(content(Content), AfterHeader, Rest), + append(Settings, Content, Original), !, + append(Original, [if(is_(A,B), (nonvar(B), is(A,B)))], Translation), % adding def of is_2 last! + assertz(parsed). + +% header parses all the declarations and assert them into memory to be invoked by the rules. +% header/3 +header(Settings, In, Next) :- + length(In, TextSize), % after comments were removed + phrase(settings(DictEntries, Settings_), In, Next), + fix_settings(Settings_, Settings2), + RulesforErrors = [(text_size(TextSize))|Settings2], % is text_size being used? % asserting the Settings too! predicates, events and fluents + included_files(Settings2, RestoredDictEntries, CollectedRules), + append(Settings2, CollectedRules, Settings), + append(DictEntries, RestoredDictEntries, AllDictEntries), + order_templates(AllDictEntries, OrderedEntries), + process_types_dict(OrderedEntries, Types), + %print_message(informational, "types ~w rules ~w"-[Types, CollectedRules]), + append(OrderedEntries, RulesforErrors, SomeRules), + append(SomeRules, Types, MRules), + %print_message(informational, "rules ~w"-[MRules]), + assertall(MRules), !. % asserting contextual information +header(_, Rest, _) :- + asserterror('LE error in the header ', Rest), + fail. + +fix_settings(Settings_, Settings2) :- + ( member(target(_), Settings_) -> Settings1 = Settings_ ; Settings1 = [target(taxlog)|Settings_] ), !, % taxlog as default + Settings2 = [query(null, true), example(null, []), abducible(true,true)|Settings1]. % a hack to stop the loop when query is empty + +included_files(Settings2, RestoredDictEntries, CollectedRules) :- + member(in_files(ModuleNames), Settings2), % include all those files and get additional DictEntries before ordering + print_message(informational, "Module Names ~w\n"-[ModuleNames]), + assertz(including), !, % cut to prevent escaping failure of load_all_files + load_all_files(ModuleNames, RestoredDictEntries, CollectedRules), + print_message(informational, "Restored Entries ~w\n"-[RestoredDictEntries]). +included_files(_, [], []). + +%load_all_files/2 +%load the prolog files that correspond to the modules names listed in the section of inclusion +%and produces the list of entries that must be added to the dictionaries +load_all_files([], [], []). +load_all_files([Name|R], AllDictEntries, AllRules) :- + print_message(informational, "Loading ~w"-[Name]), + split_module_name(Name, File, URL), + print_message(informational, "File ~w URL ~w"-[File, URL]), + concat(File, "-prolog", Part1), concat(Part1, ".pl", Filename), + (URL\=''->atomic_list_concat([File,'-prolog', '+', URL], NewName); atomic_list_concat([File,'-prolog'], NewName)), + print_message(informational, "File ~w FullName ~w"-[Filename, NewName]), + load_file_module(Filename, NewName, true), !, + print_message(informational, "the dictionaries of ~w being restored into module ~w"-[NewName]), + (NewName:local_dict(_,_,_) -> findall(dict(A,B,C), NewName:local_dict(A,B,C), ListDict) ; ListDict = []), + (NewName:local_meta_dict(_,_,_) -> findall(meta_dict(A,B,C), NewName:local_meta_dict(A,B,C), ListMetaDict); ListMetaDict = []), + append(ListDict, ListMetaDict, DictEntries), + %print_message(informational, "the dictionaries being restored are ~w"-[DictEntries]), + %listing(NewName:_), + findall(if(H,B), (member(dict(E, _,_), DictEntries), E\=[], H=..E, clause(NewName:H, B)), Rules), + findall(Pred, (member(dict(E,_,_), ListDict), E\=[], Pred=..E), ListOfPred), + findall(MPred, (member(dict(ME,_,_), ListMetaDict), ME\=[], MPred=..ME), ListOfMPred), + append([predicates(ListOfPred), metapredicates(ListOfMPred)], Rules, TheseRules), % for term expansion + %print_message(informational, "rules to copy ~w"-[Rules]), + %collect_all_preds(SwishModule, DictEntries, Preds), + %print_message(informational, "the dictionaries being set dynamics are ~w"-[Preds]), + %declare_preds_as_dynamic(SwishModule, Preds) + %print_message(informational, "Loaded ~w"-[Filename]), + load_all_files(R, RDict, NextRules), + append(RDict, DictEntries, AllDictEntries), + append(TheseRules, NextRules, AllRules). +load_all_files([Filename|_], [], []) :- + print_message(informational, "Failed to load file ~w"-[Filename]), fail. + +% Experimental rules for processing types: +process_types_dict(Dictionary, Type_entries) :- + findall(Word, + ( (member(dict([_|GoalElements], Types, _), Dictionary); + member(meta_dict([_|GoalElements], Types, _), Dictionary)), + member((_Name-Type), Types), + process_types_or_names([Type], GoalElements, Types, TypeWords), + concat_atom(TypeWords, '_', Word), Word\=''), Templates), + (Templates\=[] -> setof(is_type(Ty), member(Ty, Templates), Type_entries) ; Type_entries = []). + + +% process_types_or_names/4 +process_types_or_names([], _, _, []) :- !. +process_types_or_names([Word|RestWords], Elements, Types, PrintExpression ) :- + atom(Word), concat_atom(WordList, '_', Word), !, + process_types_or_names(RestWords, Elements, Types, RestPrintWords), + append(WordList, RestPrintWords, PrintExpression). +process_types_or_names([Word|RestWords], Elements, Types, PrintExpression ) :- + var(Word), matches_name(Word, Elements, Types, Name), !, + process_types_or_names(RestWords, Elements, Types, RestPrintWords), + tokenize_atom(Name, NameWords), delete_underscore(NameWords, CNameWords), + add_determiner(CNameWords, PrintName), append(['*'|PrintName], ['*'|RestPrintWords], PrintExpression). +process_types_or_names([Word|RestWords], Elements, Types, [PrintWord|RestPrintWords] ) :- + matches_type(Word, Elements, Types, date), + ((nonvar(Word), number(Word)) -> unparse_time(Word, PrintWord); PrintWord = Word), !, + process_types_or_names(RestWords, Elements, Types, RestPrintWords). +process_types_or_names([Word|RestWords], Elements, Types, [PrintWord|RestPrintWords] ) :- + matches_type(Word, Elements, Types, day), + ((nonvar(Word), number(Word)) -> unparse_time(Word, PrintWord); PrintWord = Word), !, + process_types_or_names(RestWords, Elements, Types, RestPrintWords). +process_types_or_names([Word|RestWords], Elements, Types, Output) :- + compound(Word), + translate_goal_into_LE(Word, PrintWord), !, % cut the alternatives + process_types_or_names(RestWords, Elements, Types, RestPrintWords), + append(PrintWord, RestPrintWords, Output). +process_types_or_names([Word|RestWords], Elements, Types, [Word|RestPrintWords] ) :- + process_types_or_names(RestWords, Elements, Types, RestPrintWords). + + +% Experimental rules for reordering of templates +% order_templates/2 +order_templates(NonOrdered, Ordered) :- + predsort(compare_templates, NonOrdered, Ordered). + +compare_templates(<, meta_dict(_,_,_), dict(_,_,_)). + +compare_templates(=, dict(_,_,T1), dict(_,_,T2)) :- T1 =@= T2. +compare_templates(<, dict(_,_,T1), dict(_,_,T2)) :- length(T1, N1), length(T2, N2), N1>N2. +compare_templates(<, dict(_,_,T1), dict(_,_,T2)) :- length(T1, N), length(T2, N), template_before(T1, T2). + +compare_templates(>, Dict1, Dict2) :- not(compare_templates(=, Dict1, Dict2)), not(compare_templates(<, Dict1, Dict2)). + +compare_templates(=, meta_dict(_,_,T1), meta_dict(_,_,T2)) :- T1 =@= T2. +compare_templates(<, meta_dict(_,_,T1), meta_dict(_,_,T2)) :- length(T1, N1), length(T2, N2), N1>N2. +compare_templates(<, meta_dict(_,_,T1), meta_dict(_,_,T2)) :- length(T1, N), length(T2, N), template_before(T1, T2). + +template_before([H1], [H2]) :- H1 =@= H2. +template_before([H1|_R1], [H2|_R2]) :- nonvar(H1), var(H2). +template_before([H1|_R1], [H2|_R2]) :- H1 @> H2. +template_before([H1|R1], [H2|R2]) :- H1=@=H2, template_before(R1, R2). + + +/* --------------------------------------------------------- LE DCGs */ +% settings/2 or /4 +settings(AllR, AllS) --> + spaces_or_newlines(_), declaration(Rules,Setting), settings(RRules, RS), + {append(Setting, RS, AllS), append(Rules, RRules, AllR)}, !. +settings([], [], Stay, Stay) :- !, + ( phrase(rules_previous(_), Stay, _) ; + phrase(scenario_, Stay, _) ; + phrase(query_, Stay, _) ). + % settings ending with the start of the knowledge base or scenarios or queries. +settings(_, _, Rest, _) :- + asserterror('LE error in the declarations on or before ', Rest), + fail. +settings([], [], Stay, Stay). + +% content structure: cuts added to avoid search loop +% content/1 or /3 +content(T) --> %{print_message(informational, "going for KB:"-[])}, + spaces_or_newlines(_), rules_previous(Kbname), %{print_message(informational, "KBName: ~w"-[Kbname])}, + kbase_content(S), %{print_message(informational, "KB: ~w"-[S])}, + content(R), + {append([kbname(Kbname)|S], R, T)}, !. +content(T) --> %{print_message(informational, "going for scenario:"-[])}, + spaces_or_newlines(_), scenario_content(S), !, %{print_message(informational, "scenario: ~w"-[S])}, + content(R), + {append(S, R, T)}, !. +content(T) --> %{print_message(informational, "going for query:"-[])}, + spaces_or_newlines(_), query_content(S), !, content(R), + {append(S, R, T)}, !. +content([]) --> + spaces_or_newlines(_), []. +content(_, Rest, _) :- + asserterror('LE error in the content ', Rest), + fail. + +% kbase_content/1 or /3 +kbase_content(T) --> + spaces_or_newlines(_), statement(S), kbase_content(R), + {append(S, R, T)}, !. +kbase_content([]) --> + spaces_or_newlines(_), []. +kbase_content(_, Rest, _) :- + asserterror('LE error in a knowledge base ', Rest), + fail. + +% declaration/2 or /4 +% target +declaration([], [target(Language)]) --> % one word description for the language: prolog, taxlog + spaces(_), [the], spaces(_), [target], spaces(_), [language], spaces(_), [is], spaces(_), colon_or_not_, + spaces(_), [Language], spaces(_), period, !, {assertz(source_lang(en))}. +% french: la langue cible est : prolog +declaration([], [target(Language)]) --> % one word description for the language: prolog, taxlog + spaces(_), [la], spaces(_), [langue], spaces(_), [cible], spaces(_), [est], spaces(_), colon_or_not_, + spaces(_), [Language], spaces(_), period, !, {assertz(source_lang(fr))}. +% italian: il linguaggio destinazione è : prolog +declaration([], [target(Language)]) --> % one word description for the language: prolog, taxlog + spaces(_), [il], spaces(_), [linguaggio], spaces(_), [destinazione], spaces(_), [è], spaces(_), colon_or_not_, + spaces(_), [Language], spaces(_), period, !, {assertz(source_lang(it))}. +% spanish: el lenguaje objetivo es: prolog +declaration([], [target(Language)]) --> % one word description for the language: prolog, taxlog + spaces(_), [el], spaces(_), [lenguaje], spaces(_), [objetivo], spaces(_), [es], spaces(_), colon_or_not_, + spaces(_), [Language], spaces(_), period, !, {assertz(source_lang(es))}. + +% meta predicates +declaration(Rules, [metapredicates(MetaTemplates)]) --> + meta_predicate_previous, list_of_meta_predicates_decl(Rules, MetaTemplates), !. +%timeless or just templates +declaration(Rules, [predicates(Templates)]) --> + predicate_previous, list_of_predicates_decl(Rules, Templates), !. +%events +declaration(Rules, [events(EventTypes)]) --> + event_predicate_previous, list_of_predicates_decl(Rules, EventTypes), !. +%time varying +declaration(Rules, [fluents(Fluents)]) --> + fluent_predicate_previous, list_of_predicates_decl(Rules, Fluents), !. +%files to be included +declaration([kbname(KBName)], [in_files(Files)]) --> + files_to_include_previous(KBName), list_of_files(Files), !. +% +declaration(_, _, Rest, _) :- + asserterror('LE error in a declaration on or before ', Rest), + fail. + +colon_or_not_ --> [':'], spaces(_). +colon_or_not_ --> []. + +meta_predicate_previous --> + spaces(_), [the], spaces(_), [metapredicates], spaces(_), [are], spaces(_), [':'], spaces_or_newlines(_). +meta_predicate_previous --> + spaces(_), [the], spaces(_), [meta], spaces(_), [predicates], spaces(_), [are], spaces(_), [':'], spaces_or_newlines(_). +meta_predicate_previous --> + spaces(_), [the], spaces(_), [meta], spaces(_), ['-'], spaces(_), [predicates], spaces(_), [are], spaces(_), [':'], spaces_or_newlines(_). +% french : les modèles sont : +meta_predicate_previous --> + spaces(_), [les], spaces(_), ['méta'], spaces(_), ['modèles'], spaces(_), [sont], spaces(_), [':'], spaces_or_newlines(_). +% italian: i predicati sono: +meta_predicate_previous --> + spaces(_), [i], spaces(_), [meta], spaces(_), [modelli], spaces(_), [sono], spaces(_), [':'], spaces_or_newlines(_). +% spanish: los predicados son: +meta_predicate_previous --> + spaces(_), [los], spaces(_), [meta], spaces(_), [predicados], spaces(_), [son], spaces(_), [':'], spaces_or_newlines(_). + +predicate_previous --> + spaces(_), [the], spaces(_), [predicates], spaces(_), [are], spaces(_), [':'], spaces_or_newlines(_). +predicate_previous --> + spaces(_), [the], spaces(_), [templates], spaces(_), [are], spaces(_), [':'], spaces_or_newlines(_). +predicate_previous --> + spaces(_), [the], spaces(_), [timeless], spaces(_), [predicates], spaces(_), [are], spaces(_), [':'], spaces_or_newlines(_). +% french : les modèles sont : +predicate_previous --> + spaces(_), [les], spaces(_), ['modèles'], spaces(_), [sont], spaces(_), [':'], spaces_or_newlines(_). +% italian: i predicati sono: +predicate_previous --> + spaces(_), [i], spaces(_), [modelli], spaces(_), [sono], spaces(_), [':'], spaces_or_newlines(_). +% spanish: los predicados son: +predicate_previous --> + spaces(_), [los], spaces(_), [predicados], spaces(_), [son], spaces(_), [':'], spaces_or_newlines(_). + +event_predicate_previous --> + spaces(_), [the], spaces(_), [event], spaces(_), [predicates], spaces(_), [are], spaces(_), [':'], spaces_or_newlines(_). + +fluent_predicate_previous --> + spaces(_), [the], spaces(_), [fluents], spaces(_), [are], spaces(_), [':'], spaces_or_newlines(_). +fluent_predicate_previous --> + spaces(_), [the], spaces(_), [time], ['-'], [varying], spaces(_), [predicates], spaces(_), [are], spaces(_), [':'], spaces_or_newlines(_). + +files_to_include_previous(KBName) --> + spaces_or_newlines(_), [the], spaces(_), ['knowledge'], spaces(_), [base], extract_constant([includes], NameWords), [includes], + spaces(_), [these], spaces(_), [files], spaces(_), [':'], !, spaces_or_newlines(_), {name_as_atom(NameWords, KBName)}. + +% at least one predicate declaration required +list_of_predicates_decl([], []) --> spaces_or_newlines(_), next_section, !. +list_of_predicates_decl([Ru|Rin], [F|Rout]) --> spaces_or_newlines(_), predicate_decl(Ru,F), comma_or_period, list_of_predicates_decl(Rin, Rout), !. +list_of_predicates_decl(_, _, Rest, _) :- + asserterror('LE error found in a template declaration ', Rest), + fail. + +% at least one predicate declaration required +list_of_meta_predicates_decl([], []) --> spaces_or_newlines(_), next_section, !. +list_of_meta_predicates_decl([Ru|Rin], [F|Rout]) --> + spaces_or_newlines(_), meta_predicate_decl(Ru,F), comma_or_period, list_of_meta_predicates_decl(Rin, Rout). +list_of_meta_predicates_decl(_, _, Rest, _) :- + asserterror('LE error found in the declaration of a meta template ', Rest), + fail. + +list_of_files([]) --> spaces_or_newlines(_), next_section, !. +list_of_files([Filename|Rout]) --> spaces_or_newlines(_), extract_string([Filename]), list_of_files(Rout), !. + %{name_as_atom(NameWords, Filename)}. +list_of_files(_, Rest, _) :- + asserterror('LE error found in a file to include ', Rest), + fail. + +% next_section/2 +% a hack to avoid superflous searches format(string(Mess), "~w", [StopHere]), print_message(informational, Message), +next_section(StopHere, StopHere) :- + phrase(meta_predicate_previous, StopHere, _), !. % format(string(Message), "Next meta predicates", []), print_message(informational, Message). + +next_section(StopHere, StopHere) :- + phrase(predicate_previous, StopHere, _), !. % format(string(Message), "Next predicates", []), print_message(informational, Message). + +next_section(StopHere, StopHere) :- + phrase(event_predicate_previous, StopHere, _), !. % format(string(Message), "Next ecent predicates", []), print_message(informational, Message). + +next_section(StopHere, StopHere) :- + phrase(fluent_predicate_previous, StopHere, _), !. % format(string(Message), "Next fluents", []), print_message(informational, Message). + +next_section(StopHere, StopHere) :- + phrase(files_to_include_previous(_), StopHere, _), !. + +next_section(StopHere, StopHere) :- + phrase(rules_previous(_), StopHere, _), !. % format(string(Message), "Next knowledge base", []), print_message(informational, Message). + +next_section(StopHere, StopHere) :- + phrase(scenario_, StopHere, _), !. % format(string(Message), "Next scenario", []), print_message(informational, Message). + +next_section(StopHere, StopHere) :- + phrase(query_, StopHere, _). % format(string(Message), "Next query", []), print_message(informational, Message). + +% predicate_decl/2 +predicate_decl(dict([Predicate|Arguments],TypesAndNames, Template), Relation) --> + spaces(_), template_decl(RawTemplate), + {build_template(RawTemplate, Predicate, Arguments, TypesAndNames, Template), + Relation =.. [Predicate|Arguments]}, !. +% we are using this resource of the last clause to record the error and its details +% not very useful with loops, of course. +% error clause +predicate_decl(_, _, Rest, _) :- + asserterror('LE error found in a declaration ', Rest), + fail. + +% meta_predicate_decl/2 +meta_predicate_decl(meta_dict([Predicate|Arguments],TypesAndNames, Template), Relation) --> + spaces(_), template_decl(RawTemplate), + {build_template(RawTemplate, Predicate, Arguments, TypesAndNames, Template), + Relation =.. [Predicate|Arguments]}. +meta_predicate_decl(_, _, Rest, _) :- + asserterror('LE error found in a meta template declaration ', Rest), + fail. + +rules_previous(default) --> + spaces_or_newlines(_), [the], spaces(_), [rules], spaces(_), [are], spaces(_), [':'], spaces_or_newlines(_), !. +rules_previous(KBName) --> + spaces_or_newlines(_), [the], spaces(_), ['knowledge'], spaces(_), [base], extract_constant([includes], NameWords), [includes], spaces(_), [':'], !, spaces_or_newlines(_), + {name_as_atom(NameWords, KBName)}. +rules_previous(default) --> % backward compatibility + spaces_or_newlines(_), [the], spaces(_), ['knowledge'], spaces(_), [base], spaces(_), [includes], spaces(_), [':'], spaces_or_newlines(_). +% italian: la base di conoscenza include +rules_previous(KBName) --> + spaces_or_newlines(_), [la], spaces(_), [base], spaces(_), [di], spaces(_), [conoscenza], spaces(_), extract_constant([include], NameWords), [include], spaces(_), [':'], !, spaces_or_newlines(_), + {name_as_atom(NameWords, KBName)}. +% french: la base de connaissances dont le nom est comprend : +rules_previous(KBName) --> + spaces_or_newlines(_), [la], spaces(_), [base], spaces(_), [de], spaces(_), [connaissances], spaces(_), [dont], spaces(_), [le], spaces(_), [nom], spaces(_), [est], extract_constant([comprend], NameWords), [comprend], spaces(_), [':'], !, spaces_or_newlines(_), + {name_as_atom(NameWords, KBName)}. +% spanish: la base de conocimiento incluye: +rules_previous(KBName) --> + spaces_or_newlines(_), [la], spaces(_), [base], spaces(_), [de], spaces(_), [conocimiento], extract_constant([incluye], NameWords), [incluye], spaces(_), [':'], !, spaces_or_newlines(_), + {name_as_atom(NameWords, KBName)}. + +% scenario_content/1 or /3 +% a scenario description: assuming one example -> one scenario -> one list of facts. +scenario_content(Scenario) --> + scenario_, extract_constant([is, es, est, è], NameWords), is_colon_, newline, + %list_of_facts(Facts), period, !, + spaces(_), assumptions_(Assumptions), !, % period is gone + {name_as_atom(NameWords, Name), Scenario = [example( Name, [scenario(Assumptions, true)])]}. + +scenario_content(_, Rest, _) :- + asserterror('LE error found around this scenario expression: ', Rest), fail. + +% query_content/1 or /3 +% statement: the different types of statements in a LE text +% a query +query_content(Query) --> + query_, extract_constant([is, es, est, è], NameWords), is_colon_, spaces_or_newlines(_), + query_header(Ind0, Map1), + conditions(Ind0, Map1, _, Conds), !, period, % period stays! + {name_as_atom(NameWords, Name), Query = [query(Name, Conds)]}. + +query_content(_, Rest, _) :- + asserterror('LE error found around this expression: ', Rest), fail. + +% (holds_at(_149428,_149434) if +% (happens_at(_150138,_150144), +% initiates_at(_150138,_149428,_150144)), +% _150144 before _149434, +% not ((terminates_at(_152720,_149428,_152732),_150144 before _152732),_152732 before _149434)) + +% it becomes the case that +% fluent +% when +% event +% if +% statement/1 or /3 +statement(Statement) --> + it_becomes_the_case_that_, spaces_or_newlines(_), + literal_([], Map1, holds(Fluent, _)), spaces_or_newlines(_), + when_, spaces_or_newlines(_), + literal_(Map1, Map2, happens(Event, T)), spaces_or_newlines(_), + body_(Body, [map(T, '_change_time')|Map2],_), period, + {(Body = [] -> Statement = [if(initiates(Event, Fluent, T), true)]; + (Statement = [if(initiates(Event, Fluent, T), Body)]))}, !. + +% it becomes not the case that +% fluent +% when +% event +% if +statement(Statement) --> + it_becomes_not_the_case_that_, spaces_or_newlines(_), + literal_([], Map1, holds(Fluent, _)), spaces_or_newlines(_), + when_, spaces_or_newlines(_), + literal_(Map1, Map2, happens(Event, T)), spaces_or_newlines(_), + body_(Body, [map(T, '_change_time')|Map2],_), period, + {(Body = [] -> Statement = [if(terminates(Event, Fluent, T), true)]; + (Statement = [if(terminates(Event, Fluent, T), Body)] %, print_message(informational, "~w"-Statement) + ))}, !. + +% it is illegal that +% event +% if ... +statement(Statement) --> + it_is_illegal_that_, spaces_or_newlines(_), + literal_([], Map1, happens(Event, T)), body_(Body, Map1, _), period, + {(Body = [] -> Statement = [if(it_is_illegal(Event, T), true)]; + Statement = [if(it_is_illegal(Event, T), Body)])},!. + +% it is unknown whether +statement(Statement) --> + it_is_unknown_whether_, spaces_or_newlines(_), + literal_([], Map1, Abducible), body_(Body, Map1, _), period, + {(Body = [] -> Statement = [abducible(Abducible, true)]; + Statement = [abducible(Abducible, Body)])},!. + +% a fact or a rule +statement(Statement) --> currentLine(L), + literal_([], Map1, Head), body_(Body, Map1, _), period, + {(Body = [] -> Statement = [if(L, Head, true)]; Statement = [if(L, Head, Body)])}. + +% error +statement(_, Rest, _) :- + asserterror('LE error found around this statement: ', Rest), fail. + +list_of_facts([F|R1]) --> literal_([], _,F), rest_list_of_facts(R1). + +rest_list_of_facts(L1) --> comma, spaces_or_newlines(_), list_of_facts(L1). +rest_list_of_facts([]) --> []. + +% assumptions_/3 or /5 +assumptions_([A|R]) --> + spaces_or_newlines(_), rule_([], _, A), !, assumptions_(R). +assumptions_([]) --> + spaces_or_newlines(_), []. + +rule_(InMap, InMap, Rule) --> + it_is_unknown_whether_, spaces_or_newlines(_), + literal_([], Map1, Abducible), body_(Body, Map1, _), period, + {(Body = [] -> Rule = (abducible(Abducible, true):-true); Rule = (abducible(Abducible, Body):-true))},!. + +rule_(InMap, OutMap, Rule) --> + literal_(InMap, Map1, Head), body_(Body, Map1, OutMap), period, + %spaces(Ind), condition(Head, Ind, InMap, Map1), body_(Body, Map1, OutMap), period, + {(Body = [] -> Rule = (Head :-true); Rule = (Head :- Body))}. + +rule_(M, M, _, Rest, _) :- + asserterror('LE error found in an assumption, near to ', Rest), fail. + +% no prolog inside LE! +%statement([Fact]) --> +% spaces(_), prolog_literal_(Fact, [], _), spaces_or_newlines(_), period. +% body/3 or /5 +body_([], Map, Map) --> spaces_or_newlines(_). +body_(Conditions, Map1, MapN) --> + newline, spaces(Ind), if_, !, conditions(Ind, Map1, MapN, Conditions), spaces_or_newlines(_). +body_(Conditions, Map1, MapN) --> + if_, newline_or_nothing, spaces(Ind), conditions(Ind, Map1, MapN, Conditions), spaces_or_newlines(_). + +newline_or_nothing --> newline. +newline_or_nothing --> []. + +% literal_/3 or /5 +% literal_ reads a list of words until it finds one of these: ['\n', if, '.'] +% it then tries to match those words against a template in memory (see dict/3 predicate). +% The output is then contigent to the type of literal according to the declarations. +literal_(Map1, MapN, FinalLiteral) --> % { print_message(informational, 'at time, literal') }, + at_time(T, Map1, Map2), comma, possible_instance(PossibleTemplate), + {match_template(PossibleTemplate, Map2, MapN, Literal), + (fluents(Fluents) -> true; Fluents = []), + (events(Events) -> true; Events = []), + (lists:member(Literal, Events) -> FinalLiteral = happens(Literal, T) + ; (lists:member(Literal, Fluents) -> FinalLiteral = holds(Literal, T) + ; FinalLiteral = Literal))}, !. % by default (including builtins) they are timeless! + +literal_(Map1, MapN, FinalLiteral) --> % { print_message(informational, 'literal, at time') }, + possible_instance(PossibleTemplate), comma, at_time(T, Map1, Map2), + {match_template(PossibleTemplate, Map2, MapN, Literal), + (fluents(Fluents) -> true; Fluents = []), + (events(Events) -> true; Events = []), + (lists:member(Literal, Events) -> FinalLiteral = happens(Literal, T) + ; (lists:member(Literal, Fluents) -> FinalLiteral = holds(Literal, T) + ; FinalLiteral = Literal))}, !. % by default (including builtins) they are timeless! + +literal_(Map1, MapN, FinalLiteral) --> + possible_instance(PossibleTemplate), %{ print_message(informational, "~w"-[PossibleTemplate]) }, + {match_template(PossibleTemplate, Map1, MapN, Literal), + (fluents(Fluents) -> true; Fluents = []), + (events(Events) -> true; Events = []), + (consult_map(Time, '_change_time', Map1, _MapF) -> T=Time; true), + (lists:member(Literal, Events) -> FinalLiteral = happens(Literal, T) + ; (lists:member(Literal, Fluents) -> FinalLiteral = holds(Literal, T) + ; (FinalLiteral = Literal))) + %print_message(informational, "~w with ~w"-[FinalLiteral, MapF]) + }, !. % by default (including builtins) they are timeless! + +% rewritten to use in swish. Fixed! It was a name clash. Apparently "literal" is used somewhere else +%literal_(Map1, MapN, Literal, In, Out) :- print_message(informational, ' inside a literal'), +% possible_instance(PossibleTemplate, In, Out), print_message(informational, PossibleTemplate), +% match_template(PossibleTemplate, Map1, MapN, Literal). +% error clause +literal_(M, M, _, Rest, _) :- + asserterror('LE error found in a literal ', Rest), fail. + +% conditions/4 or /6 +conditions(Ind0, Map1, MapN, Conds) --> + list_of_conds_with_ind(Ind0, Map1, MapN, Errors, ListConds), + {Errors=[] -> ri(Conds, ListConds); (assert_error_os(Errors), fail)}. % preempty validation of errors +conditions(_, Map, Map, _, Rest, _) :- + asserterror('LE indentation error ', Rest), fail. + +% list_of_conds_with_ind/5 +% list_of_conds_with_ind(+InitialInd, +InMap, -OutMap, -Errors, -ListOfConds) +list_of_conds_with_ind(Ind0, Map1, MapN, [], [Cond|Conditions]) --> + condition(Cond, Ind0, Map1, Map2), + more_conds(Ind0, Ind0,_, Map2, MapN, Conditions). +list_of_conds_with_ind(_, M, M, [error('Error in condition at', LineNumber, Tokens)], [], Rest, _) :- + once( nth1(N,Rest,newline(NextLine)) ), LineNumber is NextLine-2, + RelevantN is N-1, + length(Relevant,RelevantN), append(Relevant,_,Rest), + findall(Token, (member(T,Relevant), (T=newline(_) -> Token='\n' ; Token=T)), Tokens). + +more_conds(Ind0, _, Ind3, Map1, MapN, [ind(Ind2), Op, Cond2|RestMapped]) --> + newline, spaces(Ind2), {Ind0 =< Ind2}, % if the new indentation is deeper, it goes on as before. + operator(Op), condition(Cond2, Ind2, Map1, Map2), + %{print_message(informational, "~w"-[Conditions])}, !, + more_conds(Ind0, Ind2, Ind3, Map2, MapN, RestMapped). +more_conds(_, Ind, Ind, Map, Map, [], L, L). + +% this naive definition of term is problematic +% term_/4 or /6 +term_(StopWords, Term, Map1, MapN) --> + (variable(StopWords, Term, Map1, MapN), !); (constant(StopWords, Term, Map1, MapN), !); (list_(Term, Map1, MapN), !). %; (compound_(Term, Map1, MapN), !). + +% list_/3 or /5 +list_(List, Map1, MapN) --> + spaces(_), bracket_open_, !, extract_list([']'], List, Map1, MapN), bracket_close. + +compound_(V1/V2, Map1, MapN) --> + term_(['/'], V1, Map1, Map2), ['/'], term_([], V2, Map2, MapN). + +% event observations +%condition(happens(Event), _, Map1, MapN) --> +% observe_, literal_(Map1, MapN, Event), !. + +% condition/4 or /6 +% this produces a Taxlog condition with the form: +% setof(Owner/Share, is_ultimately_owned_by(Asset,Owner,Share) on Before, SetOfPreviousOwners) +% from a set of word such as: +% and a record of previous owners is a set of [an owner, a share] +% where the asset is ultimately owned by the share with the owner at the previous time +condition(FinalExpression, _, Map1, MapN) --> + variable([is], Set, Map1, Map2), is_a_set_of_, term_([], Term, Map2, Map3), !, % moved where to the following line + newline, spaces(Ind2), where_, conditions(Ind2, Map3, Map4, Goals), + modifiers(setof(Term,Goals,Set), Map4, MapN, FinalExpression). + +% for every a party is a party in the event, it is the case that: +condition(FinalExpression, _, Map1, MapN) --> + for_all_cases_in_which_, newline, !, + spaces(Ind2), conditions(Ind2, Map1, Map2, Conds), spaces_or_newlines(_), + it_is_the_case_that_, newline, + spaces(Ind3), conditions(Ind3, Map2, Map3, Goals), + modifiers(forall(Conds,Goals), Map3, MapN, FinalExpression). + +% the Value is the sum of each Asset Net such that +condition(FinalExpression, _, Map1, MapN) --> + variable([is], Value, Map1, Map2), is_the_sum_of_each_, extract_variable([such], [], NameWords, [], _), such_that_, !, + { name_predicate(NameWords, Name), update_map(Each, Name, Map2, Map3) }, newline, + spaces(Ind), conditions(Ind, Map3, Map4, Conds), + modifiers(aggregate_all(sum(Each),Conds,Value), Map4, MapN, FinalExpression). + +% it is not the case that +%condition((this_capsule(M), not(M:Conds)), _, Map1, MapN) --> +%condition((true, not(Conds)), _, Map1, MapN) --> +condition(not(Conds), _, Map1, MapN) --> +%condition(not(Conds), _, Map1, MapN) --> + spaces(_), not_, newline, % forget other choices. We know it is a not case + spaces(Ind), conditions(Ind, Map1, MapN, Conds), !. + +condition(Cond, _, Map1, MapN) --> + literal_(Map1, MapN, Cond), !. + +% error clause +condition(_, _Ind, Map, Map, Rest, _) :- + asserterror('LE error found at a condition ', Rest), fail. + +% modifiers add reifying predicates to an expression. +% modifiers(+MainExpression, +MapIn, -MapOut, -FinalExpression) +modifiers(MainExpression, Map1, MapN, on(MainExpression, Var) ) --> + newline, spaces(_), at_, variable([], Var, Map1, MapN). % newline before a reifying expression +modifiers(MainExpression, Map, Map, MainExpression) --> []. + +% variable/4 or /6 +variable(StopWords, Var, Map1, MapN) --> + spaces(_), indef_determiner, extract_variable(StopWords, [], NameWords, [], _), % <-- CUT! + { NameWords\=[], name_predicate(NameWords, Name), update_map(Var, Name, Map1, MapN) }. +variable(StopWords, Var, Map1, MapN) --> + spaces(_), def_determiner, extract_variable(StopWords, [], NameWords, [], _), % <-- CUT! + { NameWords\=[], name_predicate(NameWords, Name), consult_map(Var, Name, Map1, MapN) }. +% allowing for symbolic variables: +variable(StopWords, Var, Map1, MapN) --> + spaces(_), extract_variable(StopWords, [], NameWords, [], _), + { NameWords\=[], name_predicate(NameWords, Name), consult_map(Var, Name, Map1, MapN) }. + +% constant/4 or /6 +constant(StopWords, Constant, Map, Map) --> + extract_constant(StopWords, NameWords), { NameWords\=[], name_predicate(NameWords, Constant) }. + +% deprecated +prolog_literal_(Prolog, Map1, MapN) --> + predicate_name_(Predicate), parentesis_open_, extract_list([], Arguments, Map1, MapN), parentesis_close_, + {Prolog =.. [Predicate|Arguments]}. + +predicate_name_(Module:Predicate) --> + [Module], colon_, extract_constant([], NameWords), { name_predicate(NameWords, Predicate) }, !. +predicate_name_(Predicate) --> extract_constant([], NameWords), { name_predicate(NameWords, Predicate) }. + +at_time(T, Map1, MapN) --> spaces_or_newlines(_), at_, expression_(T, Map1, MapN), spaces_or_newlines(_). + +spaces(N) --> [' '], !, spaces(M), {N is M + 1}. +% todo: reach out for codemirror s configuration https://codemirror.net/doc/manual.html for tabSize +spaces(N) --> ['\t'], !, spaces(M), {N is M + 4}. % counting tab as four spaces (default in codemirror) +spaces(0) --> []. + +spaces_or_newlines(N) --> [' '], !, spaces_or_newlines(M), {N is M + 1}. +spaces_or_newlines(N) --> ['\t'], !, spaces_or_newlines(M), {N is M + 4}. % counting tab as four spaces. See above +spaces_or_newlines(N) --> newline, !, spaces_or_newlines(M), {N is M + 1}. % counting \r as one space +spaces_or_newlines(0) --> []. + +newline --> [newline(_Next)]. + +one_or_many_newlines --> newline, spaces(_), one_or_many_newlines, !. +one_or_many_newlines --> []. + +if_ --> [if], spaces_or_newlines(_). % so that if can be written many lines away from the rest +if_ --> [se], spaces_or_newlines(_). % italian +if_ --> [si], spaces_or_newlines(_). % french and spanish + +period --> ['.']. +comma --> [',']. +colon_ --> [':'], spaces(_). + +comma_or_period --> period, !. +comma_or_period --> comma. + +and_ --> [and]. +and_ --> [e]. % italian +and_ --> [et]. % french +and_ --> [y]. % spanish + +or_ --> [or]. +or_ --> [o]. % italian and spanish +or_ --> [ou]. % french + +not_ --> [it], spaces(_), [is], spaces(_), [not], spaces(_), [the], spaces(_), [case], spaces(_), [that], spaces(_). +not_ --> [non], spaces(_), [risulta], spaces(_), [che], spaces(_). % italian +not_ --> [ce], spaces(_), [n],[A],[est], spaces(_), [pas], spaces(_), [le], spaces(_), [cas], spaces(_), [que], spaces(_), {atom_string(A, "'")}. % french +not_ --> [no], spaces(_), [es], spaces(_), [el], spaces(_), [caso], spaces(_), [que], spaces(_). % spanish + +is_the_sum_of_each_ --> [is], spaces(_), [the], spaces(_), [sum], spaces(_), [of], spaces(_), [each], spaces(_) . +is_the_sum_of_each_ --> [è], spaces(_), [la], spaces(_), [somma], spaces(_), [di], spaces(_), [ogni], spaces(_). % italian +is_the_sum_of_each_ --> [es], spaces(_), [la], spaces(_), [suma], spaces(_), [de], spaces(_), [cada], spaces(_). % spanish +is_the_sum_of_each_ --> [est], spaces(_), [la], spaces(_), [somme], spaces(_), [de], spaces(_), [chaque], spaces(_). % french + +such_that_ --> [such], spaces(_), [that], spaces(_). +such_that_ --> [tale], spaces(_), [che], spaces(_). % italian +such_that_ --> [tel], spaces(_), [que], spaces(_). % french +such_that_ --> [tal], spaces(_), [que], spaces(_). % spanish + +at_ --> [at], spaces(_). +at_ --> [a], spaces(_). % italian + +minus_ --> ['-'], spaces(_). + +plus_ --> ['+'], spaces(_). + +divide_ --> ['/'], spaces(_). + +times_ --> ['*'], spaces(_). + +bracket_open_ --> [A], spaces(_), {atom_string(A, "[")}. +bracket_close --> [A], spaces(_), {atom_string(A, "]")}. + +parenthesis_open_ --> ['('], spaces(_). +parenthesis_close_ --> [A], spaces(_), {atom_string(A, ")")}. + +this_information_ --> [this], spaces(_), [information], spaces(_). + +has_been_recorded_ --> [has], spaces(_), [been], spaces(_), [recorded], spaces(_). + +for_all_cases_in_which_ --> spaces_or_newlines(_), [for], spaces(_), [all], spaces(_), [cases], spaces(_), [in], spaces(_), [which], spaces(_). +for_all_cases_in_which_ --> spaces_or_newlines(_), [pour], spaces(_), [tous], spaces(_), [les], spaces(_), [cas], spaces(_), [o],[ù], spaces(_). % french +for_all_cases_in_which_ --> spaces_or_newlines(_), [per], spaces(_), [tutti], spaces(_), [i], spaces(_), [casi], spaces(_), [in], spaces(_), [cui], spaces(_). % italian +for_all_cases_in_which_ --> spaces_or_newlines(_), [en], spaces(_), [todos], spaces(_), [los], spaces(_), [casos], spaces(_), [en], spaces(_), [los], spaces(_), [que], spaces(_). % spanish +for_all_cases_in_which_ --> spaces_or_newlines(_), [en], spaces(_), [cualquier], spaces(_), [caso], spaces(_), [en], spaces(_), [el], spaces(_), [que], spaces(_). % spanish + +it_is_the_case_that_ --> [it], spaces(_), [is], spaces(_), [the], spaces(_), [case], spaces(_), [that], spaces(_). +it_is_the_case_that_ --> [es], spaces(_), [el], spaces(_), [caso], spaces(_), [que], spaces(_). % spanish +it_is_the_case_that_ --> [es], spaces(_), [también], spaces(_), [el], spaces(_), [caso], spaces(_), [que], spaces(_). % spanish +it_is_the_case_that_ --> [c], [A], [est], spaces(_), [le], spaces(_), [cas], spaces(_), [que], spaces(_), {atom_string(A, "'")}. % french +it_is_the_case_that_ --> [è], spaces(_), [provato], spaces(_), [che], spaces(_). % italian + +is_a_set_of_ --> [is], spaces(_), [a], spaces(_), [set], spaces(_), [of], spaces(_). +is_a_set_of_ --> [es], spaces(_), [un], spaces(_), [conjunto], spaces(_), [de], spaces(_). % spanish +is_a_set_of_ --> [est], spaces(_), [un], spaces(_), [ensemble], spaces(_), [de], spaces(_). % french +is_a_set_of_ --> [est], spaces(_), [un], spaces(_), [ensemble], spaces(_), [de], spaces(_). % italian + +where_ --> [where], spaces(_). +where_ --> [en], spaces(_), [donde], spaces(_). % spanish +where_ --> ['où'], spaces(_). % french +where_ --> [dove], spaces(_). % italian +where_ --> [quando], spaces(_). % italian +where_ --> [donde], spaces(_). % spanish + +scenario_ --> spaces_or_newlines(_), ['Scenario'], !, spaces(_). +scenario_ --> spaces_or_newlines(_), [scenario], spaces(_). % english and italian +scenario_ --> spaces_or_newlines(_), [le], spaces(_), [scénario], spaces(_). % french +scenario_ --> spaces_or_newlines(_), [escenario], spaces(_). % spanish + +is_colon_ --> [is], spaces(_), [':'], spaces(_). +is_colon_ --> [es], spaces(_), [':'], spaces(_). % spanish +is_colon_ --> [est], spaces(_), [':'], spaces(_). % french +is_colon_ --> [è], spaces(_), [':'], spaces(_). % italian + +query_ --> spaces_or_newlines(_), ['Query'], !, spaces(_). +query_ --> spaces_or_newlines(_), [query], spaces(_). +query_ --> spaces_or_newlines(_), [la], spaces(_), [question], spaces(_). % french +query_ --> spaces_or_newlines(_), [la], spaces(_), [pregunta], spaces(_). % spanish +query_ --> spaces_or_newlines(_), [domanda], spaces(_). % italian + +for_which_ --> [for], spaces(_), [which], spaces(_). +for_which_ --> [para], spaces(_), [el], spaces(_), [cual], spaces(_). % spanish singular +for_which_ --> [pour], spaces(_), [qui], spaces(_). % french +for_which_ --> [per], spaces(_), [cui], spaces(_). % italian + +query_header(Ind, Map) --> spaces(Ind), for_which_, list_of_vars([], Map), colon_, spaces_or_newlines(_). +query_header(0, []) --> []. + +list_of_vars(Map1, MapN) --> + extract_variable([',', and, el, et, y, ':'], [], NameWords, [], _), + { name_predicate(NameWords, Name), update_map(_Var, Name, Map1, Map2) }, + rest_of_list_of_vars(Map2, MapN). + +rest_of_list_of_vars(Map1, MapN) --> and_or_comma_, list_of_vars(Map1, MapN). +rest_of_list_of_vars(Map, Map) --> []. + +and_or_comma_ --> [','], spaces(_). +and_or_comma_ --> and_, spaces(_). + +it_becomes_the_case_that_ --> + it_, [becomes], spaces(_), [the], spaces(_), [case], spaces(_), [that], spaces(_). + +it_becomes_not_the_case_that_ --> + it_, [becomes], spaces(_), [not], spaces(_), [the], spaces(_), [case], spaces(_), [that], spaces(_). +it_becomes_not_the_case_that_ --> + it_, [becomes], spaces(_), [no], spaces(_), [longer], spaces(_), [the], spaces(_), [case], spaces(_), [that], spaces(_). + +when_ --> [when], spaces(_). + +it_ --> [it], spaces(_), !. +it_ --> ['It'], spaces(_). + +observe_ --> [observe], spaces(_). + +it_is_illegal_that_ --> + it_, [is], spaces(_), [illegal], spaces(_), [that], spaces(_). + +it_is_unknown_whether_ --> + it_, [is], spaces(_), [unknown], spaces(_), [whether], spaces(_). + +it_is_unknown_whether_ --> + it_, [is], spaces(_), [unknown], spaces(_), [that], spaces(_). + +it_is_unknown_whether_ --> + [non], spaces(_), [è], spaces(_), [noto], spaces(_), [se], spaces(_). % italian + +/* --------------------------------------------------- Supporting code */ +% indentation code +% ri/2 ri(-Conditions, +IndentedForm). + +ri(P, L) :- rinden(Q, L), c2p(Q, P). + +% rinden/2 produces the conditions from the list with the indented form. +rinden(Q, List) :- rind(_, _, Q, List). + +rind(L, I, Q, List) :- rind_and(L, I, Q, List); rind_or(L, I, Q, List). + +rind_and(100, [], true, []). +rind_and(100, [], Cond, [Cond]) :- simple(Cond). +rind_and(T, [T|RestT], and(First,Rest), Final) :- + combine(NewF, [ind(T), and|RestC], Final), + rind(T1, Tr1, First, NewF), + T1>T, + rind(Tn, Tr, Rest, RestC), + append(Tr1, Tr, RestT), + right_order_and(Rest, Tn, T). + +rind_or(100, [], false, []). +rind_or(100, [], Cond, [Cond]) :- simple(Cond). +rind_or(T, [T|RestT], or(First,Rest), Final) :- + combine(NewF, [ind(T), or|RestC], Final), + rind(T1, Tr1, First, NewF), + T1>T, + rind(Tn, Tr, Rest, RestC), + append(Tr1, Tr, RestT), + right_order_or(Rest, Tn, T). + +right_order_and(Rest, Tn, T) :- Rest=or(_,_), Tn>T. +right_order_and(Rest, Tn, T) :- Rest=and(_,_), Tn=T. +right_order_and(Rest, _, _) :- simple(Rest). + +right_order_or(Rest, Tn, T) :- Rest=and(_,_), Tn>T. +right_order_or(Rest, Tn, T) :- Rest=or(_,_), Tn=T. +right_order_or(Rest, _, _) :- simple(Rest). + +combine(F, S, O) :- ( F\=[], S=[ind(_), Op, V], ((Op==and_); (Op==or_)), simple(V), O=F) ; (F=[], O=S). +combine([H|T], S, [H|NT]) :- combine(T, S, NT). + +simple(Cond) :- Cond\=and(_,_), Cond\=or(_,_), Cond\=true, Cond\=false. + +c2p(true, true). +c2p(false, false). +c2p(C, C) :- simple(C). +c2p(and(A, RestA), (AA, RestAA)) :- + c2p(A, AA), + c2p(RestA, RestAA). +c2p(or(A, RestA), (AA; RestAA)) :- + c2p(A, AA), + c2p(RestA, RestAA). + +/* --------------------------------------------------- More Supporting code */ +clean_comments([], []) :- !. +clean_comments(['%'|Rest], New) :- % like in prolog comments start with % + jump_comment(Rest, Next), + clean_comments(Next, New). +clean_comments([Code|Rest], [Code|New]) :- + clean_comments(Rest, New). + +jump_comment([], []). +jump_comment([newline(N)|Rest], [newline(N)|Rest]). % leaving the end of line in place +jump_comment([_|R1], R2) :- + jump_comment(R1, R2). + +% template_decl/4 +% cuts added to improve efficiency +template_decl([], [newline(_)|RestIn], [newline(_)|RestIn]) :- + asserterror('LE error: misplaced new line found in a template declaration ', RestIn), !, + fail. % cntrl \n should be rejected as part of a template +template_decl(RestW, [' '|RestIn], Out) :- !, % skip spaces in template + template_decl(RestW, RestIn, Out). +template_decl(RestW, ['\t'|RestIn], Out) :- !, % skip cntrl \t in template + template_decl(RestW, RestIn, Out). +% excluding ends of lines from templates +%template_decl(RestW, [newline(_)|RestIn], Out) :- !, % skip cntrl \n in template +% template_decl(RestW, RestIn, Out). +template_decl([Word|RestW], [Word|RestIn], Out) :- + not(lists:member(Word,['.', ','])), % only . and , as boundaries. Beware! + template_decl(RestW, RestIn, Out), !. +template_decl([], [Word|Rest], [Word|Rest]) :- + lists:member(Word,['.', ',']), !. +template_decl(_, Rest, _) :- + asserterror('LE error found in a template declaration ', Rest), fail. + +% build_template/5 +build_template(RawTemplate, Predicate, Arguments, TypesAndNames, Template) :- + build_template_elements(RawTemplate, [], Arguments, TypesAndNames, OtherWords, Template), + name_predicate(OtherWords, Predicate). + +% build_template_elements(+Input, +Previous, -Args, -TypesNames, -OtherWords, -Template) +build_template_elements([], _, [], [], [], []) :- !. +% a variable signalled by a * +build_template_elements(['*', Word|RestOfWords], _Previous, [Var|RestVars], [Name-Type|RestTypes], Others, [Var|RestTemplate]) :- + has_pairing_asteriks([Word|RestOfWords]), + %(ind_det(Word); ind_det_C(Word)), % Previous \= [is|_], % removing this requirement when * is used + phrase(determiner, [Word|RestOfWords], RRestOfWords), % allows the for variables in templates declarations only + extract_variable_template(['*'], [], NameWords, [], TypeWords, RRestOfWords, ['*'|NextWords]), !, % <-- it must end with * too + name_predicate(NameWords, Name), + name_predicate(TypeWords, Type), + build_template_elements(NextWords, [], RestVars, RestTypes, Others, RestTemplate). +build_template_elements(['*', Word|RestOfWords], _Previous,_, _, _, _) :- + not(has_pairing_asteriks([Word|RestOfWords])), !, fail. % produce an error report if asterisks are not paired +% a variable not signalled by a * % for backward compatibility \\ DEPRECATED +%build_template_elements([Word|RestOfWords], Previous, [Var|RestVars], [Name-Type|RestTypes], Others, [Var|RestTemplate]) :- +% (ind_det(Word); ind_det_C(Word)), Previous \= [is|_], +% extract_variable(['*'], Var, [], NameWords, TypeWords, RestOfWords, NextWords), !, % <-- CUT! +% name_predicate(NameWords, Name), +% name_predicate(TypeWords, Type), +% build_template_elements(NextWords, [], RestVars, RestTypes, Others, RestTemplate). +build_template_elements([Word|RestOfWords], Previous, RestVars, RestTypes, [Word|Others], [Word|RestTemplate]) :- + build_template_elements(RestOfWords, [Word|Previous], RestVars, RestTypes, Others, RestTemplate). + +has_pairing_asteriks(RestOfTemplate) :- + findall('*',member('*', RestOfTemplate), Asteriks), length(Asteriks, N), 1 is mod(N, 2). + +name_predicate(Words, Predicate) :- + concat_atom(Words, '_', Predicate). + +% name_as_atom/2 +name_as_atom([Number], Number) :- + number(Number), !. +name_as_atom([Atom], Number) :- + atom_number(Atom, Number), !. +name_as_atom(Words, Name) :- + numbervars(Words, 1, _, [functor_name('unknown')]), + replace_vars(Words, Atoms), + list_words_to_codes(Atoms, Codes), + replace_ast_a(Codes, CCodes), + atom_codes(Name, CCodes). + +words_to_atom(Words, Name) :- %trace, + numbervars(Words, 0, _, [singletons(true)]), + list_words_to_codes(Words, Codes), + atom_codes(Name, Codes). + +replace_ast_a([], []) :- !. +replace_ast_a([42,32,97|Rest], [42,97|Out]) :- !, + replace_final_ast(Rest, Out). +replace_ast_a([C|Rest], [C|Out]) :- + replace_ast_a(Rest, Out). + +replace_final_ast([], []) :- !. +replace_final_ast([32,42|Rest], [42|Out]) :- !, + replace_ast_a(Rest, Out). +replace_final_ast([C|Rest], [C|Out]) :- + replace_final_ast(Rest, Out). + +% maps a list of words to a list of corresponding codes +% adding an space between words-codes (32). +% list_word_to_codes/2 +list_words_to_codes([], []). +list_words_to_codes([Word|RestW], Out) :- + atom_codes(Word, Codes), + remove_quotes(Codes, CleanCodes), + list_words_to_codes(RestW, Next), + (Next=[]-> Out=CleanCodes; + % if it comes the symbol _ + - / \ or the previous is only + o - then no space is added between words + (Next=[95|_]; Next=[43|_]; Next=[45|_]; Next=[47|_]; Next=[92|_]; + CleanCodes=[43]; CleanCodes=[45])-> + append(CleanCodes, Next, Out); + append(CleanCodes, [32|Next], Out) + ), !. + +remove_quotes([], []) :-!. +remove_quotes([39|RestI], RestC) :- remove_quotes(RestI, RestC), !. +% quick fix to remove parentheses and numbers too. +remove_quotes([40, _, 41|RestI], RestC) :- remove_quotes(RestI, RestC), !. +%remove_quotes([41|RestI], RestC) :- remove_quotes(RestI, RestC), !. +remove_quotes([C|RestI], [C|RestC]) :- remove_quotes(RestI, RestC). + +replace_vars([],[]) :- !. +replace_vars([A|RI], [A|RO]) :- atom(A), replace_vars(RI,RO), !. +replace_vars([W|RI], [A|RO]) :- term_to_atom(W, A), replace_vars(RI,RO). + +add_cond(and, Ind1, Ind2, Previous, C4, (C; (C3, C4))) :- + last_cond(or, Previous, C, C3), % (C; C3) + Ind1 < Ind2, !. +add_cond(and, Ind1, Ind2, Previous, C4, ((C; C3), C4)) :- + last_cond(or, Previous, C, C3), % (C; C3) + Ind1 > Ind2, !. +add_cond(and,I, I, (C, C3), C4, (C, (C3, C4))) :- !. +add_cond(and,_, _, Cond, RestC, (Cond, RestC)) :- !. +add_cond(or, Ind1, Ind2, Previous, C4, (C, (C3; C4))) :- + last_cond(and, Previous, C, C3), % (C, C3) + Ind1 < Ind2, !. +add_cond(or, Ind1, Ind2, Previous, C4, ((C, C3); C4)) :- + last_cond(and, Previous, C, C3), % (C, C3) + Ind1 > Ind2, !. +add_cond(or, I, I, (C; C3), C4, (C; (C3; C4))) :- !. +add_cond(or, _, _, Cond, RestC, (Cond; RestC)). + +last_cond(or, (A;B), A, B) :- B\=(_;_), !. +last_cond(or, (C;D), (C;R), Last) :- last_cond(or, D, R, Last). + +last_cond(and, (A,B), A, B) :- B\=(_,_), !. +last_cond(and, (C,D), (C,R), Last) :- last_cond(and, D, R, Last). + +% adjust_op(Ind1, Ind2, PreviousCond, Op1, Cond2, Op2, Rest, RestMapped, Conditions) +% from and to and +adjust_op(Ind1, Ind2, C1, and, C2, and, C3, ((C1, C2), C3) ) :- + Ind1 =< Ind2, !. +adjust_op(Ind1, Ind2, C1, and, C2, and, C3, ((C1, C2), C3) ) :- + Ind1 > Ind2, !. +% from or to ord +adjust_op(Ind1, Ind2, C1, or, C2, or, C3, ((C1; C2); C3) ) :- + Ind1 =< Ind2, !. +adjust_op(Ind1, Ind2, C1, or, C2, or, C3, ((C1; C2); C3) ) :- + Ind1 > Ind2, !. +% from and to deeper or +adjust_op(Ind1, Ind2, C1, and, C2, or, C3, (C1, (C2; C3)) ) :- + Ind1 < Ind2, !. +% from deeper or to and +adjust_op(Ind1, Ind2, C1, or, C2, and, C3, ((C1; C2), C3) ) :- + Ind1 > Ind2, !. +% from or to deeper and +adjust_op(Ind1, Ind2, C1, or, C2, and, C3, (C1; (C2, C3)) ) :- + Ind1 < Ind2, !. +% from deeper and to or +adjust_op(Ind1, Ind2, C1, and, C2, or, C3, ((C1, C2); C3) ) :- + Ind1 > Ind2. + +operator(and, In, Out) :- and_(In, Out). +operator(or, In, Out) :- or_(In, Out). + +% possible_instance/3 +% cuts added to improve efficiency +% skipping a list +possible_instance([], [], []) :- !. +possible_instance(Final, ['['|RestIn], Out) :- !, + possible_instance_for_lists(List, RestIn, [']'|Next]), + possible_instance(RestW, Next, Out), + append(['['|List], [']'|RestW], Final). +possible_instance(RestW, [' '|RestIn], Out) :- !, % skip spaces in template + possible_instance(RestW, RestIn, Out). +possible_instance(RestW, ['\t'|RestIn], Out) :- !, % skip tabs in template + possible_instance(RestW, RestIn, Out). +possible_instance([that|Instance], In, Out) :- % to allow "that" instances to spread over more than one line + phrase(spaces_or_newlines(_), In, [that|Rest]), + phrase(spaces_or_newlines(_), Rest, Next), !, + possible_instance(Instance, Next, Out). +possible_instance([Word|RestW], [Word|RestIn], Out) :- + %not(lists:member(Word,['\n', if, and, or, '.', ','])), !, + not(lists:member(Word,[newline(_), if, '.', ','])), + % leaving the comma in as well (for lists and sets we will have to modify this) + possible_instance(RestW, RestIn, Out). +possible_instance([], [Word|Rest], [Word|Rest]) :- + lists:member(Word,[newline(_), if, '.', ',']). % leaving or/and out of this + +% using [ and ] for list and set only to avoid clashes for commas +%possible_instance_for_lists([], [], []) :- !. +possible_instance_for_lists([], [']'|Out], [']'|Out]) :- !. +possible_instance_for_lists(RestW, [' '|RestIn], Out) :- !, % skip spaces in template + possible_instance_for_lists(RestW, RestIn, Out). +possible_instance_for_lists(RestW, ['\t'|RestIn], Out) :- !, % skip tabs in template + possible_instance_for_lists(RestW, RestIn, Out). +possible_instance_for_lists([Word|RestW], [Word|RestIn], Out) :- + %not(lists:member(Word,['\n', if, and, or, '.', ','])), !, + possible_instance_for_lists(RestW, RestIn, Out). +%possible_instance_for_lists([], [Word|Rest], [Word|Rest]) :- +% lists:member(Word,[',', newline(_), if, '.']). % leaving or/and out of this + +% match_template/4 +match_template(PossibleLiteral, Map1, MapN, Literal) :- + %print_message(informational,'Possible Meta Literal ~w'-[PossibleLiteral]), + meta_dictionary(Predicate, _, MetaCandidate), + meta_match(MetaCandidate, PossibleLiteral, Map1, MapN, MetaTemplate), !, + meta_dictionary(Predicate, _, MetaTemplate), + Literal =.. Predicate. + +match_template(PossibleLiteral, Map1, MapN, Literal) :- + %print_message(informational,'Possible Literal ~w'-[PossibleLiteral]), + dictionary(Predicate, _, Candidate), + match(Candidate, PossibleLiteral, Map1, MapN, Template), !, + dictionary(Predicate, _, Template), + Literal =.. Predicate. + %print_message(informational,'Match!! with ~w'-[Literal]).% !. + +% meta_match/5 +% meta_match(+CandidateTemplate, +PossibleLiteral, +MapIn, -MapOut, -SelectedTemplate) +meta_match([], [], Map, Map, []) :- !. +meta_match([Word|_LastElement], [Word|PossibleLiteral], Map1, MapN, [Word,Literal]) :- % asuming Element is last in template! + Word = that, % that is a reserved word "inside" templates! -> that + (meta_dictionary(Predicate, _, Candidate); dictionary(Predicate, _, Candidate)), % searching for a new inner literal + match(Candidate, PossibleLiteral, Map1, MapN, InnerTemplate), + (meta_dictionary(Predicate, _, InnerTemplate); dictionary(Predicate, _, InnerTemplate)), + Literal =.. Predicate, !. +meta_match([MetaElement|RestMetaElements], [MetaWord|RestPossibleLiteral], Map1, MapN, [MetaElement|RestSelected]) :- + nonvar(MetaElement), MetaWord = MetaElement, !, + meta_match(RestMetaElements, RestPossibleLiteral, Map1, MapN, RestSelected). +%meta_match([MetaElement|RestMetaElements], PossibleLiteral, Map1, MapN, [Literal|RestSelected]) :- +% var(MetaElement), stop_words(RestMetaElements, StopWords), +% extract_literal(StopWords, LiteralWords, PossibleLiteral, NextWords), +% meta_dictionary(Predicate, _, Candidate), +% match(Candidate, LiteralWords, Map1, Map2, Template), %only two meta levels! % does not work. +% meta_dictionary(Predicate, _, Template), +% Literal =.. Predicate, !, +% meta_match(RestMetaElements, NextWords, Map2, MapN, RestSelected). +meta_match([MetaElement|RestMetaElements], PossibleLiteral, Map1, MapN, [Literal|RestSelected]) :- + var(MetaElement), stop_words(RestMetaElements, StopWords), + extract_literal(StopWords, LiteralWords, PossibleLiteral, NextWords), + dictionary(Predicate, _, Candidate), % this assumes that the "contained" literal is an object level literal. + match(Candidate, LiteralWords, Map1, Map2, Template), + dictionary(Predicate, _, Template), + Literal =.. Predicate, !, + meta_match(RestMetaElements, NextWords, Map2, MapN, RestSelected). +% it could also be an object level matching of other kind +meta_match([Element|RestElements], [Det|PossibleLiteral], Map1, MapN, [Var|RestSelected]) :- + var(Element), + phrase(indef_determiner, [Det|PossibleLiteral], RPossibleLiteral), stop_words(RestElements, StopWords), + extract_variable(StopWords, [], NameWords, [], _, RPossibleLiteral, NextWords), NameWords \= [], % <- leave that _ unbound! + name_predicate(NameWords, Name), + update_map(Var, Name, Map1, Map2), !, % <-- CUT! + meta_match(RestElements, NextWords, Map2, MapN, RestSelected). +meta_match([Element|RestElements], [Det|PossibleLiteral], Map1, MapN, [Var|RestSelected]) :- + var(Element), + phrase(def_determiner, [Det|PossibleLiteral], RPossibleLiteral), stop_words(RestElements, StopWords), + extract_variable(StopWords, [], NameWords, [], _, RPossibleLiteral, NextWords), NameWords \= [], % <- leave that _ unbound! + name_predicate(NameWords, Name), + consult_map(Var, Name, Map1, Map2), !, % <-- CUT! + meta_match(RestElements, NextWords, Map2, MapN, RestSelected). +% handling symbolic variables (as long as they have been previously defined and included in the map!) +meta_match([Element|RestElements], PossibleLiteral, Map1, MapN, [Var|RestSelected]) :- + var(Element), stop_words(RestElements, StopWords), + extract_variable(StopWords, [], NameWords, [], _, PossibleLiteral, NextWords), NameWords \= [], % <- leave that _ unbound! + name_predicate(NameWords, Name), + consult_map(Var, Name, Map1, Map2), !, % <-- CUT! % if the variables has been previously registered + meta_match(RestElements, NextWords, Map2, MapN, RestSelected). +meta_match([Element|RestElements], ['['|PossibleLiteral], Map1, MapN, [List|RestSelected]) :- + var(Element), stop_words(RestElements, StopWords), + extract_list([']'|StopWords], List, Map1, Map2, PossibleLiteral, [']'|NextWords]), !, % matching brackets verified + meta_match(RestElements, NextWords, Map2, MapN, RestSelected). +% enabling expressions and constants +meta_match([Element|RestElements], [Word|PossibleLiteral], Map1, MapN, [Expression|RestSelected]) :- + var(Element), stop_words(RestElements, StopWords), + extract_expression([','|StopWords], NameWords, [Word|PossibleLiteral], NextWords), NameWords \= [], + % this expression cannot add variables + ( phrase(expression_(Expression, Map1, Map1), NameWords) -> true ; ( name_predicate(NameWords, Expression) ) ), + %print_message(informational, 'found a constant or an expression '), print_message(informational, Expression), + meta_match(RestElements, NextWords, Map1, MapN, RestSelected). + +% match/5 +% match(+CandidateTemplate, +PossibleLiteral, +MapIn, -MapOut, -SelectedTemplate) +match([], [], Map, Map, []) :- !. % success! It succeds iff PossibleLiteral is totally consumed +% meta level access: that New Literal +match([Word|_LastElement], [Word|PossibleLiteral], Map1, MapN, [Word,Literal]) :- % asuming Element is last in template! + Word = that, % that is a reserved word "inside" templates! -> that + (meta_dictionary(Predicate, _, Candidate); dictionary(Predicate, _, Candidate)), % searching for a new inner literal + match(Candidate, PossibleLiteral, Map1, MapN, InnerTemplate), + (meta_dictionary(Predicate, _, InnerTemplate); dictionary(Predicate, _, InnerTemplate)), + Literal =.. Predicate, !. +%match([Element, Apost|RestElements], [_Word|PossibleLiteral], Map1, MapN, [Element, Apost|RestSelected]) :- +% nonvar(Element), atom_string(Apost, "'"), !, %Word aprox= Element, TO BE DONE: full test +% match(RestElements, PossibleLiteral, Map1, MapN, RestSelected). +%match([Element|RestElements], [_Word, Apost|PossibleLiteral], Map1, MapN, [Element|RestSelected]) :- +% nonvar(Element), atom_string(Apost, "'"), !, %Word aprox= Element, TO BE DONE: full test +% match(RestElements, PossibleLiteral, Map1, MapN, RestSelected). +match([Element|RestElements], [Word|PossibleLiteral], Map1, MapN, [Element|RestSelected]) :- + nonvar(Element), Word = Element, + match(RestElements, PossibleLiteral, Map1, MapN, RestSelected). +match([Element|RestElements], [Det|PossibleLiteral], Map1, MapN, [Var|RestSelected]) :- + var(Element), + phrase(indef_determiner,[Det|PossibleLiteral], RPossibleLiteral), stop_words(RestElements, StopWords), + extract_variable(StopWords, [], NameWords, [], _, RPossibleLiteral, NextWords), NameWords \= [], % <- leave that _ unbound! + name_predicate(NameWords, Name), + update_map(Var, Name, Map1, Map2), !, % <-- CUT! + match(RestElements, NextWords, Map2, MapN, RestSelected). +match([Element|RestElements], [Det|PossibleLiteral], Map1, MapN, [Var|RestSelected]) :- + var(Element), + phrase(def_determiner, [Det|PossibleLiteral], RPossibleLiteral), stop_words(RestElements, StopWords), + extract_variable(StopWords, [], NameWords, [], _, RPossibleLiteral, NextWords), NameWords \= [], % <- leave that _ unbound! + name_predicate(NameWords, Name), + consult_map(Var, Name, Map1, Map2), !, % <-- CUT! + match(RestElements, NextWords, Map2, MapN, RestSelected). +% handling symbolic variables (as long as they have been previously defined and included in the map!) +match([Element|RestElements], PossibleLiteral, Map1, MapN, [Var|RestSelected]) :- + var(Element), stop_words(RestElements, StopWords), + extract_variable(StopWords, [], NameWords, [], _, PossibleLiteral, NextWords), NameWords \= [], % <- leave that _ unbound! + name_predicate(NameWords, Name), + consult_map(Var, Name, Map1, Map2), !, % <-- CUT! % if the variables has been previously registered + match(RestElements, NextWords, Map2, MapN, RestSelected). +match([Element|RestElements], ['['|PossibleLiteral], Map1, MapN, [List|RestSelected]) :- + var(Element), stop_words(RestElements, StopWords), + extract_list([']'|StopWords], List, Map1, Map2, PossibleLiteral, [']'|NextWords]), % matching brackets verified + %print_message(informational, "List ~w"-[List]), + %correct_list(List, Term), + match(RestElements, NextWords, Map2, MapN, RestSelected). +% enabling expressions and constants +match([Element|RestElements], [Word|PossibleLiteral], Map1, MapN, [Expression|RestSelected]) :- + var(Element), stop_words(RestElements, StopWords), + %print_message(informational, [Word|PossibleLiteral]), + extract_expression([','|StopWords], NameWords, [Word|PossibleLiteral], NextWords), NameWords \= [], + % print_message(informational, "Expression? ~w"-[NameWords]), + % this expression cannot add variables + ( phrase(expression_(Expression, Map1, _), NameWords) -> true ; ( name_predicate(NameWords, Expression) ) ), + %print_message(informational, 'found a constant or an expression '), print_message(informational, Expression), + match(RestElements, NextWords, Map1, MapN, RestSelected). + +correct_list([], []) :- !. +correct_list([A,B], [A,B]) :- atom(B), !. % not(is_list(B)), !. +correct_list([A,B], [A|B] ) :- !. +correct_list([A|B], [A|NB]) :- correct_list(B, NB). + +% expression/3 or /5 +%expression_(List, MapIn, MapOut) --> list_(List, MapIn, MapOut), !. +% expression_ resolve simple math (non boolean) expressions fttb. +% dates must be dealt with first +% 2021-02-06T08:25:34 is transformed into 1612599934.0. +expression_(DateInSeconds, Map, Map) --> + [Year,'-', Month, '-', DayTHours,':', Minutes, ':', Seconds], spaces(_), + { concat_atom([Year,'-', Month, '-', DayTHours,':', Minutes, ':', Seconds], '', Date), + parse_time(Date,DateInSeconds) %, print_message(informational, "~w"-[DateInSeconds]) + }, !. +% 2021-02-06 +expression_(DateInSeconds, Map, Map) --> [Year,'-', Month, '-', Day], spaces(_), + { concat_atom([Year, Month, Day], '', Date), parse_time(Date, DateInSeconds) }, !. +% basic float extracted from atoms from the tokenizer +%expression_(Float, Map, Map) --> [AtomNum,'.',AtomDecimal], +% { atom(AtomNum), atom(AtomDecimal), atomic_list_concat([AtomNum,'.',AtomDecimal], Atom), atom_number(Atom, Float) }, !. +expression_(Number, Map, Map) --> [Number], {number(Number)}. +% mathematical expressions +expression_(InfixBuiltIn, Map1, MapN) --> + {op_stop(Stop)}, %{print_message(informational, "Stop at ~w"-[Stop])}, + term_(Stop, Term, Map1, Map2), spaces(_), + binary_op(BuiltIn), + spaces(_), expression_(Expression, Map2, MapN), spaces(_), + !, + %{print_message(informational, "Term ~w and BuiltIn ~w and Expression ~w"-[Term, BuiltIn, Expression])}, + { InfixBuiltIn=..[BuiltIn, Term, Expression] }. %, + %print_message(informational, " ~w ~w ~w with map ~w "-[Term, BuiltIn, Expression, MapN]) }. % , +% signed Value +expression_(SignedExpression, Map1, MapN) --> % disregarding + for the time being + %{print_message(informational, " minus something ~w"-[Map1])}, + minus_, spaces(_), expression_(Expression, Map1, MapN), spaces(_), !, + {SignedExpression =.. [(-), Expression]}. +% parentheses expression +expression_(Expression, Map1, MapN) --> + parenthesis_open_, spaces(_), expression_(Expression, Map1, MapN), spaces(_), parenthesis_close_, !. %,{print_message(informational, " parentheses (~w)"-[Expression])}. +% a quick fix for integer numbers extracted from atoms from the tokenizer +expression_(Number, Map, Map) --> [Atom], spaces(_), { atom(Atom), atom_number(Atom, Number) }, !. +expression_(Var, Map1, Map2) --> {op_stop(Stop)}, variable(Stop, Var, Map1, Map2),!. +expression_(Constant, Map1, Map2) --> {op_stop(Stop)}, constant(Stop, Constant, Map1, Map2). %, {print_message(informational, "Constant Expression ~w"-Constant)}. +% error clause +expression_(_, _, _, Rest, _) :- + asserterror('LE error found in an expression ', Rest), fail. + +% operators with any amout of words/symbols +% binary_op/3 +binary_op(Op, In, Out) :- + op2tokens(Op, OpTokens, _), + append(OpTokens, Out, In). + +% very inefficient. Better to compute and store. See below +op_tokens(Op, OpTokens) :- + current_op(_Prec, Fix, Op), Op \= '.', % Regenerate response + (Fix = 'xfx'; Fix='yfx'; Fix='xfy'; Fix='yfy'), + term_string(Op, OpString), tokenize(OpString, Tokens, [cased(true), spaces(true), numbers(false)]), + unpack_tokens(Tokens, OpTokens). + +% findall(op2tokens(Op, OpTokens, OpTokens), op_tokens(Op, OpTokens), L), forall(member(T,L), (write(T),write('.'), nl)). +% op2tokens(+Operator, PrologTokens, sCASPTokens) +% op2tokens/3 +% disengaging any expression seemingly in natural language +%op2tokens(is_not_before,[is_not_before],[is_not_before]). +%op2tokens(of,[of],[of]). +%op2tokens(if,[if],[if]). +%op2tokens(then,[then],[then]). +%op2tokens(must,[must],[must]). +%op2tokens(on,[on],[on]). +%op2tokens(because,[because],[because]). +%op2tokens(and,[and],[and]). +%op2tokens(in,[in],[in]). +%op2tokens(or,[or],[or]). +%op2tokens(at,[at],[at]). +%op2tokens(before,[before],[before]). +%op2tokens(after,[after],[after]). +%op2tokens(else,[else],[else]). +%op2tokens(with,[with],[with]). +op2tokens(::,[:,:],[:,:]). +op2tokens(->,[-,>],[-,>]). +op2tokens(:,[:],[:]). +%op2tokens(,,[',,,'],[',,,']). +op2tokens(:=,[:,=],[:,=]). +op2tokens(==,[=,=],[=,=]). +op2tokens(:-,[:,-],[:,-]). +op2tokens(/\,[/,\],[/,\]). +op2tokens(=,[=],[=]). +%op2tokens(rem,[rem],[rem]). +%op2tokens(is,[is],[is]). +op2tokens(=:=,[=,:,=],[=,:,=]). +op2tokens(=\=,[=,\,=],[=,\,=]). +op2tokens(xor,[xor],[xor]). +%op2tokens(as,[as],[as]). +op2tokens(rdiv,[rdiv],[rdiv]). +op2tokens(>=,[>,=],[>,=]). +op2tokens(@<,[@,<],[@,<]). +op2tokens(@=<,[@,=,<],[@,=,<]). +op2tokens(=@=,[=,@,=],[=,@,=]). +op2tokens(\=@=,[\,=,@,=],[\,=,@,=]). +op2tokens(@>,[@,>],[@,>]). +op2tokens(@>=,[@,>,=],[@,>,=]). +op2tokens(\==,[\,=,=],[\,=,=]). +op2tokens(\=,[\,=],[\,=]). +op2tokens(>,[>],[>]). +%op2tokens(|,[',|,'],[',|,']). +op2tokens('|',['|'],['|']). +op2tokens(\/,[\,/],[\,/]). +op2tokens(+,[+],[+]). +op2tokens(>>,[>,>],[>,>]). +op2tokens(;,[;],[;]). +op2tokens(<<,[<,<],[<,<]). +op2tokens(:<,[:,<],[:,<]). +op2tokens(>:<,[>,:,<],[>,:,<]). +op2tokens(/,[/],[/]). +op2tokens(=>,[=,>],[=,>]). +op2tokens(=..,[=,.,.],[=,.,.]). +op2tokens(div,[div],[div]). +op2tokens(//,[/,/],[/,/]). +op2tokens(**,[*,*],[*,*]). +op2tokens(*,[*],[*]). +op2tokens(^,[^],[^]). +op2tokens(mod,[mod],[mod]). +op2tokens(-,[-],[-]). +op2tokens(*->,[*,-,>],[*,-,>]). +op2tokens(<,[<],[<]). +op2tokens(=<,[=,<],[=,<]). +op2tokens(-->,[-,-,>],[-,-,>]). + +% very inefficient. Better to compute and store. See below +op_stop_words(Words) :- + op_stop(Words) -> true; ( + findall(Word, + (current_op(_Prec, _, Op), Op \= '.', % dont include the period! + term_string(Op, OpString), + tokenize(OpString, Tokens, [cased(true), spaces(true), numbers(false)]), + unpack_tokens(Tokens, [Word|_])), Words), % taking only the first word as stop word + assertz(op_stop(Words)) + ), !. + +% disengaging any word or phrase in natural language +op_stop([ + %(on), + %(because), + %(is_not_before), + %(not), + %(before), + %(and), + %(or), + %(at), + (html_meta), + %(after), + %(in), + %(else), + (+), + %(then), + %(must), + %(if), + ($), + (\), + (=), + (thread_initialization), + (:), + (\), + '\'', + (xor), + (:), + (rem), + (\), + %(table), + %(initialization), + (rdiv), + (/), + (>), + (>), + (=), + (=), + (;), + %(as), + %(is), + (=), + @, + (\), + (thread_local), + (>), + (=), + (<), + (*), + '\'', + (=), + (\), + (+), + (:), + (>), + (div), + %(discontiguous), + (<), + (/), + %(meta_predicate), + (=), + (-), + %(volatile), + %(public), + (:), + (*), + ?, + (/), + (*), + (-), + %(multifile), + %(dynamic), + (mod), + (^) + %(module_transparent) + ]). + +stop_words([], []). +stop_words([Word|_], [Word]) :- nonvar(Word). % only the next word for now +stop_words([Word|_], []) :- var(Word). + +% list_symbol/1: a symbol specific for list that can be used as stop word for others +list_symbol('['). +list_symbol(']'). + +parenthesis('('). +parenthesis(')'). + +extract_literal(_, [], [], []) :- !. +extract_literal(StopWords, [], [Word|RestOfWords], [Word|RestOfWords]) :- + (member(Word, StopWords); that_(Word); phrase(newline, [Word])), !. +extract_literal(SW, RestName, [' '|RestOfWords], NextWords) :- !, % skipping spaces + extract_literal(SW, RestName, RestOfWords, NextWords). +extract_literal(SW, RestName, ['\t'|RestOfWords], NextWords) :- !, + extract_literal(SW, RestName, RestOfWords, NextWords). +extract_literal(SW, [Word|RestName], [Word|RestOfWords], NextWords) :- + extract_literal(SW, RestName, RestOfWords, NextWords). + +% extract_variable_template/7 +% extract_variable_template(+StopWords, +InitialNameWords, -FinalNameWords, +InitialTypeWords, -FinalTypeWords, +ListOfWords, -NextWordsInText) +% refactored as a dcg predicate +extract_variable_template(_, Names, Names, Types, Types, [], []) :- !. % stop at when words run out +extract_variable_template(StopWords, Names, Names, Types, Types, [Word|RestOfWords], [Word|RestOfWords]) :- % stop at reserved words, verbs or prepositions. + %(member(Word, StopWords); reserved_word(Word); verb(Word); preposition(Word); punctuation(Word); phrase(newline, [Word])), !. % or punctuation + (member(Word, StopWords); that_(Word); list_symbol(Word); punctuation(Word); phrase(newline, [Word])), !. +extract_variable_template(SW, InName, OutName, InType, OutType, [' '|RestOfWords], NextWords) :- !, % skipping spaces + extract_variable_template(SW, InName, OutName, InType, OutType, RestOfWords, NextWords). +extract_variable_template(SW, InName, OutName, InType, OutType, ['\t'|RestOfWords], NextWords) :- !, % skipping spaces + extract_variable_template(SW, InName, OutName, InType, OutType, RestOfWords, NextWords). +extract_variable_template(SW, InName, OutName, InType, OutType, [Word|RestOfWords], NextWords) :- % ordinals are not part of the type + ordinal(Word), !, + extract_variable_template(SW, [Word|InName], OutName, InType, OutType, RestOfWords, NextWords). +%extract_variable_template(SW, InName, OutName, InType, OutType, [Word|RestOfWords], NextWords) :- % types are not part of the name +% is_a_type(Word), +% extract_variable(SW, InName, NextName, InType, OutType, RestOfWords, NextWords), +% (NextName = [] -> OutName = [Word]; OutName = NextName), !. +extract_variable_template(SW, InName, [Word|OutName], InType, [Word|OutType], [Word|RestOfWords], NextWords) :- % everything else is part of the name (for instances) and the type (for templates) + extract_variable_template(SW, InName, OutName, InType, OutType, RestOfWords, NextWords). + +% extract_variable/7 +% extract_variable(+StopWords, +InitialNameWords, -FinalNameWords, +InitialTypeWords, -FinalTypeWords, +ListOfWords, -NextWordsInText) +% refactored as a dcg predicate +extract_variable(_, Names, Names, Types, Types, [], []) :- !. % stop at when words run out +extract_variable(StopWords, Names, Names, Types, Types, [Word|RestOfWords], [Word|RestOfWords]) :- % stop at reserved words, verbs or prepositions. + %(member(Word, StopWords); reserved_word(Word); verb(Word); preposition(Word); punctuation(Word); phrase(newline, [Word])), !. % or punctuation + (member(Word, StopWords); that_(Word); list_symbol(Word); punctuation(Word); phrase(newline, [Word])), !. +extract_variable(SW, InName, OutName, InType, OutType, [' '|RestOfWords], NextWords) :- !, % skipping spaces + extract_variable(SW, InName, OutName, InType, OutType, RestOfWords, NextWords). +extract_variable(SW, InName, OutName, InType, OutType, ['\t'|RestOfWords], NextWords) :- !, % skipping spaces + extract_variable(SW, InName, OutName, InType, OutType, RestOfWords, NextWords). +extract_variable(SW, InName, OutName, InType, OutType, [Word|RestOfWords], NextWords) :- % ordinals are not part of the type + ordinal(Word), !, + extract_variable(SW, [Word|InName], OutName, InType, OutType, RestOfWords, NextWords). +extract_variable(SW, InName, OutName, InType, OutType, [Word|RestOfWords], NextWords) :- % types are not part of the name + is_a_type(Word), + extract_variable(SW, InName, NextName, InType, OutType, RestOfWords, NextWords), + (NextName = [] -> OutName = [Word]; OutName = NextName), !. +extract_variable(SW, InName, [Word|OutName], InType, [Word|OutType], [Word|RestOfWords], NextWords) :- % everything else is part of the name (for instances) and the type (for templates) + extract_variable(SW, InName, OutName, InType, OutType, RestOfWords, NextWords). + +% extract_expression/4 +% extract_expression(+StopWords, ListOfNameWords, +ListOfWords, NextWordsInText) +% it does not stop at reserved words! +extract_expression(_, [], [], []) :- !. % stop at when words run out +extract_expression(StopWords, [], [Word|RestOfWords], [Word|RestOfWords]) :- % stop at verbs? or prepositions?. + (member(Word, StopWords); that_(Word); list_symbol(Word); parenthesis(Word), phrase(newline, [Word])), !. +%extract_expression([Word|RestName], [Word|RestOfWords], NextWords) :- % ordinals are not part of the name +% ordinal(Word), !, +% extract_constant(RestName, RestOfWords, NextWords). +extract_expression(SW, RestName, [' '|RestOfWords], NextWords) :- !, % skipping spaces + extract_expression(SW, RestName, RestOfWords, NextWords). +extract_expression(SW, RestName, ['\t'|RestOfWords], NextWords) :- !, + extract_expression(SW, RestName, RestOfWords, NextWords). +extract_expression(SW, [Word|RestName], [Word|RestOfWords], NextWords) :- + %is_a_type(Word), + %not(determiner(Word)), % no determiners inside constants! + extract_expression(SW, RestName, RestOfWords, NextWords). + +% extract_constant/4 +% extract_constant(+StopWords, ListOfNameWords, +ListOfWords, NextWordsInText) +extract_constant(_, [], [], []) :- !. % stop at when words run out +extract_constant(StopWords, [], [Word|RestOfWords], [Word|RestOfWords]) :- % stop at reserved words, verbs? or prepositions?. + %(member(Word, StopWords); reserved_word(Word); verb(Word); preposition(Word); punctuation(Word); phrase(newline, [Word])), !. % or punctuation + (member(Word, StopWords); that_(Word); list_symbol(Word); parenthesis(Word); punctuation(Word); phrase(newline, [Word])), !. +%extract_constant([Word|RestName], [Word|RestOfWords], NextWords) :- % ordinals are not part of the name +% ordinal(Word), !, +% extract_constant(RestName, RestOfWords, NextWords). +extract_constant(SW, RestName, [' '|RestOfWords], NextWords) :- !, % skipping spaces + extract_constant(SW, RestName, RestOfWords, NextWords). +extract_constant(SW, RestName, ['\t'|RestOfWords], NextWords) :- !, + extract_constant(SW, RestName, RestOfWords, NextWords). +extract_constant(SW, [Word|RestName], [Word|RestOfWords], NextWords) :- + %is_a_type(Word), + %not(determiner(Word)), % no determiners inside constants! + extract_constant(SW, RestName, RestOfWords, NextWords). + +%extract_string/3 +extract_string([], [], []) :- !. +extract_string([], [newline(A)|RestOfWords], [newline(A)|RestOfWords]):- !. +extract_string([String], InWords, NextWords) :- + extract_all_string([newline(_)], Words, InWords, NextWords), + concat_atom(Words, '', String). + +extract_all_string(StopWords, [], [Word|RestOfWords], RestOfWords) :- + member(Word, StopWords), !. +extract_all_string(StopWords, [Word|RestString], [Word|RestOfWords], NextWords) :- + extract_all_string(StopWords, RestString, RestOfWords, NextWords ). + +% extract_list/6 +% extract_list(+StopWords, -List, +Map1, -Map2, +[Word|PossibleLiteral], -NextWords), +extract_list(SW, [], Map, Map, [Word|Rest], [Word|Rest]) :- + lists:member(Word, SW), !. % stop but leave the symbol for further verification +%extract_list(_, [], Map, Map, [')'|Rest], [')'|Rest]) :- !. +extract_list(SW, RestList, Map1, MapN, [' '|RestOfWords], NextWords) :- !, % skipping spaces + extract_list(SW, RestList, Map1, MapN, RestOfWords, NextWords). +extract_list(SW, RestList, Map1, MapN, [' '|RestOfWords], NextWords) :- !, % skipping spaces + extract_list(SW, RestList, Map1, MapN, RestOfWords, NextWords). +extract_list(SW, RestList, Map1, MapN, ['\t'|RestOfWords], NextWords) :- !, + extract_list(SW, RestList, Map1, MapN, RestOfWords, NextWords). +extract_list(SW, RestList, Map1, MapN, [','|RestOfWords], NextWords) :- !, % skip over commas + extract_list(SW, RestList, Map1, MapN, RestOfWords, NextWords). +extract_list(SW, RestList, Map1, MapN, ['|'|RestOfWords], NextWords) :- !, % skip over | + extract_list(SW, RestList, Map1, MapN, RestOfWords, NextWords). +extract_list(StopWords, List, Map1, MapN, [Det|InWords], LeftWords) :- + phrase(indef_determiner, [Det|InWords], RInWords), + extract_variable(['|'|StopWords], [], NameWords, [], _, RInWords, NextWords), NameWords \= [], % <- leave that _ unbound! + name_predicate(NameWords, Name), + update_map(Var, Name, Map1, Map2), + (NextWords = [']'|_] -> (RestList = [], LeftWords=NextWords, MapN=Map2 ) ; + extract_list(StopWords, RestList, Map2, MapN, NextWords, LeftWords) ), + (RestList\=[] -> List=[Var|RestList]; List=[Var]), + !. +extract_list(StopWords, List, Map1, MapN, [Det|InWords], LeftWords) :- + phrase(def_determiner, [Det|InWords], RInWords), + extract_variable(['|'|StopWords], [], NameWords, [], _, RInWords, NextWords), NameWords \= [], % <- leave that _ unbound! + name_predicate(NameWords, Name), + consult_map(Var, Name, Map1, Map2), + (NextWords = [']'|_] -> (RestList = [], LeftWords=NextWords, MapN=Map2 ) ; + extract_list(StopWords, RestList, Map2, MapN, NextWords, LeftWords) ), + (RestList\=[] -> List=[Var|RestList]; List=[Var]), !. +extract_list(StopWords, List, Map1, MapN, InWords, LeftWords) :- % symbolic variables without determiner + extract_variable(['|'|StopWords], [], NameWords, [], _, InWords, NextWords), NameWords \= [], % <- leave that _ unbound! + name_predicate(NameWords, Name), + consult_map(Var, Name, Map1, Map2), + (NextWords = [']'|_] -> (RestList = [], LeftWords=NextWords, MapN=Map2 ) ; + extract_list(StopWords, RestList, Map2, MapN, NextWords, LeftWords) ), + (RestList\=[] -> List=[Var|RestList]; List=[Var]), !. +extract_list(StopWords, List, Map1, MapN, InWords, LeftWords) :- + extract_expression(['|',','|StopWords], NameWords, InWords, NextWords), NameWords \= [], + ( phrase(expression_(Expression, Map1, Map2), NameWords) -> true + ; ( Map1 = Map2, name_predicate(NameWords, Expression) ) ), + ( NextWords = [']'|_] -> ( RestList = [], LeftWords=NextWords, MapN=Map2 ) + ; extract_list(StopWords, RestList, Map2, MapN, NextWords, LeftWords) ), + extend_list(RestList, Expression, List), !. % print_message(informational, " ~q "-[List]), !. + %(RestList=[_,_|_] -> List=[Expression|RestList] ; + % RestList = [One] -> List=[Expression, One] ; + % RestList = [] -> List = [[]] ), !. + +extend_list([A,B|R], X, List) :- append([X], [A,B|R], List). +extend_list([A], X, [X|[A]]). +extend_list([], X, [X]). + +determiner --> ind_det, !. +determiner --> ind_det_C, !. +determiner --> def_det, !. +determinar --> def_det_C. + +indef_determiner --> ind_det, !. +indef_determiner --> ind_det_C. + +def_determiner --> def_det, !. +def_determiner --> def_det_C. + +rebuild_template(RawTemplate, Map1, MapN, Template) :- + template_elements(RawTemplate, Map1, MapN, [], Template). + +% template_elements(+Input,+InMap, -OutMap, +Previous, -Template) +template_elements([], Map1, Map1, _, []). +template_elements([Word|RestOfWords], Map1, MapN, Previous, [Var|RestTemplate]) :- + (phrase(ind_det, [Word|RestOfWords], RRestOfWords); phrase(ind_det_C,[Word|RestOfWords], RRestOfWords)), Previous \= [is|_], + extract_variable([], [], NameWords, [], _, RRestOfWords, NextWords), !, % <-- CUT! + name_predicate(NameWords, Name), + update_map(Var, Name, Map1, Map2), + template_elements(NextWords, Map2, MapN, [], RestTemplate). +template_elements([Word|RestOfWords], Map1, MapN, Previous, [Var|RestTemplate]) :- + (phrase(def_det, [Word|RestOfWords], RRestOfWords); phrase(def_det_C,[Word|RestOfWords], RRestOfWords)), Previous \= [is|_], + extract_variable([], [], NameWords, [], _, RRestOfWords, NextWords), !, % <-- CUT! + name_predicate(NameWords, Name), + member(map(Var,Name), Map1), % confirming it is an existing variable and unifying + template_elements(NextWords, Map1, MapN, [], RestTemplate). +template_elements([Word|RestOfWords], Map1, MapN, Previous, [Word|RestTemplate]) :- + template_elements(RestOfWords, Map1, MapN, [Word|Previous], RestTemplate). + +% update_map/4 +% update_map(?V, +Name, +InMap, -OutMap) +update_map(V, Name, InMap, InMap) :- + var(V), nonvar(Name), nonvar(InMap), + member(map(O,Name), InMap), O\==V, fail, !. +update_map(V, Name, InMap, OutMap) :- % updates the map by adding a new variable into it. + var(V), nonvar(Name), nonvar(InMap), + not(member(map(_,Name), InMap)), + OutMap = [map(V,Name)|InMap]. +%update_map(V, _, Map, Map) :- +% nonvar(V). + +% consult_map/4 +% consult_map(+V, -Name, +Inmap, -OutMap) +consult_map(V, Name, InMap, InMap) :- + member(map(Var, SomeName), InMap), (Name == SomeName -> Var = V; ( Var == V -> Name = SomeName ; fail ) ), !. +%consult_map(V, V, Map, Map). % leave the name unassigned % deprecated to be used inside match + +builtin_(BuiltIn, [BuiltIn1, BuiltIn2|RestWords], RestWords) :- + atom_concat(BuiltIn1, BuiltIn2, BuiltIn), + Predicate =.. [BuiltIn, _, _], % only binaries fttb + predicate_property(system:Predicate, built_in), !. +builtin_(BuiltIn, [BuiltIn|RestWords], RestWords) :- + Predicate =.. [BuiltIn, _, _], % only binaries fttb + predicate_property(system:Predicate, built_in). + +/* --------------------------------------------------------- Utils in Prolog */ +time_of(P, T) :- P=..[_|Arguments], lists:append(_, [T], Arguments). % it assumes time as the last argument + +% Unwraps tokens, excelt for newlines which become newline(NextLineNumber) +unpack_tokens([], []). +unpack_tokens([cntrl(Char)|Rest], [newline(Next)|NewRest]) :- (Char=='\n' ; Char=='\r'), !, + %not sure what will happens on env that use \n\r + update_nl_count(Next), unpack_tokens(Rest, NewRest). +unpack_tokens([First|Rest], [New|NewRest]) :- + (First = word(New); First=cntrl(New); First=punct(New); First=space(New); First=number(New); First=string(New)), + !, + unpack_tokens(Rest, NewRest). + +% increments the next line number +update_nl_count(NN) :- retract(last_nl_parsed(N)), !, NN is N + 1, assert(last_nl_parsed(NN)). + +ordinal(Ord) :- + ordinal(_, Ord). + +ordinal(1, 'first'). +ordinal(2, 'second'). +ordinal(3, 'third'). +ordinal(4, 'fourth'). +ordinal(5, 'fifth'). +ordinal(6, 'sixth'). +ordinal(7, 'seventh'). +ordinal(8, 'eighth'). +ordinal(9, 'ninth'). +ordinal(10, 'tenth'). +% french +ordinal(1, 'premier'). +ordinal(2, 'seconde'). +ordinal(3, 'troisième'). +ordinal(4, 'quatrième'). +ordinal(5, 'cinquième'). +ordinal(6, 'sixième'). +ordinal(7, 'septième'). +ordinal(8, 'huitième'). +ordinal(9, 'neuvième'). +ordinal(10, 'dixième'). +% spanish male +ordinal(1, 'primero'). +ordinal(2, 'segundo'). +ordinal(3, 'tercero'). +ordinal(4, 'cuarto'). +ordinal(5, 'quinto'). +ordinal(6, 'sexto'). +ordinal(7, 'séptimo'). +ordinal(8, 'octavo'). +ordinal(9, 'noveno'). +ordinal(10, 'decimo'). +% spanish female +ordinal(1, 'primera'). +ordinal(2, 'segunda'). +ordinal(3, 'tercera'). +ordinal(4, 'cuarta'). +ordinal(5, 'quinta'). +ordinal(6, 'sexta'). +ordinal(7, 'séptima'). +ordinal(8, 'octava'). +ordinal(9, 'novena'). +ordinal(10, 'decima'). + +%is_a_type/1 +is_a_type(T) :- % pending integration with wei2nlen:is_a_type/1 + %ground(T), + (is_type(T); pre_is_type(T)), !. + %(T=time; T=date; T=number; T=person; T=day). % primitive types to start with + %not(number(T)), not(punctuation(T)), + %not(reserved_word(T)), + %not(verb(T)), + %not(preposition(T)). + +/* ------------------------------------------------ determiners */ + +ind_det_C --> ['A']. +ind_det_C --> ['An']. +ind_det_C --> ['Un']. % spanish, italian, and french +ind_det_C --> ['Una']. % spanish, italian +ind_det_C --> ['Une']. % french +ind_det_C --> ['Qui']. % french which? +ind_det_C --> ['Quoi']. % french which? +ind_det_C --> ['Uno']. % italian +ind_det_C --> ['Che']. % italian which +ind_det_C --> ['Quale']. % italian which +% ind_det_C('Some'). +ind_det_C --> ['Each']. % added experimental +ind_det_C --> ['Which']. % added experimentally +ind_det_C --> ['Cuál']. % added experimentally spanish + +def_det_C --> ['The']. +def_det_C --> ['El']. % spanish +def_det_C --> ['La']. % spanish, italian, and french +def_det_C --> ['Le']. % french +def_det_C --> ['L'], [A], {atom_string(A, "'")}. % french +def_det_C --> ['Il']. % italian +def_det_C --> ['Lo']. % italian + +ind_det --> [a]. +ind_det --> [an]. +ind_det --> [another]. % added experimentally +ind_det --> [which]. % added experimentally +ind_det --> [each]. % added experimentally +ind_det --> [un]. % spanish, italian, and french +ind_det --> [una]. % spanish, italian +ind_det --> [une]. % french +ind_det --> [qui]. % french which? +ind_det --> [quel]. % french which? masculine +ind_det --> [quelle]. % french which? femenine +ind_det --> [che]. % italian which +ind_det --> [quale]. % italian which +ind_det --> [uno]. % italian +ind_det --> ['cuál']. % spanish +% ind_det(some). + +def_det --> [the]. +def_det --> [el]. % spanish +def_det --> [la]. % spanish, italian and french +def_det --> [le]. % french +def_det --> [l], [A], {atom_string(A, "'")}. % french, italian +def_det --> [il]. % italian +def_det --> [lo]. % italian + +/* ------------------------------------------------ reserved words */ +reserved_word(W) :- % more reserved words pending?? + W = 'is'; W ='not'; W='if'; W='If'; W='then'; W = 'where'; W = '&'; % <- hack! + W = 'at'; W= 'from'; W='to'; W='half'; % W='or'; W='and'; % leaving and/or out of this for now + W = 'else'; W = 'otherwise'; + W = such ; + W = '<'; W = '='; W = '>'; W = '+'; W = '-'; W = '/'; W = '*'; % these are handled by extract_expression + W = '{' ; W = '}' ; W = '(' ; W = ')' ; W = '[' ; W = ']', + W = ':', W = ','; W = ';'. % these must be handled by parsing +reserved_word(P) :- punctuation(P). + +that_(that). +that_('That'). + +/* ------------------------------------------------ punctuation */ +%punctuation(punct(_P)). + +punctuation('.'). +punctuation(','). +punctuation(';'). +%punctuation(':'). +punctuation('\''). + +/* ------------------------------------------------ verbs */ +verb(Verb) :- present_tense_verb(Verb); continuous_tense_verb(Verb); past_tense_verb(Verb). + +present_tense_verb(is). +present_tense_verb(complies). +present_tense_verb(does). +present_tense_verb(occurs). +present_tense_verb(meets). +present_tense_verb(relates). +present_tense_verb(can). +present_tense_verb(qualifies). +present_tense_verb(has). +present_tense_verb(satisfies). +present_tense_verb(owns). +present_tense_verb(belongs). +present_tense_verb(applies). +present_tense_verb(must). +present_tense_verb(acts). +present_tense_verb(falls). +present_tense_verb(corresponds). +present_tense_verb(likes). + +continuous_tense_verb(according). +continuous_tense_verb(beginning). +continuous_tense_verb(ending). + +past_tense_verb(spent). +past_tense_verb(looked). +past_tense_verb(could). +past_tense_verb(had). +past_tense_verb(tried). +past_tense_verb(explained). +past_tense_verb(ocurred). + +/* ------------------------------------------------- prepositions */ +preposition(of). +%preposition(on). +preposition(from). +preposition(to). +preposition(at). +preposition(in). +preposition(with). +preposition(plus). +preposition(as). +preposition(by). + +/* ------------------------------------------------- memory handling */ +assertall([]). +assertall([F|R]) :- + not(asserted(F)), + %print_message(informational, "Asserting ~w"-[F]), + assertz(F), !, + assertall(R). +assertall([_F|R]) :- + assertall(R). + +asserted(F :- B) :- clause(F, B). % as a rule with a body +asserted(F) :- clause(F,true). % as a fact + +/* -------------------------------------------------- error handling */ +currentLine(LineNumber, Rest, Rest) :- + once( nth1(_,Rest,newline(NextLine)) ), LineNumber is NextLine-2. + +% assert_error_os/1 +% to save final error to be displayed +assert_error_os([]) :- !. +assert_error_os([error(Message, LineNumber, Tokens)|Re]) :- + asserta(error_notice(error, Message, LineNumber, Tokens)), + assert_error_os(Re). + +asserterror(Me, Rest) :- + %print_message(error, ' Error found'), + %select_first_section(Rest, 40, Context), + %retractall(error_notice(_,_,_,_)), % we will report only the last + once( nth1(N,Rest,newline(NextLine)) ), LineNumber is NextLine-2, + RelevantN is N-1, + length(Relevant,RelevantN), append(Relevant,_,Rest), + findall(Token, (member(T,Relevant), (T=newline(_) -> Token='\n' ; Token=T)), Tokens), + asserta(error_notice(error, Me, LineNumber, Tokens)). % asserting the last first! + +% to select just a chunck of Rest to show. +select_first_section([], _, []) :- !. +select_first_section(_, 0, []) :- !. +select_first_section([E|R], N, [E|NR]) :- + N > 0, NN is N - 1, + select_first_section(R, NN, NR). + +showErrors(File,Baseline) :- % showing the deepest message! + findall(error_notice(error, Me,Pos, ContextTokens), + error_notice(error, Me,Pos, ContextTokens), ErrorsList), + deepest(ErrorsList, + error_notice(error, 'None',0, ['There was no syntax error']), + error_notice(error, MeMax,PosMax, ContextTokensMax)), + atomic_list_concat([MeMax,': '|ContextTokensMax],ContextTokens_), + Line is PosMax+Baseline, + print_message(error,error(syntax_error(ContextTokens_),file(File,Line,_One,_Char))). + % to show them all + %forall(error_notice(error, Me,Pos, ContextTokens), ( + % atomic_list_concat([Me,': '|ContextTokens],ContextTokens_), + % Line is Pos+Baseline, + % print_message(error,error(syntax_error(ContextTokens_),file(File,Line,_One,_Char))) + % )). + +deepest([], Deepest, Deepest) :- !. +deepest([error_notice(error, Me,Pos, ContextTokens)|Rest], + error_notice(error,_Me0, Pos0,_ContextTokens0), Out) :- + Pos0 < Pos, !, + deepest(Rest, error_notice(error, Me,Pos, ContextTokens), Out). +deepest([_|Rest], In, Out) :- + deepest(Rest, In, Out). + +showProgress :- + findall(error_notice(error, Me,Pos, ContextTokens), + error_notice(error, Me,Pos, ContextTokens), ErrorsList), + deepest(ErrorsList, + error_notice(error, 'None',0, ['There was no syntax error']), + error_notice(error, MeMax,PosMax, ContextTokensMax)), + atomic_list_concat([MeMax,': '|ContextTokensMax],ContextTokens_), + Line is PosMax+1, + print_message(informational,error(syntax_error(ContextTokens_),file(someFile,Line,_One,_Char))). + + +spypoint(A,A). % for debugging + +% meta_dictionary(?LiteralElements, ?NamesAndTypes, ?Template) +% for meta templates. See below +% meta_dictionary/1 +meta_dictionary(Predicate, VariablesNames, Template) :- + meta_dict(Predicate, VariablesNames, Template) ; predef_meta_dict(Predicate, VariablesNames, Template). + +:- discontiguous predef_meta_dict/3. +predef_meta_dict([\=, T1, T2], [first_thing-time, second_thing-time], [T1, is, different, from, T2]). +predef_meta_dict([=, T1, T2], [first_thing-time, second_thing-time], [T1, is, equal, to, T2]). + +% dictionary(?LiteralElements, ?NamesAndTypes, ?Template) +% this is a multimodal predicate used to associate a Template with its particular other of the words for LE +% with the Prolog expression of that relation in LiteralElements (not yet a predicate, =.. is done elsewhere). +% NamesAndTypes contains the external name and type (name-type) of each variable just in the other in +% which the variables appear in LiteralElement. +% dictionary/1 +dictionary(Predicate, VariablesNames, Template) :- % dict(Predicate, VariablesNames, Template). + dict(Predicate, VariablesNames, Template) ; predef_dict(Predicate, VariablesNames, Template). +% predef_dict(Predicate, VariablesNames, Template); dict(Predicate, VariablesNames, Template). + +:- discontiguous predef_dict/3. +% predef_dict/3 is a database with predefined templates for LE +% it must be ordered by the side of the third argument, to allow the system to check first the longer template +% with the corresponding starting words. +% for Taxlog examples +predef_dict(['\'s_R&D_expense_credit_is', Project, ExtraDeduction, TaxCredit], + [project-projectid, extra-amount, credit-amount], + [Project, '\'s', 'R&D', expense, credit, is, TaxCredit, plus, ExtraDeduction]). +predef_dict(['can_request_R&D_relief_such_as', Project, ExtraDeduction, TaxCredit], + [project-projectid, extra-amount, credit-amount], + [Project, can, request,'R&D', relief, for, a, credit, of, TaxCredit, with, a, deduction, of, ExtraDeduction]). +predef_dict(['\'s_sme_R&D_relief_is', Project, ExtraDeduction, TaxCredit], + [project-projectid, extra-amount, credit-amount], + [the, 'SME', 'R&D', relief, for, Project, is, estimated, at, TaxCredit, with, an, extra, of, ExtraDeduction]). +predef_dict([project_subject_experts_list_is,Project,Experts], [project-object, experts_list-list], + [Project, has, an, Experts, list]). +predef_dict([rollover_applies,EventID,Asset,Time,Transferor,TransfereesList], [id-event,asset-asset,when-time,from-person,to-list], + [EventID, rollover, of, the, transfer, of, Asset, from, Transferor, to, TransfereesList, at, Time, applies]). +predef_dict([transfer_event,ID,Asset,Time,Transferor,TransfereesList],[id-id,asset-asset,time-time,from-person,to-list], + [event, ID, of, transfering, Asset, from, Transferor, to, TransfereesList, at, Time, occurs]). +predef_dict([s_type_and_liability_are(Asset,Type,Liability), [asset-asset, assettype-type, liabilty-amount], + [the, type, of, asset, Asset, is, Type, its, liability, is, Liability]]). +predef_dict([exempt_transfer,From,To,SecurityIdentifier,Time],[from-taxpayer,to-taxpayer,secID-number, time-time], + [a, transfer, from, From, to, To, with, SecurityIdentifier, at, Time, is, exempt]). +predef_dict([shares_transfer,Sender,Recipient,SecurityID,Time], [from-person, to-person, id-number, time-time], + [Sender, transfers, shares, to, Recipient, at, Time, with, id, SecurityID]). +predef_dict([trading_in_market,SecurityID,MarketID,Time], [id-number,market-number,time-time], + [whoever, is, identified,by, SecurityID, is, trading, in, market, MarketID, at, Time]). +predef_dict([uk_tax_year_for_date,Date,Year,Start,End], [date-date,year-year,start-date,end-date], + [date, Date, falls, in, the, 'UK', tax, year, Year, that, starts, at, Start, ends, at, End]). +predef_dict([days_spent_in_uk,Individual,Start,End,TotalDays], [who-person,start-date,end-date,total-number], + [Individual, spent, TotalDays, days, in, the, 'UK', starting, at, Start, ending, at, End]). +predef_dict([days_spent_in_uk,Individual,Start,End,TotalDays], [who-person,start-date,end-date,total-number], + [Individual, spent, TotalDays, in, the, 'UK', starting, at, Start, &, ending, at, End]). +predef_dict([uk_tax_year_for_date,Date,Year,Start,End], [first_date-date, year-year, second_date-date, third_date-date], + [in, the, 'UK', Date, falls, in, Year, beginning, at, Start, &, ending, at, End]). +predef_dict([is_individual_or_company_on, A, B], + [affiliate-affiliate, date-date], + [A, is, an, individual, or, is, a, company, at, B]). +% Prolog +predef_dict([has_as_head_before, A, B, C], [list-list, symbol-term, rest_of_list-list], [A, has, B, as, head, before, C]). +predef_dict([append, A, B, C],[first_list-list, second_list-list, third_list-list], [appending, A, then, B, gives, C]). +predef_dict([reverse, A, B], [list-list, other_list-list], [A, is, the, reverse, of, B]). +predef_dict([same_date, T1, T2], [time_1-time, time_2-time], [T1, is, the, same, date, as, T2]). % see reasoner.pl before/2 +predef_dict([between,Minimum,Maximum,Middle], [min-date, max-date, middle-date], + [Middle, is, between, Minimum, &, Maximum]). +predef_dict([is_1_day_after, A, B], [date-date, second_date-date], + [A, is, '1', day, after, B]). +predef_dict([is_days_after, A, B, C], [date-date, number-number, second_date-date], + [A, is, B, days, after, C]). +predef_dict([immediately_before, T1, T2], [time_1-time, time_2-time], [T1, is, immediately, before, T2]). % see reasoner.pl before/2 +predef_dict([\=, T1, T2], [thing_1-thing, thing_2-thing], [T1, is, different, from, T2]). +predef_dict([==, T1, T2], [thing_1-thing, thing_2-thing], [T1, is, equivalent, to, T2]). +predef_dict([is_a, Object, Type], [object-object, type-type], [Object, is, of, type, Type]). +predef_dict([is_not_before, T1, T2], [time1-time, time2-time], [T1, is, not, before, T2]). % see reasoner.pl before/2 +predef_dict([=, T1, T2], [thing_1-thing, thing_2-thing], [T1, is, equal, to, T2]). +predef_dict([isbefore, T1, T2], [time1-time, time2-time], [T1, is, before, T2]). % see reasoner.pl before/2 +predef_dict([isafter, T1, T2], [time1-time, time2-time], [T1, is, after, T2]). % see reasoner.pl before/2 +predef_dict([member, Member, List], [member-object, list-list], [Member, is, in, List]). +predef_dict([is_, A, B], [term-term, expression-expression], [A, is, B]). % builtin Prolog assignment +% predefined entries: +%predef_dict([assert,Information], [info-clause], [this, information, Information, ' has', been, recorded]). +predef_dict([\=@=, T1, T2], [thing_1-thing, thing_2-thing], [T1, \,=,@,=, T2]). +predef_dict([\==, T1, T2], [thing_1-thing, thing_2-thing], [T1, \,=,=, T2]). +predef_dict([=\=, T1, T2], [thing_1-thing, thing_2-thing], [T1, =,\,=, T2]). +predef_dict([=@=, T1, T2], [thing_1-thing, thing_2-thing], [T1, =,@,=, T2]). +predef_dict([==, T1, T2], [thing_1-thing, thing_2-thing], [T1, =,=, T2]). +predef_dict([=<, T1, T2], [thing_1-thing, thing_2-thing], [T1, =,<, T2]). +predef_dict([=<, T1, T2], [thing_1-thing, thing_2-thing], [T1, =,<, T2]). +predef_dict([>=, T1, T2], [thing_1-thing, thing_2-thing], [T1, >,=, T2]). +predef_dict([=, T1, T2], [thing_1-thing, thing_2-thing], [T1, =, T2]). +predef_dict([<, T1, T2], [thing_1-thing, thing_2-thing], [T1, <, T2]). +predef_dict([>, T1, T2], [thing_1-thing, thing_2-thing], [T1, >, T2]). +predef_dict([unparse_time, Secs, Date], [secs-time, date-date], [Secs, corresponds, to, date, Date]). +predef_dict([must_be, Type, Term], [type-type, term-term], [Term, must, be, Type]). +predef_dict([must_not_be, A, B], [term-term, variable-variable], [A, must, not, be, B]). + +% pre_is_type/1 +pre_is_type(thing). +pre_is_type(time). +pre_is_type(type). +pre_is_type(object). +pre_is_type(date). +pre_is_type(day). +pre_is_type(person). +pre_is_type(list). +pre_is_type(number). + +% support predicates +must_be(A, var) :- var(A). +must_be(A, nonvar) :- nonvar(A). +must_be_nonvar(A) :- nonvar(A). +must_not_be(A,B) :- not(must_be(A,B)). + +has_as_head_before([B|C], B, C). + +% see reasoner.pl +%before(A,B) :- nonvar(A), nonvar(B), number(A), number(B), A < B. + +matches_name(Word, [Element|_], [Name-_|_], Name) :- Word == Element, !. +matches_name(Word, [_|RestElem], [_|RestTypes], Name) :- + matches_name(Word, RestElem, RestTypes, Name). + +matches_type(Word, [Element|_], [_-Type|_], Type) :- Word == Element, !. +matches_type(Word, [_|RestElem], [_|RestTypes], Type) :- + matches_type(Word, RestElem, RestTypes, Type). + +delete_underscore([], []) :- !. +delete_underscore(['_'|Rest], Final) :- delete_underscore(Rest, Final), !. +delete_underscore([W|Rest], [W|Final]) :- delete_underscore(Rest, Final). + +add_determiner([Word|RestWords], [Det, Word|RestWords]) :- + name(Word,[First|_]), proper_det(First, Det). + +proper_det(97, an) :- !. +proper_det(101, an) :- !. +proper_det(105, an) :- !. +proper_det(111, an) :- !. +proper_det(117, an) :- !. +proper_det(_, a). + +% ---------------------------------------------------------------- sandbox + +sandbox:safe_primitive(le_input:source_lang(_)). +sandbox:safe_primitive(le_input:is_type(_)). +sandbox:safe_primitive(le_input:dict(_,_,_)). +sandbox:safe_primitive(le_input:meta_dict(_,_,_)). +sandbox:safe_primitive(le_input:assertall(_)). +sandbox:safe_primitive(le_input:asserted(_)). \ No newline at end of file diff --git a/examples/multi-file-generation/project/prolog/le_local.pl b/examples/multi-file-generation/project/prolog/le_local.pl new file mode 100755 index 00000000..f35d0681 --- /dev/null +++ b/examples/multi-file-generation/project/prolog/le_local.pl @@ -0,0 +1,37 @@ +/* le_local: a prolog module for LE handling of a local filesystem. + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. + +*/ + +:- module(le_local, + [load_file_module/3, + this_capsule/1, + portray_clause_ind/1, + update_file/3, + myDeclaredModule/1 + ]). + +load_file_module(FileName, FileName, _) :- + load_files([FileName], [module(FileName)]). + +this_capsule(user). + %thread_self(M). % current_module(M) messes it up + +portray_clause_ind(Clause) :- + portray_clause(Clause). + +:- multifile kp_loader:myDeclaredModule/1. + +myDeclaredModule(user). + +update_file(NewFileName, _, String) :- + open(NewFileName, write, Stream, []), + write(Stream, String), + close(Stream). \ No newline at end of file diff --git a/examples/multi-file-generation/project/prolog/reasoner.pl b/examples/multi-file-generation/project/prolog/reasoner.pl new file mode 100755 index 00000000..c2254f38 --- /dev/null +++ b/examples/multi-file-generation/project/prolog/reasoner.pl @@ -0,0 +1,750 @@ +/* Copyright [2021] Initial copyright holders by country: +LodgeIT (AU), AORA Law (UK), Bob Kowalski (UK), Miguel Calejo (PT), Jacinto Dávila (VE) + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +*/ + +:- module(reasoner,[query/4, query_with_facts/5, query_once_with_facts/5, explanation_node_type/2, render_questions/2, + run_examples/0, run_examples/1, myClause2/9, myClause/4, taxlogWrapper/10, niceModule/2, refToOrigin/2, + isafter/2, is_not_before/2, isbefore/2, immediately_before/2, same_date/2, subtract_days/3, this_year/1, uk_tax_year/4, in/2, + isExpressionFunctor/1, set_time_of_day/3, start_of_day/2, end_of_day/2, is_days_after/3, is_1_day_after/2, unparse_time/2 + ]). + +/** Tax-KB reasoner and utils +@author Miguel Calejo +*/ + +:- use_module(library(aggregate)). + +:- use_module(kp_loader). +:- use_module(le_answer). + +:- thread_local do_not_fail_undefined_preds/0. + +% query(AtGoal,Unknowns,ExplanationTerm,Result) +% Result will be true/false/unknown +query(Goal,Questions,E,Result) :- + query_with_facts(Goal,[],false,Questions,E,Result). + +%! query_with_facts(+Goal,?FactsListOrExampleName,-Unknowns,?ExplanationTemplate,-Result) +query_with_facts(Goal,Facts,Questions,E,Outcome) :- + query_with_facts(Goal,Facts,false,Questions,E,Outcome). + +%! query_with_facts(+Goal,?FactsListOrExampleName,+OnceUndo,-Unknowns,-ExplanationTemplate,-Result) +% query considering the given facts (or accumulated facts of all scenarios the given example name) +% if OnceUndo, only one solution, and time execution is limited +% ExplanationTemplate determines Logical English or taxlog (Prolog syntax) explanation nodes +% Result will be true/false/unknown +% This is NOT reentrant +query_with_facts(Goal,Facts_,OnceUndo,unknowns(Unknowns),E,Outcome) :- %trace, + must_be(boolean,OnceUndo), + (Goal=at(G,M__) -> atom_string(M_,M__) ; + myDeclaredModule(M_) -> Goal=G; + (print_message(error,"No knowledge module specified"-[]), fail)), + context_module(Me), + (shouldMapModule(M_,M)->true;M=M_), + (is_list(Facts_)-> Facts=Facts_; example_fact_sequence(M,Facts_,Facts)), + Caller = Me:( + i(at(G,M),OnceUndo,U,Result_), + Result_=..[Outcome,E_], + expand_explanation_refs(E_,Facts,E) + ), + retractall(hypothetical_fact(_,_,_,_,_,_)), + (OnceUndo==true -> (true, once_with_facts(Caller, M, Facts, true)) ; (true, call_with_facts(Caller, M, Facts))), + list_without_variants(U,Unknowns_), % remove duplicates, keeping the first clause reference for each group + mapModulesInUnknwons(Unknowns_,Unknowns). + +%! query_once_with_facts(+Goal,?FactsListOrExampleName,-Unknowns,-Explanation,-Result) +% query considering the given facts (or accumulated facts of all scenarios the given example name), undoes them at the end; limited execution time +query_once_with_facts(Goal,Facts_,Questions,E,Outcome) :- + query_with_facts(Goal,Facts_,true,Questions,E,Outcome). + +%! render_questions(+Unknowns,-Questions) is det +% Transform unknown goals ( at(G,KP)/c(Cref) )into question(...) terms +render_questions(unknowns(U),Q) :- !, nonvar(U), render_questions(U,Q). +render_questions([U1|Un],[Q1|Qn]) :- !, render_question(U1,Q1), render_questions(Un,Qn). +render_questions([],[]). + +render_question(at(U,M_)/_,question(U,Q)) :- (shouldMapModule(M_,M)->true;M=M_), catch(M:question(U,QT),_,fail), !, + (QT=Format-Args -> format(string(Q),Format,Args); Q=QT). +render_question(at(U,M_)/_,question(U,Q,Answer)) :- (shouldMapModule(M_,M)->true;M=M_), catch(M:question(U,QT,Answer),_,fail), !, + (QT=Format-Args -> format(string(Q),Format,Args); Q=QT). +render_question(G/_,Q) :- format(string(Q)," Is ~w true?",[G]). + +% list_without_variants(+L,-NL) +% Remove duplicates from list L, without binding variables, and keeping last occurrences in their original order +list_without_variants([X/Cref|L],[X/Cref|NL]) :- !, remove_all_variants(L,X,LL), list_without_variants(LL,NL). +list_without_variants([],[]). +% remove_all_variants(+List,+Term,-NewList) +remove_all_variants(L,T,NL) :- select(X/_Cref,L,LL), variant(X,T), !, remove_all_variants(LL,T,NL). +remove_all_variants(L,_,L). + +niceModule(Goal,NiceGoal) :- nonvar(Goal), Goal=at(G,Ugly), moduleMapping(Nice,Ugly), !, NiceGoal=at(G,Nice). +niceModule(G,G). + +mapModulesInUnknwons([G/Cref|U], [NG/Cref|NU]) :- !, niceModule(G,NG), mapModulesInUnknwons(U,NU). +mapModulesInUnknwons([],[]). + +% i(+AtGoal,+OnceTimed,-Unknowns,-ExplainedResult) always succeeds, with result true(Explanation) or false(Explanation) +% top level interpreter predicate; true with Unknowns\=[].... means 'unknown' +i( at(G,KP),OnceTimed,U,Result) :- % hack to use the latest module version on the SWISH window + shouldMapModule(KP,UUID), !, + i( at(G,UUID),OnceTimed,U,Result). +i( at(G,KP),OnceTimed,Unknowns,Result) :- !, + reset_errors, + context_module(M), + nextGoalID(ID), + Limit=0.5, % max seconds + Caller = i(at(G,KP),M,top_goal,top_clause,U__,E__), + (OnceTimed==true -> IG = call_with_time_limit( Limit, Caller) ; IG = Caller), + ( catch( (IG,E_=E__,U=U__), time_limit_exceeded, (E_=[], U=[time_limit_exceeded], print_message(warning,"Time limit of ~w seconds exceeded by ~w at ~w"-[Limit,G,KP])) ) *-> + (expand_failure_trees_and_simp(E_,FailedUnknowns,E), Result=true(E)) ; + (expand_failure_trees_and_simp([f(ID,_,_,_)],FailedUnknowns,E), U=[], Result=false(E)) ), + append(U,FailedUnknowns,U_), + maplist(niceModule,U_,Unknowns). +i( G,_,_,_) :- print_message(error,"Top goal ~w should be qualified with ' at knowledge_page'"-[G]), fail. + +% i(+Goal,+AlreadyLoadedAndMappedModule,+CallerGoalID,+CallerClauseRef,-Unknowns,-Why) +% failure means false; success with empty Unknowns list means true; +% Unknowns contains a list of at(GoalOrErrorTerm,Module)/c(CallerClauseRef) ..c a hack to avoid a SWISH rendering bug +% otherwise, result unknown, depending on solutions to goals in Unknowns; +% explanation is a list of proof-like trees: +% s(nodeLiteral,Module,ClauseRef,childrenNodes); (s)success) [] denotes.. some self-evident literal; +% u(nodeLiteral,Module,CallerClauseRef,[]); u)nknown (or system predicate floundering), basically similar to s +% if nextGoalID(ID), i(G,...) fails with zero solutions, there will be a failed tree asserted with root failed(ID,...) +% failures for not(G) goals will also leave asserted a fact failed_success(ID,Unknowns,Why) +% successes for not(G) goals will have a Why with the underlying failure, f(NegatedGoalID,Module,CallerID,FreeVar); +% these can be expanded by expand_failure_trees into f(G,Module,CallerClausRef,Children) +% there may be orphan failed(ID,...) facts, because we're focusing on solution-less failures only +% this predicate is NOT thread safe +%i(G,M,_,_,_,_) :- nextGoalID(ID), writeln(ID-G/M), fail. +%i(G,M,_,_,_,_) :- nextGoalID(ID), print_message(informational,"~w"-[ID-G/M]), fail. +i(G,M,_,_,_,_) :- var(G), !, throw(variable_call_at(M)). +i(true, _, _, _, U, E) :- !, U=[], E=[]. +i(false, _, _, _, _U, _E) :- !, fail. +i(and(A,B), M, CID, Cref, U, E) :- !, i((A,B),M,CID,Cref,U,E). +i((A,B), M, CID, Cref, U, E) :- !, i(A,M,CID,Cref,U1,E1), i(B,M,CID,Cref,U2,E2), append(U1,U2,U), append(E1,E2,E). +i(or(A,B), M, CID, Cref, U, E) :- !, i((A;B),M,CID,Cref,U,E). +i((A;B), M, CID, Cref, U, E) :- !, (i(A,M,CID,Cref,U,E) ; i(B,M,CID,Cref,U,E)). +i(must(I,M), Mod, CID, Cref, U, E) :- !, i(then(I,M), Mod, CID, Cref, U, E). +i(\+ G,M,CID, Cref, U,E) :- !, i( not(G),M,CID,Cref,U,E). +i(not(G), M, CID, Cref, NotU, NotE) :- !, + newGoalID(NotID), + % our negation as failure requires no unknowns: + ( i( G, M, NotID, Cref, U, E) -> ( + assert( failed(NotID,M,CID,Cref,not(G))), + assert( failed_success(NotID,U,E)), + fail + ) ; ( + NotE = [f(NotID,M,CID,_NotHere_TheyAreAsserted)], NotU=[] + )). +i(!,_,_,_,_,_) :- throw(no_cuts_allowed). +i(';'(C->T,Else), M, CID, Cref, U, E) :- !,% should we forbid Prolog if-then-elses..? + nextGoalID(ID), + ( i(C,M,CID,Cref,UC,EC) -> ( + i(T,M,CID,Cref,UT,ET), + append(UC,UT,U), append(EC,ET,E) + ) ; ( + % any further failures under the (failed) condition? + ((nextGoalID(Other), Other\=ID) -> EC=[f(ID,M,CID,_NotYet)] ; EC=[]), + i(Else,M,CID,Cref,U,EE), append(EC,EE,E) + )). +i((If->Then),M,CID,Cref,U,E) :- !, + i((If->Then;fail),M,CID,Cref,U,E). +% i(then(if(C),else(T,Else)), M, CID, Cref, U, E) :- !, +% nextGoalID(ID), +% (i(C,M,CID,Cref,UC,EC) *-> ( +% i(T,M,CID,Cref,UT,ET), +% append(UC,UT,U), append(EC,ET,E) +% ) ; ( +% ((nextGoalID(Other), Other\=ID) -> EC=[f(ID,M,CID,_NotYet)] ; EC=[]), +% i(Else,M,CID,Cref,U,EE), % no unknowns under C for sure +% append(EC,EE,E) +% )). +% Now simply using the following, because the above loses explanations for successful C and failed Then +i(then(if(C),else(T,Else)), M, CID, Cref, U, E) :- !, + i((C,T;not(C),Else), M, CID, Cref, U, E). +i(then(if(C),Then),M,CID,Cref,U,E) :- !, i(then(if(C),else(Then,true)),M,CID,Cref,U,E). +% sometimes this is not used... SWI seems to expands forall(X,C) into \+ (X, \+C) +i(forall(A,B),M,CID,Cref,U,E) :- !, + E=[s(forall(A,B),M,meta,Children)], + newGoalID(ForID), + findall(X, ( + i(A,M,ForID,Cref,UA,EA), + nextGoalID(ID), + (i(B,M,ForID,Cref,UB,EB) -> ( + append(UA,UB,Ui),append(EA,EB,Ei),X=Ui/Ei + ) ; ( + % failed; was there a relevant failure under B? + ((nextGoalID(Other), Other\=ID) -> EB=[f(ID,M,CID,_NotYet)] ; EB=[]), + append(EA,EB,Ei), + X=failed(UA/Ei) + )) + ), Tuples), + (member(failed(UB/Ei),Tuples) -> ( + assert( failed(ForID,M,CID,Cref,forall(A,B))), + assert( failed_success(ForID,UB,Ei)), + fail + ) ; ( + findall(Ui,member(Ui/_,Tuples),U_), append(U_,U), + findall(Ei,member(_/Ei,Tuples),Children_), append(Children_,Children) + )). +i(setof(X,G,L),M,CID,Cref,U,E) :- !, E=[s(setof(X,G,L),M,meta,Children)], + wrapTemplateGoal(G,M,CID,Cref,Ui,Ei,Wrapped), %TODO: should we introduce an explicit failed node for aggregates? + setof(X/Ui/Ei, Wrapped, Tuples), + squeezeTuples(Tuples,L,U,Children). +i(bagof(X,G,L),M,CID,Cref,U,E) :- !, E=[s(bagof(X,G,L),M,meta,Children)], + wrapTemplateGoal(G,M,CID,Cref,Ui,Ei,Wrapped), + bagof(X/Ui/Ei, Wrapped, Tuples), + squeezeTuples(Tuples,L,U,Children). +i(aggregate(Template,G,Result),M,CID,Cref,U,E) :- !, E=[s(aggregate(Template,G,Result),M,meta,Children)], + % uses a bit too much of SWI internals at swipl-devel/library/aggregate.pl + % note that aggregate/3 fails when there are no solutions, unlike aggregate_all (for count and sum) + aggregate:template_to_pattern(bag, Template, Pattern, M:G, Goal, Aggregate), + i(bagof(Pattern, Goal, List),M,CID,Cref,U_,[s(_Bagof,_M,_ClauseRef,Children_)]), + catch( ( aggregate:aggregate_list(Aggregate, List, Result), U=U_, Children=Children_ ), + error(instantiation_error,_Cx), + (append(U_,[at(instantiation_error(G),M)/c(Cref)],U), append(Children_,[u(instantiation_error(G),M,unknown,[])],Children)) + ). +i(aggregate_all(Template,G,Result),M,CID,Cref,U,AggrE) :- !, AggrE=[s(aggregate_all(Template,G,Result),M,meta,E)], + % uses a bit too much of SWI internals at swipl-devel/library/aggregate.pl + aggregate:template_to_pattern(all, Template, Pattern, M:G, Goal, Aggregate), + i(findall(Pattern, Goal, List),M,CID,Cref,U_,E_), + catch( ( aggregate:aggregate_list(Aggregate, List, Result), U=U_, E=E_ ), + error(instantiation_error,_Cx), + (append(U_,[at(instantiation_error(G),M)/c(Cref)],U), append(E_,[u(instantiation_error(G),M,unknown,[])],E)) + ). +i(findall(X,G,L),M,CID,Cref,U,E) :- !, + newGoalID(FindallID), + findall(X/Ui/Ei, i(G,M,FindallID,Cref,Ui,Ei), Tuples), + (Tuples==[] -> ( % we want to know why there were no solutions: + L=[], E = [f(FindallID,M,CID,_NotHere_TheyAreAsserted)], U=[] + ) ; ( + squeezeTuples(Tuples,L,U,Children), + E=[s(findall(X,G,L),M,meta,Children)] + )), + ((E=[],U=[]) -> true ; % findall succeeds always, so we keep its last and only solution's explanation: + (assert(failed(FindallID,M,CID,Cref,findall(X,G,L))), assert(failed_success(FindallID,U,E))) + ). +% questions are now annotation facts for rendering unknowns, not goals, so this is commented out: +% i(Q,M,_CID,Cref,U,E) :- functor(Q,question,N), (N=1;N=2), !, +% Q=..[_,Q_|_], +% (Q_=Format-Args -> format(string(Q__),Format,Args); Q_=Q__), +% U=[at(Q__,M)], E=[u(at(Q__,M),M,Cref,[])]. +i(M:G,Mod,CID,Cref,U,E) :- !, i(at(G,M),Mod,CID,Cref,U,E). +i(G,M,CID,Cref,U,E) :- system_predicate(G), !, + evalArgExpressions(G,M,NewG,CID,Cref,Uargs,E_), + % floundering originates unknown: + catch(( myCall(M:NewG), U=Uargs, E=E_), + error(_Error,_Cx), + (append(Uargs,[at(instantiation_error(G),M)/c(Cref)],U), append(E_,[u(instantiation_error(G),M,Cref,[])],E) )). +i(at(G,KP),M,CID,Cref,U,E) :- shouldMapModule(KP,UUID), !, + i(at(G,UUID),M,CID,Cref,U,E). % use SWISH's latest editor version +i(At,Mod,CID,Cref,U,E) :- At=at(G,M_), !, + atom_string(M,M_), + ( (loaded_kp(M); hypothetical_fact(M,_,_,_,_,_)) -> + i(G,M,CID,Cref,U,E) ; + (U=[At/c(Cref)], E=[u(At,Mod,Cref,[])] )). +i(G,M,_CID,Cref,U,E) :- unknown(G,M), do_not_fail_undefined_preds, !, + (U=[at(G,M)/c(Cref)],E=[ u(at(G,M),M,Cref,[]) ]). +%TODO: on(G,2020) means "G true on some instant in 2020"; who matches that with '20210107' ? check for clauses and hypos +i(G,M,CID,Cref,U,E) :- + newGoalID(NewID), create_counter(Counter), + LastSolutionHolder = hacky(none), + (true ;( % before failing, save our failure information + \+ catch(M:irrelevant_explanation(G),_,fail), + get_counter(Counter,Nsolutions), + assert(failed(NewID,M,CID,Cref,G)), + (Nsolutions==0 -> true ; ( + % we keep the explanation for our last solution, in case no more failure explanations are available for our ancestors + % and we want some path to the reasons for that failure; this is costly, but less than the full suspects tree + arg(1,LastSolutionHolder,U_+E_), + assert(failed_success(NewID,U_,E_)) + )), + fail + )), + evalArgExpressions(G,M,NewG,CID,Cref,Uargs,Eargs), % failures in the expression (which would be weird btw...) stay directly under CID + myClause(NewG,M,B,Ref,IsProlog,_URL,LocalE), + (IsProlog==false -> i(B,M,NewID,Ref,U_,Children_) ; ( + catch( myCall(B), error(Error,_), (U_=[at(Error,M)/c(Cref)])), % should this call be qualified with M? What when M is the SWISH module...? + (var(U_)->U_=[];true), + Children_=LocalE + )), + inc_counter(Counter), % one more solution found; this is a nonbacktrackable operation + append(Uargs,U_,U), + (catch(M:irrelevant_explanation(NewG),_,fail) -> E=Eargs ; (E=[s(G,M,Ref,Children)], append(Eargs,Children_,Children) )), + % we keep the explanation and unknowns for the last solution: + ((E=[],U=[]) -> true ; copy_term(U+E,U_+E_), nb_setarg(1,LastSolutionHolder,U_+E_)). + +% unknown(+Goal,+Module) whether the knowledge source is currently unable to provide a result +unknown(G,M) :- var(G), !, throw(variable_unknown_call_at(M)). +unknown(on(G,_Time),M) :- !, unknown(G,M). +unknown(G,M) :- functor(G,F,N),functor(GG,F,N), \+ myClause2(GG,_,M,_,_,_,_,_,_). + + +myCall(G) :- sandbox:safe_call(G). + +:- thread_local last_goal_id/1, failed/5, failed_success/3. + +nextGoalID(ID) :- + (last_goal_id(Old) -> true ; Old=0), ID is Old+1. +newGoalID(ID) :- + (retract(last_goal_id(Old)) -> true ; Old=0), ID is Old+1, assert(last_goal_id(ID)). + +% destructive counters, may also be used as destructive variables that do not lose their value during repeat/fail loops +create_counter(counter(0)). +get_counter(counter(N),N). +set_counter(Counter,N) :- Counter=counter(_), nb_setarg(1,Counter,N). +inc_counter(Counter,N) :- get_counter(Counter,N), NewN is N+1, nb_setarg(1,Counter,NewN). +inc_counter(Counter) :- inc_counter(Counter,_). + +evalArgExpressions(G,M,NewG,CID,Cref,U,E) :- + G=..[F|Args], + maplist(evalExpression(M,CID,Cref),Args,Results,Us,Es), + NewG=..[F|Results], + append(Us,U), append(Es,E). + +% evalExpression(+Module,+CallerID,+CallerClauseRef,+Expression,-Result,+CallerID,+CallerClauseRef,-Unknowns,-WhyExplanation) expands (only) user functions +% TODO: add arithmetic expressions too...? +evalExpression(_M,_CID,_Cref,X,X,[],[]) :- var(X), !. +evalExpression(M,CID,Cref,Exp,R,U,[s(function(Exp),M,Ref,Children)]) :- M:clause(function(Exp,R),Body,Ref), !, + once( i(Body,M,CID,Cref,U,Children) ). +evalExpression(M,_CID,Cref,Exp,R,U,Why) :- Exp=..[F,_|_], isExpressionFunctor(F), !, + catch((R is Exp, U=[], Why=[]), Ex, ( U=[at(instantiation_error(Ex),M)/c(Cref)], Why=[u(instantiation_error(Ex),M,Cref,[])] )). +evalExpression(_M,_CID,_,X,X,[],[]). + +isExpressionFunctor(F) :- memberchk(F,[+,-,*,/]). + + +%wrapTemplateGoal(+Gtemplate,+Module,+CallerID,+CallerClauseRef,+Unknowns,+Explanation,-WrappedGtemplate) +% e.g. X^Y^g --> i(X^Y^i(g,Module,CID,Cref,Unknowns,Explanation)) +wrapTemplateGoal(G,M,CID,Cref,U,E,i(G,M,CID,Cref,U,E)) :- var(G), !. +wrapTemplateGoal(V^G,M,CID,Cref,U,E,V^Wrapped) :- !, wrapTemplateGoal(G,M,CID,Cref,U,E,Wrapped). +wrapTemplateGoal(G,M,CID,Cref,U,E,i(G,M,CID,Cref,U,E)). + +%squeezeTuples(+Tuples,-ResultsList,-Unknowns,-Explanations) +squeezeTuples(Tuples,L,U,Es) :- + findall(X, member(X/_/_,Tuples), L), + findall(Ui, member(_/Ui/_,Tuples), U_), append(U_,U), + findall(Ei, member(_/_/Ei,Tuples), Es_), append(Es_,Es). + +myClause(H,M,Body,Ref) :- myClause(H,M,Body,Ref,_,_,_). + +% myClause(+Head,+Module,-Body,-Ref,-IsProlog,-OriginURL,-LocalExplanation) IsProlog is true if the body should be called directly, without interpretation +myClause(on(H,Time),M,Body,Ref,IsProlog,URL,E) :- !, myClause2(H,Time,M,Body,Ref,IsProlog,URL,E,_LE_line). +myClause(H,M,Body,Ref,IsProlog,URL,E) :- myClause2(H,_Time,M,Body,Ref,IsProlog,URL,E,_LE_line). + +% Supports the injecting of facts for a query: +:- thread_local hypothetical_fact/6. % Module, FactTemplate, Fact, ClauseLikeBody, FakeClauseRef, redefine/extend + +% myClause2(PlainHead,Time,Module,Body,Ref,IsProlog,URL,LocalExplanation, LE_line) +myClause2(H,Time,M,Body,Ref,IsProlog,URL,E, Line) :- + (nonvar(Ref) -> clause_property(Ref,module(M)) ; true), + (hypothetical_fact(M,H,_,_,_,extend) -> % allow existing facts and rules to persist even with similar hypos: + (hypothetical_fact(M,H,H,Body_,Ref,_) ; M:clause(H,Body_,Ref)) ; %... or override them: + (hypothetical_fact(M,H,Fact,Body_,Ref,_) *-> H=Fact ; M:clause(H,Body_,Ref)) + ), + % hypos with rules cause their bodies to become part of our resolvent via Body: + taxlogWrapper(Body_,_ExplicitTime,Time,M,Body,Ref,IsProlog,URL,E, Line). + +% taxlogWrapper(RawBody,ExplicitTime,Time,Module,Body,ClauseRef,IsProlog,URL,E,LE_Line) +% keep this in sync with syntax.pl +taxlogWrapper(targetBody(Body,Explicit,Time_,URL,E_,L),Explicit,Time,M,Body,Ref,IsProlog,URL,E, L) :- (Body=call(_);Body==true), !, + Time=Time_, IsProlog=true, E=[s(E_,M,Ref,[])]. +taxlogWrapper(targetBody(Body,Explicit,Time_,URL,E, L),Explicit,Time,_M,Body,_Ref,IsProlog,URL,E, L) :- !, Time=Time_, IsProlog=false. +taxlogWrapper(Body_,false,_Time,_M,Body,_Ref,IsProlog,URL,E, _) :- Body_=Body,IsProlog=true,E=[],URL=''. + +refToOrigin(Ref,URL) :- + blob(Ref,clause), + myClause2(_H,_Time,Module_,_Body,Ref,_IsProlog,URL_,_E, _), + !, + (moduleMapping(Module,Module_)-> true ; Module=Module_), + (is_absolute_url(URL_) -> URL=URL_; ( + sub_atom(Module,_,_,0,'/') -> atomic_list_concat([Module,URL_],URL) ; URL=Module % atomic_list_concat([Module,'/',URL_],URL) + )). +refToOrigin(Ref_,Ref) :- term_string(Ref_,Ref). + +% refToSourceAndOrigin(ClauseRef,-SourceCode,-TextOriginURL) +refToSourceAndOrigin(Ref,Source,Origin) :- + refToOrigin(Ref,Origin), + ((blob(Ref,clause),clause(H,B,Ref)) -> ( + with_output_to(string(Source),portray_clause((H:-B))) + + ) + ; Source=""). + +:- multifile prolog:meta_goal/2. % for xref +prolog:meta_goal(at(G,M),[M_:G]) :- (nonvar(M) -> atom_string(M_,M) ; M=M_). +% next two handled by declare_our_metas: +prolog:meta_goal(on(G,_Time),[G]). +prolog:meta_goal(targetBody(G,_,_,_,_,_),[G]). +%prolog:meta_goal(because(G,_Why),[G]). +prolog:meta_goal(and(A,B),[A,B]). +prolog:meta_goal(or(A,B),[A,B]). +prolog:meta_goal(must(A,B),[A,B]). +prolog:meta_goal(not(A),[A]). +prolog:meta_goal(then(if(C),else(T,Else)),[C,T,Else]). +prolog:meta_goal(then(if(C),Then),[C,Then]) :- Then\=else(_,_). +prolog:meta_goal(aggregate(_,G,_),[G]). % is this necessary...? +prolog:meta_goal(aggregate_all(_,G,_),[G]). % is this necessary...? + +:- multifile prolog:called_by/4. +prolog:called_by(on(G,_T), M, M, [G]). % why is this needed, given meta_goal(on(..))...? +prolog:called_by(because(G,_Why), M, M, [G]). % why is this needed, given meta_goal(on(..))...? +prolog:called_by(targetBody(G,_,_,_,_,_), M, M, [G]). +%prolog:called_by(aggregate(_,G,_), M, M, [G]). % why is this needed, given meta_goal(on(..))...? + +% does NOT fix the "G is not called" bug: prolog:called_by(mainGoal(G,_), M, M, [G]). + + +%%%% Support for automated tests/examples + +run_examples :- + forall(kp(M),( + format("Knowledge page ~w~n",M), + run_examples(M) + )). + +%TODO: 'true' assertions right now can have unknowns; this needs to be customizable +run_examples(Module) :- + loaded_kp(Module), + forall( catch(Module:example(Desc,Scenarios),error(existence_error(_, _), _),fail), ( + format(" Running example ~w~n",Desc), + run_scenarios(Scenarios,Module,1,[],_U,_E) + )). + +%consider sequence of scenario fact sets; for now, a simple concatenation: +run_scenarios([scenario(Facts,G)|Scenarios],M,N,PreviousFacts,U,E) :- !, + append(PreviousFacts,Facts,Facts_), + query_once_with_facts(at(G,M),Facts_,U1,E1,Result), + format(" Scenario ~w result : ~w~n",[N,Result]), + format(" Scenario ~w unknowns : ~w~n",[N,U1]), + format(" Scenario ~w explanation: ~w~n",[N,E1]), + NewN is N+1, + run_scenarios(Scenarios,M,NewN,Facts_,Un,En), + append(U1,Un,U), append([E1],En,E). +run_scenarios([],_,_,_,[],[]). + +% example_fact_sequence(+Module,?ExampleName,-Facts) +example_fact_sequence(M_,Name,Facts) :- + atom_string(M,M_), + loaded_kp(M), + (catch(M:example(Name,Scenarios),error(existence_error(_, _), _),fail) *-> true ; + (print_message(error,"Missing scenario for example: ~w"-[Name]), fail)), + findall(SF,member(scenario(SF,_Assertion),Scenarios),Facts_), + append(Facts_,Facts). + + +% once_with_facts(Goal,Module,AdditionalFacts,+DoUndo) +% Facts should be ground... +% asserts the facts (and deletes those with a - ) and calls Goal, stopping at the first solution, and optionally undoing the fact changes +% if a fact's predicate is undefined or not dynamic, it is declared (forever) as thread_local, +% to support multiple clients +% BUG: not thread safe, failing to call thread_local(..) before +once_with_facts(G,M_,Facts,DoUndo) :- + must_be(boolean,DoUndo), + atom_string(M,M_), + loaded_kp(M), % make sure the module is loaded + assert_and_remember(Facts,M,from_with_facts,Undo), + (true; DoUndo==true, once(Undo), fail), + once(M:G), + (DoUndo==true -> once(Undo) ; true). + +% call_with_facts(+Goal,+Module,+AdditionalFacts) This does NOT undo the fact changes +call_with_facts(G,M_,Facts) :- + atom_string(M,M_), + loaded_kp(M), % make sure the module is loaded + assert_and_remember(Facts,M,from_with_facts,_Undo), + call(M:G). + + +% assert a list of timed facts, and returns a goal to undo the asserts +assert_and_remember([-Fact|Facts],M,Why,(Undo,Undos)) :- !, + must_be(nonvar,Fact), + assertion( \+ (functor(Fact,':-',_);functor(Fact,if,_)) ), + canonic_fact_time(Fact,M,CF,Time,ExplicitTime), assert_and_remember_(delete,redefine,CF,ExplicitTime,_,Time,Why,Undo), + assert_and_remember(Facts,M,Why,Undos). +assert_and_remember([Fact__|Facts],M,Why,(Undo,Undos)) :- must_be(nonvar,Fact__), + (Fact__= (++(Fact_)) -> How=extend ; (Fact__=Fact_,How=redefine)), + % Note: the following MUST be kept in sync with taxlog2prolog/3; essencially, this assumes no transform occurs: + (Fact_ = if(Fact,Body) -> true ; (Fact=Fact_,Body=true)), %TODO: verify that rules are not functions etc + canonic_fact_time(Fact,M,CF,Time,ExplicitTime), assert_and_remember_(add,How,CF,ExplicitTime,Body,Time,Why,Undo), + assert_and_remember(Facts,M,Why,Undos). +assert_and_remember([],_,_,true). + +assert_and_remember_(Operation,How,M:Fact,Explicit,Body,Time,Why,Undo) :- + assertion(How==extend;How==redefine), + %TODO: Adds could check if there's a matching clause already, to avoid spurious facts at the end of some example runs + % abolish caused 'No permission to modify thread_local_procedure'; weird interaction with yall.pl ..?? + % ( \+ predicate_property(M:Fact,_) -> (functor(Fact,F,N), thread_local(M:F/N)) ; + % predicate_property(M:Fact,(dynamic)) -> true ; + % (functor(Fact,F,N), dynamic(M:F/N) ) % should be thread_local(M:F/N) !!! + % ), + % Instead of the above complications, we now use hypothetical_fact: + % e.g. add a fact F in one scenarion and deleting in the next, which may leave F asserted when undoing the delete + % this seems to require either using a variant test... or demanding facts to be ground + % hypothetical_fact(M,H,Fact,Body_,Ref) + functor(Fact,F,N), functor(Template,F,N), + Add = assert( hypothetical_fact(M,Template,Fact,targetBody(Body,Explicit,Time,'',Why,_),hypothetical,How) ), + Delete = retractall( hypothetical_fact(M,Template,Fact,targetBody(Body,_Explicit,Time,'',Why,_),_,_) ), + (Operation==add ->( Undo=Delete, Add) ; ( Undo=Add, Delete )). + +% canonic_fact_time(+Fact,+DefaultModule,Module:Fact_,Time,-ExplicitTime) +canonic_fact_time(M_:on(F,T),_,M:F,T,true) :- !, atom_string(M,M_). +canonic_fact_time(M_:F,_,M:F,_,false) :- !, atom_string(M,M_). +canonic_fact_time(at(on(F,T),M),_,M_:F,T,true) :- !, atom_string(M_,M). +canonic_fact_time(at(F,M),_,M_:F,_,false) :- !, atom_string(M_,M). +canonic_fact_time(on(F,T),M,M:F,T,true) :- !. +canonic_fact_time(F,M,M:F,_,false). + +%%%%% Explanations + +expand_failure_trees_and_simp(E,FailedUnknowns,ES) :- + expand_failure_trees(E,[],FailedUnknowns,Expanded), + simplify_explanation(Expanded,ES). + +% expand_failure_trees(+Why,Unknowns,NewUnknowns,-ExpandedWhy) the unknows are only those in failed branches +expand_failure_trees([s(X,M,Ref,Children)|Wn],U1,Un,[s(X,M,Ref,NewChildren)|EWn]) :- !, + expand_failure_trees(Children,U1,U2,NewChildren), expand_failure_trees(Wn,U2,Un,EWn). +expand_failure_trees([u(X,M,Ref,Children)|Wn],U1,Un,[u(X,M,Ref,NewChildren)|EWn]) :- !, + expand_failure_trees(Children,U1,U2,NewChildren), expand_failure_trees(Wn,U2,Un,EWn). +expand_failure_trees([f(ID,Module,CID,Children)|Wn],U1,Un,Expanded) :- + must_be(var,Children), + findall(f(ChildID,M,ID,_),failed(ChildID,M,ID,_Cref,_ChildG),Children), + expand_failure_trees(Children,U1,U2_,NewChildren_), + ((NewChildren_==[],failed_success(ID,SU,Why)) -> ( % no failure suspects, but we have a (last) solution: + append(U2_,SU,U2__), expand_failure_trees(Why,U2__,U2,NewChildren)) + ; (U2_=U2, NewChildren_ = NewChildren) + ), + + expand_failure_trees(Wn,U2,Un,EWn), + (failed(ID,Module,CID,Cref,G) -> Expanded=[f(G,Module,Cref,NewChildren)|EWn]; append(NewChildren,EWn,Expanded)). +expand_failure_trees([],U,U,[]). + +% simplify_explanation(+ExpandedWhy,-LeanerWhy) +simplify_explanation(Why,Simp) :- simplify_explanation(Why,[],_,Simp). + +% simplify_explanation(+Why,+VisitedNodes,-NewVisitedNodes,-Simplified) ...Nodes are lists of (s/f/u)(Literal,Module) +simplify_explanation([E1|En],Visited,NewVisited,Simplified) :- E1=..[Type,X,M,Ref,Children], Node=..[Type,X,M], + ((member(Node_,Visited), variant(Node_,Node))-> + simplify_explanation(En,Visited,NewVisited,Simplified) ; + ( + simplify_explanation(Children,[Node|Visited],V2,SimpChildren), simplify_explanation(En,V2,NewVisited,SimpN), + E1Simp=..[Type,X,M,Ref,SimpChildren], + Simplified=[E1Simp|SimpN] + ) + ). +simplify_explanation([],V,V,[]). + +% expand_explanation_refs(+ExpandedWhy,+ExtraFacts,-ExpandedRefLessWhy) +% TODO: recover original variable names? seems to require either some hacking with clause_info or reparsing +% transforms explanation: each nodetype(Literal,Module,ClauseRef,Children) --> nodetype(Literal,ClauseRef,Module,SourceString,OriginURL,Children) +expand_explanation_refs(CrudeE,Facts,taxlog(taxlogExplanation(E))) :- !, + expand_explanation_refs_taxlog(CrudeE, Facts, E). + +expand_explanation_refs(CrudeE,Facts,le(le_Explanation(E))) :- !, + expand_explanation_refs_le(CrudeE, Facts, E). + +expand_explanation_refs(CrudeE,Facts,scasp(E)) :- + expand_explanation_refs_casp(CrudeE, Facts, E). + +expand_explanation_refs_taxlog([Node|Nodes],Facts,[NewNode|NewNodes]) :- !, + Node=..[Type,X,Module,Ref,Children], + refToSourceAndOrigin(Ref,Source,Origin), + %TODO: is the following test against facts necessary???: + ((member(XX,Facts), variant(XX,X)) -> NewOrigin=userFact ; NewOrigin=Origin), + NewNode=..[Type,X,Ref,Module,Source,NewOrigin,NewChildren], + expand_explanation_refs_taxlog(Children,Facts,NewChildren), + expand_explanation_refs_taxlog(Nodes,Facts,NewNodes). +expand_explanation_refs_taxlog([],_,[]). + +expand_explanation_refs_le([Node|Nodes],Facts, [NewNode|NewNodes]) :- + Node=..[Type,X0,Module,Ref,Children], + ( Children=[s(L,M2,Ref2,[])], unifiable(X0, L, _) -> % to filter final leaves + ( NextType = s, X = L, NextChildren = [], NextModule = M2, NextRef = Ref2 ) + ; ( NextType = Type, X = X0, NextChildren = Children, NextModule = Module, NextRef = Ref)), + refToSourceAndOrigin(NextRef,Source,Origin), + %TODO: is the following test against facts necessary???: + ((member(XX,Facts), variant(XX,X)) -> NewOrigin=userFact ; NewOrigin=Origin), + (X\=[] -> + (translate_to_le(X, EnglishAnswer) -> + %print_message(informational, "Explaining ~w as ~w"-[X, EnglishAnswer]) + ( Output = EnglishAnswer + %NewNode=..[Type,Output,Ref,Module,Source,NewOrigin,NewChildren], + %expand_explanation_refs(Children,Facts,NewChildren), + %AllNodes = [NewNode|NewNodes] + ) + ; ( %print_message(informational, "Can't translate ~w"-[X]), + term_string('Prolog Expression'(X), Output) ) + ) + ; %AllNodes = NewNodes + Output = 'it is a fact' + ), + %translate_to_le(X, Output), + NewNode=..[NextType,Output,NextRef,NextModule,Source,NewOrigin,NewChildren], + expand_explanation_refs_le(NextChildren,Facts,NewChildren), + expand_explanation_refs_le(Nodes,Facts,NewNodes). +expand_explanation_refs_le([],_,[]). + +translate_to_le(X, EnglishAnswer) :- + le_input:translate_goal_into_LE(X, RawAnswer), le_input:name_as_atom(RawAnswer, EnglishAnswer). + %print_message(informational, "Translating ~w into ~w"-[X, EnglishAnswer]), !. + +expand_explanation_refs_casp([Node|Nodes],Facts,[X-NewChildren|NewNodes]) :- !, + Node=..[_Type,X,_Module,_Ref,Children], + %refToSourceAndOrigin(Ref,Source,Origin), + %TODO: is the following test against facts necessary???: + %((member(XX,Facts), variant(XX,X)) -> NewOrigin=userFact ; NewOrigin=Origin), + %NewNode=..[Type,X,Ref,Module,Source,NewOrigin,NewChildren], + expand_explanation_refs_casp(Children,Facts,NewChildren), + expand_explanation_refs_casp(Nodes,Facts,NewNodes). +expand_explanation_refs_casp([],_,[]). + +% [s(a(1,a),(0x7f95c763bc30),[s(c(1),(0x7f95c763bd90),[]),s(t(a),(0x7f95c763c000),[])])] +explanation_node_type(s,success). +explanation_node_type(f,failure). +explanation_node_type(u,unknown). % a success depending on unknown subgoals + +% for HTML rendering, see explanation_renderer.pl + +/* Graphviz support, not very promising given the large size of our labels (predicate names) +% experimental; would need unique IDs to avoid large term duplication +explanationChild(s(_,_Ref,Children),C) :- member(C,Children). + +explanationRelation(Root,Parent,Child) :- Parent=Root, explanationChild(Parent,Child). +explanationRelation(Root,Parent,Child) :- explanationChild(Root,X), explanationRelation(X,Parent,Child). + +explanationGraph(E,dot(digraph([rankdir='TB'|Items]))) :- + setof(edge(From->To,[label=""]), E_^From^To^(member(E_,E), explanationRelation(E_,From,To)), Edges), + setof(node(N,NodeAttrs), Attrs^From^To^(member(edge(From->To,Attrs),Edges), (From=N;To=N), nodeAttributes(N,NodeAttrs)), Nodes), + append(Edges,Nodes,Items). + +nodeAttributes(s(G,_Ref,_),[label=S]) :- format(string(S),"~w",G). +nodeAttributes(unknown(at(G,K)), [label=S]) :- format(string(S),"~w",G). +nodeAttributes(failed(at(G,K)), [color=red,label=S]) :- format(string(S),"~w",G). +nodeAttributes(at(G,K), [color=green,label=S]) :- format(string(S),"~w",G). +*/ + +%%%% Common background knowledge, probably to go elsewhere: + +%Time predicates; they assume times are atoms in iso_8601 format + +%! after(+Later,+Earlier) is det. +% Arguments must be dates in iso_8601 format, e.g. '20210206' or '2021-02-06T08:25:34' +isafter(Later,Earlier) :- + parse_time(Later,L), parse_time(Earlier,E), L>E. +is_not_before(Later,Earlier) :- + parse_time(Later,L), parse_time(Earlier,E), L>=E. +isbefore(Earlier,Later) :- + parse_time(Later,L), parse_time(Earlier,E), E true ; throw("Unbound arguments in immediately_before"-[])), + (nonvar(Earlier) -> (parse_time(Earlier,E), L is E+24*3600 ) ; true), + (nonvar(Later) -> (parse_time(Later,L), E is L-24*3600) ; true), + (var(Earlier) -> format_time(string(Earlier),"%FT%T%z",E) ; true), + (var(Later) -> format_time(string(Later),"%FT%T%z",L) ; true). + +same_date(T1,T2) :- + format_time(string(S),"%F",T1), format_time(string(S),"%F",T2). + +%! subtract_days(+LaterDate,+EarlierDate,-Days) +% How many days (24 hours intervals) later +subtract_days(LaterDate,EarlierDate,Days) :- + parse_time(LaterDate,Later), parse_time(EarlierDate,Earlier), + Days is round(Later-Earlier) div (24*3600). + +%! this_year(?Year) is det. +% The current year +this_year(Y) :- get_time(Now), stamp_date_time(Now,date(Y,_M,_D,_,_,_,_,_,_),local). + +%! uk_tax_year(?DateInTaxYear,?FirstYear,-StartDate,-EndDate) +% "the range of uk tax year Y is from Start to End" +% Given either a Date or a number for the first year, returns a tax year date range +uk_tax_year(D,FirstYear,Start,End) :- nonvar(D), !, FirstYear=StartYear, + parse_time(D,Time), stamp_date_time(Time,DT,local), DT=..[date,Year,Month,Day|_], + ((Month>4;Month=4,Day>=6) -> StartYear = Year ; StartYear is Year-1), + EndYear is StartYear+1, + format_time(string(Start),"%F",date(StartYear,4,6)), + format_time(string(End),"%F",date(EndYear,4,5)). +uk_tax_year(Start,StartYear,Start,End) :- must_be(integer,StartYear), + assertion(StartYear>1899), % format_time limitation + EndYear is StartYear+1, + format_time(string(Start),"%F",date(StartYear,4,6)), + format_time(string(End),"%F",date(EndYear,4,5)). + + +%! in(X,List) is nondet. +% X is in List +in(X,List) :- must_be(list,List), member(X,List). + +has_as_head_before([Head|Rest],Head,Rest). + +:- if(current_module(swish)). %%%%% On SWISH: + +sandbox:safe_primitive(reasoner:query(_,_,_,_)). +sandbox:safe_primitive(reasoner:query_once_with_facts(_,_,_,_,_)). +sandbox:safe_primitive(reasoner:query_with_facts(_,_,_,_,_)). +sandbox:safe_primitive(reasoner:render_questions(_,_)). + + +:- use_module(swish(lib/html_output),[html/1]). +% hack to avoid SWISH errors: +myhtml(H) :- this_capsule(SwishModule), SwishModule:html(H). + +kbModule(M) :- this_capsule(M). + + +:- else. % On command-line SWI-Prolog, no user restrictions: + +kbModule(user). +:- endif. diff --git a/examples/multi-file-generation/project/prolog/spacy/spacy.pl b/examples/multi-file-generation/project/prolog/spacy/spacy.pl new file mode 100755 index 00000000..ace94d67 --- /dev/null +++ b/examples/multi-file-generation/project/prolog/spacy/spacy.pl @@ -0,0 +1,488 @@ +% Copyright Miguel Calejo, 2019-2020; open source, licensed with 3-clause BSD + +:- module(_,[ + load_content/1, load_content_from_text_file/2, content/2, refreshTokens/1, content_tokens/4, content_tokens_in/5, + t_word/2, t_lemma/2, t_pos/2, t_tag/2, t_head/2, t_dep/2, t_i/2, t_offset/2, t_absorbed/2, member_with/3, member_with/2, root/2, + sentence/2, parseAndSee/4, parseAndSee/5, spaCyParseTokens/3, + depgraph/2, hierplane/2]). +% Spacy interface: parsing, representation of text chunks and sentences with tokens, utility predicates +% Text and tokens are kept associated with URLs/paths, with an implicit textual hierarchy + +%! load_content(+ContentFileOrDicts) +% loads content from a file or an ItemsArray list; each item is a _{url:U,text:T} dict +load_content(File) :- atomic(File), !, + setup_call_cleanup(open(File,read,S),( + repeat, + ( + read(S,Term), + (Term==end_of_file -> true ; + Term=content(URL,Text) -> (update_content(URL,Text), fail) ; + (print_message(warning, "ignored content: ~w"-[Term]), fail) + )) + ),close(S)), !. +load_content(Items) :- + must_be(list,Items), + forall(member(Item,Items), update_content(Item.url,Item.text) ). + +load_content_from_text_file(File,URLbase) :- + format(string(URLbase),"file://~a",[File]), + open(File,read,S), + create_counter(LC), + repeat, + inc_counter(LC,LN), + read_line_to_string(S,Line), + ( + Line==end_of_file, !, close(S) + ; + Line \= "", + \+ sub_atom(Line,0,_,_,'#'), % not a comment + format(string(URL),"~a#~w",[URLbase,LN]), + update_content(URL,Line), + fail + ). + + +% content(URL,Text) +% all the text chunks to process, each with a unique URL denoting its origin +content(Path,Text) :- + user_can_see_content, content_(Path,Text). + +:- thread_local content_/2. % URL, text string + +update_content(URL,Text) :- + must_be(atomic,URL), must_be(atomic,Text), + retractall(content_(URL,_)), assert(content_(URL,Text)). + +% parsed sentence tokens for each text chunk +content_tokens(URI, Sentence_i, Tokens,Extraction) :- + user_can_see_content, content_tokens_(URI, Sentence_i, Tokens,Extraction). + +% content_tokens_in(+PrefixURL, ?SpecificURL, ?Sentence_i, ?Tokens, ?Extraction) +content_tokens_in(PrefixURL,URL,SI,Tokens,Extraction) :- + user_can_see_content, must_be(nonvar,PrefixURL), + content_tokens_(URL, SI, Tokens,Extraction), + sub_atom(URL,0,_,_,PrefixURL). + +:- thread_local content_tokens_/4. % content_tokens_(URI, Sentence_i, Tokens, Extraction) + +% clear_tokens(+Path,+Extraction) +% clears all tokens for txt chunks prefixed with Path and given extraction +clear_tokens(Prefix,Extraction) :- + findall(Path, (content_tokens_(Path, _, _, Extraction), sub_atom(Path,0,_,_,Prefix)), Paths), + forall(member(Path,Paths),retractall(content_tokens_(Path, _, _, Extraction))). + + + +%TODO: refactor for other parsers, possibly into different module +refreshTokens(Prefix) :- + Extraction = extraction(spaCyParse,_CollapseNouns,_CollapsePuncts,_When), + clear_tokens(Path,Extraction), + get_time(Now), CollapseNouns=1, CollapsePuncts=1, + NewExtraction = extraction(spaCyParse,CollapseNouns,CollapsePuncts,Now), + forall((content_(Path, Text), sub_atom(Path,0,_,_,Prefix)),( + spaCyParse(Text,CollapseNouns,CollapsePuncts,Sentences), + storeSentences(Sentences,0,0,Path,content_tokens_,NewExtraction) + )). + + +%%% Token utilities, graph and tree generators for SWISH rendering + +%! parseAndSee(+Text,+CollapseNouns,-SentenceIndex,-Tokens,-Hierplane) +% Parse English text with spaCy and return a sentence of tokens, including its hierplane tree +parseAndSee(Text,CollapseNouns,SentenceIndex,Tokens,Hierplane) :- + spaCyParseTokens(Text,CollapseNouns,0,en,SentenceIndex,Tokens), + hierplane(Tokens,Hierplane). + +parseAndSee(Text,SentenceIndex,Tokens,Hierplane) :- + parseAndSee(Text,1,SentenceIndex,Tokens,Hierplane). + + +% t(...); tag and POS and dependency labels are kept as lowercase atoms; the rest as strings +%TODO: replace by dict-based representation for terser queries etc. e.g. member_with(i=T.head,Head,Tokens), Head.pos=verb +/** + t_word(?Token,?Word) is nondet + + t_word(?Token,?Word) + Convenience accessor to a token term argument, or "field" +*/ +t_word(t(_I,_Offset,Word,_Lemma,_POS,_Tag,_Head,_Dep,_Absorbed),Word). +t_lemma(t(_I,_Offset,_Word,Lemma,_POS,_Tag,_Head,_Dep,_Absorbed),Lemma). +t_pos(t(_I,_Offset,_Word,_Lemma,POS,_Tag,_Head,_Dep,_Absorbed),POS). +t_tag(t(_I,_Offset,_Word,_Lemma,_POS,Tag,_Head,_Dep,_Absorbed),Tag). +t_head(t(_I,_Offset,_Word,_Lemma,_POS,_Tag,Head,_Dep,_Absorbed),Head). +t_dep(t(_I,_Offset,_Word,_Lemma,_POS,_Tag,_Head,Dep,_Absorbed),Dep). +t_i(t(I,_Offset,_Word,_Lemma,_POS,_Tag,_Head,_Dep,_Absorbed),I). +t_offset(t(_I,Offset,_Word,_Lemma,_POS,_Tag,_Head,_Dep,_Absorbed),Offset). +t_absorbed(t(_I,_Offset,_Word,_Lemma,_POS,_Tag,_Head,_Dep,Absorbed),Absorbed). % List of tokens that were "chunked" into this, e.g. to improve presentation +% replace Absorbed slot: +t_absorb(t(I,Offset,Word,Lemma,POS,Tag,Head,Dep,Old), Absorbed, t(I,Offset,Word,Lemma,POS,Tag,Head,Dep,New)) :- + must_be(list,Old), must_be(list,Absorbed), append(Old,Absorbed,New). + +%! member_with(?Conditions,?Token,+Tokens) +% Tokens has a Token complying to Condition (or a list thereof); each condition is a token_field_name=value, e.g. pos=verb +member_with(i=I,T,Tokens):-!, t_i(T,I), (nonvar(I) -> memberchk(T,Tokens) ; member(T,Tokens)). % i is a key! +member_with(head=Head,T,Tokens):-!, t_head(T,Head), member(T,Tokens). +member_with(pos=POS,T,Tokens):-!, t_pos(T,POS), member(T,Tokens). +member_with(tag=Tag,T,Tokens):-!, t_tag(T,Tag), member(T,Tokens). +member_with(dep=Dep,T,Tokens):-!, t_dep(T,Dep), member(T,Tokens). +member_with(word=Word,T,Tokens):-!, t_word(T,Word), member(T,Tokens). +member_with(lemma=L,T,Tokens):-!, t_lemma(T,L), member(T,Tokens). +member_with([C|Conditions],T,Tokens):-!, member_with(C,T,Tokens), member_with(Conditions,T,Tokens). +member_with([],T,Tokens) :- !, member(T,Tokens). +member_with(AV,_,_) :- domain_error(token_attribute=value,AV). + +member_with(Conditions,Tokens) :- member_with(Conditions,_,Tokens). + +select_with(i=I,T,Tokens,NewTokens):- !, t_i(T,I), select(T,Tokens,NewTokens). +select_with(AV,_,_,_) :- domain_error(token_attribute=value,AV). + +is_root(T) :- t_dep(T,D), D==root. +root(Tokens,Root) :- must_be(list,Tokens), member(Root,Tokens), is_root(Root), !. +is_leaf(T,Tokens) :- t_i(T,I), \+ member_with(head=I,_,Tokens). + +% Absorb aux verbs into their head +chunkVerbs(Tokens,ChunkedTokens) :- + select_with(i=AuxI,Aux,Tokens,Tokens1), (t_dep(Aux,aux);t_dep(Aux,auxpass)), is_leaf(Aux,Tokens), t_head(Aux,HI), + abs(AuxI-HI) =:= 1, % hierplane seems to dislike collapsing disjoint tokens, e.g. buggy: + %spaCyParseTokens("If at any time an Event of Default with respect to a party (the “Defaulting Party”) has occurred and is then continuing, the other party (the “Non-defaulting Party”) may, by not more than 20 days notice to the Defaulting Party specifying the relevant Event of Default, designate a day not earlier than the day such notice is effective as an Early Termination Date in respect of all outstanding Transactions",0,_Tokens), chunkVerbs(_Tokens,_Chunked), hierplane(_Chunked,HP), print_term(HP,[]). + !, + select_with(i=HI,Head,Tokens1,Tokens2), t_absorb(Head,[Aux],NewHead), + chunkVerbs([NewHead|Tokens2],ChunkedTokens). +chunkVerbs(Tokens,ChunkedTokens) :- % let's keep the token index ordering: + findall(I-T,member_with(i=I,T,Tokens),Pairs), + sort(Pairs,Sorted), + findall(T,member(_-T,Sorted),ChunkedTokens). + +/** + sentence(Tokens,Sentence) is det + + sentence(+Tokens,-Sentence) + Return the tokens abstracted into a (string) sentence. +*/ +sentence(Tokens,Sentence) :- words(Tokens,Sentence). + +% words(+Tokens,-WordsString) enforces token index ordering +words(Tokens,String) :- + must_be(list,Tokens), + findall(I-T_,(member_with(i=I,T,Tokens), t_absorbed(T,Absorbed), member(T_,[T|Absorbed])),Pairs), + sort(Pairs,Sorted), + findall(T,(member(_-T,Sorted)),SortedTokens), + concatTokenWords(SortedTokens,String). + +% tokens already expanded (from Absorbed) +concatTokenWords([T],Word) :- !, t_word(T,Word). +concatTokenWords([T1,T2|Tokens],String) :- + t_word(T1,W1), t_offset(T1,O1), t_offset(T2,O2), string_length(W1,L1), + (O2-O1>L1 -> Sep = " " ; Sep = ""), + concatTokenWords([T2|Tokens],S), atomics_to_string([W1,Sep,S],String). + +orderedTokens(Tokens,Ordered) :- + must_be(list,Tokens), + findall(I-T,member_with(i=I,T,Tokens),Pairs), + sort(Pairs,Sorted), + findall(T,member(_-T,Sorted),Ordered). + +/** + depgraph(+Tokens,-Digraph) is det + + depgraph(+Tokens,-Digraph) + Given a sentence produces a GraphViz dot directed graph specification, ready to display on SWISH. +*/ +depgraph(Tokens,dot(digraph([rankdir='BT'|Edges]))) :- + findall( edge((From->To),[label=Dep]), ( + member(T,Tokens), t_head(T,HI), \+ is_root(T), + t_dep(T,Dep), t_word(T,Word), t_i(T,I), member_with(i=HI,Head,Tokens), t_word(Head,HeadWord), + % Nodes are Index:Word; stringify them so Graphviz does NOT take them as node ports: + term_string(I:Word,From), term_string(HI:HeadWord,To) + ), Edges). + +hierplane(Tokens,HP) :- + LTP = _{nsubj:left, nsubjpass:left, csubj:left, mark:left, dobj:right}, % aux:inside + hierplane(Tokens,_{linkToPosition:LTP},HP). + +% hierplane(+Tokens,+StyleMaps,-RenderableHierplaneTerm) +% StyleMaps is a dict representing optional structures in https://github.com/allenai/hierplane#maps +% For rendering see hierplane_renderer.pl +hierplane(Tokens,StyleMaps,hierplane( HP )) :- + HP = _{text:S, root:R}.put(StyleMaps), + sentence(Tokens,S), + root(Tokens,Root), + Tokens=[First|_], t_offset(First,Delta), + hierplaneTree(Root,Tokens,Delta,R). + +hierplaneTree(T,Tokens,Delta,Node_) :- + t_absorbed(T,Absorbed), + t_pos(T,POS), t_tag(T,Tag), t_dep(T,Dep), t_i(T,I), + orderedTokens([T|Absorbed],Ordered), + words([T],Words), + tokenSpans(Ordered,Delta,Spans), + Node = _{nodeType:POS, word:Words, spans:Spans, link:Dep, attributes: [Tag] }, + findall(ChildT, member_with(head=I,ChildT,Tokens), ChildTokens), + (ChildTokens = [_|_] -> Node_ = Node.put(children,Nodes) ; Node=Node_ ), + hierplaneTrees(ChildTokens,Tokens,Delta,Nodes). + +hierplaneTrees([C1|Cn],Tokens,Delta,[N1|Nn]) :- !, + hierplaneTree(C1,Tokens,Delta,N1), hierplaneTrees(Cn,Tokens,Delta,Nn). +hierplaneTrees([],_,_,[]). + +tokenSpans([T1|Tn],Delta,[_{start:Start,end:End}|Spans]) :- !, + t_offset(T1,Offset), Start is Offset-Delta, + t_word(T1,Word), string_length(Word,L), End is Start+L, + tokenSpans(Tn,Delta,Spans). +tokenSpans([],_,[]). + +% tokens_to_trees(+Tokens,-Trees) Trees will be a list of Dep(HeadToken,Children) trees +% Ex: content_tokens_(Path,SI,_Tokens),tokens_to_trees(_Tokens,_Trees), member(_Tree,_Trees), print_term(_Tree,[]). +tokens_to_trees(Tokens1,[root(Root,Children)|Trees]) :- select(Root,Tokens1,Tokens2), is_root(Root), !, + tokens_to_children_trees(Tokens2,Root,Children,Tokens3), + tokens_to_trees(Tokens3,Trees). +tokens_to_trees([],[]). + +tokens_to_children_trees(Tokens1,Head,[Child|Children],Tokens) :- t_i(Head,HI), select(C,Tokens1,Tokens2), t_head(C,HI), !, + t_dep(C,Dep), + Child=..[Dep,C,GrandChildren], + tokens_to_children_trees(Tokens2,C,GrandChildren,Tokens3), + tokens_to_children_trees(Tokens3,Head,Children,Tokens). +tokens_to_children_trees(Tokens,_,[],Tokens). + + +%%% For spaCy: +% Meaning of dependency labels: https://v2.spacy.io/api/annotation#dependency-parsing + +% tags (finer, not the coarser universal POS): https://v2.spacy.io/api/annotation#pos-tagging +% the following was copied from the above and then: +% tagToPOS(Tag,POS,M,D), string_lower(Tag,TagL), string_lower(POS,POSL), atom_string(Tag_,TagL), atom_string(POS_,POSL), +% format("tagToPOS(~q,~q, ~q,~q).~n",[Tag_,POS_,M,D]), fail. +% +% tagToPOS(FineTag,UniversalPOS,Morphology,Description) +tagToPOS($,sym, '','symbol, currency'). +tagToPOS('``',punct, 'PunctType=quot PunctSide=ini','opening quotation mark'). +tagToPOS('\'\'',punct, 'PunctType=quot PunctSide=fin','closing quotation mark'). +tagToPOS(',',punct, 'PunctType=comm','punctuation mark, comma'). +tagToPOS('-lrb-',punct, 'PunctType=brck PunctSide=ini','left round bracket'). +tagToPOS('-rrb-',punct, 'PunctType=brck PunctSide=fin','right round bracket'). +tagToPOS('.',punct, 'PunctType=peri','punctuation mark, sentence closer'). +tagToPOS(:,punct, '','punctuation mark, colon or ellipsis'). +tagToPOS(add,x, '',email). +tagToPOS(afx,adj, 'Hyph=yes',affix). +tagToPOS(cc,cconj, 'ConjType=comp','conjunction, coordinating'). +tagToPOS(cd,num, 'NumType=card','cardinal number'). +tagToPOS(dt,det, '',determiner). +tagToPOS(ex,pron, 'AdvType=ex','existential there'). +tagToPOS(fw,x, 'Foreign=yes','foreign word'). +tagToPOS(gw,x, '','additional word in multi-word expression'). +tagToPOS(hyph,punct, 'PunctType=dash','punctuation mark, hyphen'). +tagToPOS(in,adp, '','conjunction, subordinating or preposition'). +tagToPOS(jj,adj, 'Degree=pos',adjective). +tagToPOS(jjr,adj, 'Degree=comp','adjective, comparative'). +tagToPOS(jjs,adj, 'Degree=sup','adjective, superlative'). +tagToPOS(ls,x, 'NumType=ord','list item marker'). +tagToPOS(md,verb, 'VerbType=mod','verb, modal auxiliary'). +tagToPOS(nfp,punct, '','superfluous punctuation'). +tagToPOS(nil,x, '','missing tag'). +tagToPOS(nn,noun, 'Number=sing','noun, singular or mass'). +tagToPOS(nnp,propn, 'NounType=prop Number=sing','noun, proper singular'). +tagToPOS(nnps,propn, 'NounType=prop Number=plur','noun, proper plural'). +tagToPOS(nns,noun, 'Number=plur','noun, plural'). +tagToPOS(pdt,det, '',predeterminer). +tagToPOS(pos,part, 'Poss=yes','possessive ending'). +tagToPOS(prp,pron, 'PronType=prs','pronoun, personal'). +tagToPOS('prp$',det, 'PronType=prs Poss=yes','pronoun, possessive'). +tagToPOS(rb,adv, 'Degree=pos',adverb). +tagToPOS(rbr,adv, 'Degree=comp','adverb, comparative'). +tagToPOS(rbs,adv, 'Degree=sup','adverb, superlative'). +tagToPOS(rp,adp, '','adverb, particle'). +tagToPOS(sp,space, '',space). +tagToPOS(sym,sym, '',symbol). +tagToPOS(to,part, 'PartType=inf VerbForm=inf','infinitival “to”'). +tagToPOS(uh,intj, '',interjection). +tagToPOS(vb,verb, 'VerbForm=inf','verb, base form'). +tagToPOS(vbd,verb, 'VerbForm=fin Tense=past','verb, past tense'). +tagToPOS(vbg,verb, 'VerbForm=part Tense=pres Aspect=prog','verb, gerund or present participle'). +tagToPOS(vbn,verb, 'VerbForm=part Tense=past Aspect=perf','verb, past participle'). +tagToPOS(vbp,verb, 'VerbForm=fin Tense=pres','verb, non-3rd person singular present'). +tagToPOS(vbz,verb, 'VerbForm=fin Tense=pres Number=sing Person=three','verb, 3rd person singular present'). +tagToPOS(wdt,det, '','wh-determiner'). +tagToPOS(wp,pron, '','wh-pronoun, personal'). +tagToPOS('wp$',det, 'Poss=yes','wh-pronoun, possessive'). +tagToPOS(wrb,adv, '','wh-adverb'). +tagToPOS(xx,x, '',unknown). +tagToPOS('_sp',space, '',''). + +% for interactive experimentation +spaCyParseTokens(Text,SentenceI,Tokens) :- spaCyParseTokens(Text,en,SentenceI,Tokens). + +spaCyParseTokens(Text,Model,SentenceI,Tokens) :- + spaCyParseTokens(Text,1,0,Model,SentenceI,Tokens). + +spaCyParseTokens(Text,CollapseNouns,CollapsePuncts,Model,SentenceI,Tokens) :- + spaCyParse(Text,CollapseNouns,CollapsePuncts,Model,Dicts), + spaCyDictsToTokens(Dicts,0,0,Pairs), + member(SentenceI/Tokens,Pairs). + +% spaCyDictsToTokens(Dicts,SentenceIndex,WordIndex,Pairs) Pairs is a list of SI/Tokens + +spaCyDictsToTokens([S1|Sn],SI,WI,[SI/Tokens|Pairs]) :- !, + Words = S1.dep_parse.words, + Arcs = S1.dep_parse.arcs, + wordTokens(Words,WI,NewWI,Tokens), bindArcs(Arcs,Tokens), + ((member_with(head=H,Root,Tokens), var(H)) -> H=root, t_dep(Root,root) ; throw(missing_root(S1))), + assertion(ground(Tokens)), + NewSI is SI+1, + spaCyDictsToTokens(Sn,NewSI,NewWI,Pairs). +spaCyDictsToTokens([],_,_,[]). + +% storeSentences(+Sentences,+SentenceIndex,+WordIndex,+Path,+FunctorToStore,+Extraction) +storeSentences(Dicts,SentenceIndex,WordIndex,Path,Functor,Extraction) :- + spaCyDictsToTokens(Dicts,SentenceIndex,WordIndex,Pairs), + Fact =.. [Functor,Path, SI, Tokens, Extraction], + forall(member(SI/Tokens,Pairs), assert(Fact)). + +% wordTokens(+Words,+WI,-NewWI,-Tokens) +wordTokens([W|Words],WI,NewWI,[T|Tokens]) :- !, + string_lower(W.tag,TagL), atom_string(Tag,TagL), + (tagToPOS(Tag,POS,_,_)->true;Tag=POS, print_message(warning,"bad tag: ~w for ~w "-[Tag,W])), % throw(badTag(W)) is too harsh on non English languages... + t_word(T,W.text), t_tag(T,Tag), t_pos(T,POS), t_i(T,WI), + t_lemma(T,W.lemma), t_offset(T,W.offset), t_absorbed(T,[]), + I is WI+1, + wordTokens(Words,I,NewWI,Tokens). +wordTokens([],WI,WI,[]). + +% bindArcs(+Arcs,?Tokens) +bindArcs([A|Arcs],Tokens) :- !, + atom_string(Label,A.label), + (A.dir == "left" -> member_with(i=A.start,T,Tokens), H=A.end ; + A.dir == "right" -> member_with(i=A.end,T,Tokens), H=A.start + ; throw(weirdArc(A))), + t_head(T,H), t_dep(T,Label), + bindArcs(Arcs,Tokens). +bindArcs([],_). + + + +:- use_module(library(http/http_client)). +:- use_module(library(http/json)). + +%%% spaCy testing, https://github.com/jgontrum/spacy-api-docker ; requires SPACY_HOST environment variable set + +%parserURL("http://localhost:8080/dep"). +spaCyURL(U) :- getenv('SPACY_HOST',Host), format(string(U),"http://~a/sents_dep",[Host]). + +%! spaCyParse(+TextOrWordsList,+CollapseNouns,+CollapsePuncts,-Dict) +% for REST service in https://github.com/jgontrum/spacy-api-docker +spaCyParse(Text,CollapseNouns,CollapsePuncts,Dict) :- + spaCyParse(Text,CollapseNouns,CollapsePuncts,en,Dict). + +% spaCyParse(TextOrList,CollapseNouns,CollapsePuncts,Model,_) :- mylog(spaCyParse(TextOrList,CollapseNouns,CollapsePuncts,Model,_)), fail. +spaCyParse(TextOrList,CollapseNouns,CollapsePuncts,Model,Dict) :- + (is_list(TextOrList) -> atomic_list_concat(TextOrList," ",Text); TextOrList=Text), + user_can_parse, + assertion(CollapseNouns==1;CollapseNouns==0), + assertion(CollapsePuncts==1;CollapsePuncts==0), + assertion((member(M,[en,de,es,fr,pt,it,nl]), M==Model)), + must_be(var,Dict), + atom_string(Text,Text_), + replace_complicated_words(Text_,Text__), + %(Text_\=Text__ -> print_message(informational,Text__);true), + (spaCyURL(URL) -> true ; (print_message(error,"Missing spaCy URL"), fail)), + format(atom(Post),'{"text":"~a", "model":"~a", "collapse_phrases": ~w, "collapse_punctuation": ~w }',[Text__,Model,CollapseNouns,CollapsePuncts]), + catch( (http_post(URL, atom(Post), Result, []), atom_json_dict(Result,Dict,[])), Ex, (print_message(error,"spaCy failed for ~a: ~w"-[Text, Ex]), Dict=[])). + + +replace_complicated_words(Text,NewText) :- + findall(Word/Synonym,complicatedWord(Word,Synonym),Pairs), replace_complicated_words(Pairs,Text,NewText). + +replace_complicated_words([Word/Syn|Pairs],Text,NewText) :- string_replace(Text,Word,Syn,Text1), Text\=Text1, !, replace_complicated_words([Word/Syn|Pairs],Text1,NewText). +replace_complicated_words([_|Pairs],Text,NewText) :- !, replace_complicated_words(Pairs,Text,NewText). +replace_complicated_words([],T,T). + +% Some synomymns for weird legalese words SpaCy dislikes +complicatedWord(" thereof"," of it"). +complicatedWord(":-",": "). +complicatedWord("\"","'"). % doublequotes seem to break parses +complicatedWord("”","'"). % ditto for smart quotes.. +complicatedWord("‘’","'"). % ...and weird friends +complicatedWord("’’","'"). % ...and weird friends +complicatedWord("\t"," "). % ditto for tabs +complicatedWord("\n\n","\n"). % collapse empty lines +complicatedWord("\n","\\n"). % newlines need to be "reified" TODO: ";" would be better... at least of there's no other punctuation ending the previous line! + + +%%% utils +% strip leading and trailing whitespace from atom or string +strip(Atom, Stripped) :- + atom(Atom), + !, + atom_codes(Atom,Codes), strip_common(Codes,StrippedCodes), atom_codes(Stripped,StrippedCodes). +strip(String, Stripped) :- + string(String), + string_codes(String,Codes), strip_common(Codes,StrippedCodes), string_codes(Stripped,StrippedCodes). + +strip_common(Codes,StrippedCodes) :- strip_prefix(Codes,Codes1), strip_suffix(Codes1,StrippedCodes). + +strip_prefix(Codes,Stripped) :- whitespace(Codes,Codes1), !, strip_prefix(Codes1,Stripped). +strip_prefix(Codes,Codes). + +strip_suffix(Codes,Stripped) :- whitespace(W,[]), append(Codes1,W,Codes), !, strip_suffix(Codes1,Stripped). +strip_suffix(Codes,Codes). + +whitespace([32|L],L). +whitespace([9|L],L). + +string_replace(String,Pattern,Replacement,Result) :- + atomics_to_string(Items,Pattern,String), atomics_to_string(Items,Replacement,Result). + + +/** + count_solutions(:G,N) is det + + count_solutions(Goal,SolutionsCount) + Executes a goal completely, efficiently counting its solutions; better for this than using findall/3 plus length/2 +*/ +count_solutions(G,N) :- create_counter(C), (G, inc_counter(C), fail ; get_counter(C,N)). + +create_counter(counter(0)). +get_counter(counter(N),N). +set_counter(Counter,N) :- Counter=counter(_), nb_setarg(1,Counter,N). +inc_counter(Counter,N) :- get_counter(Counter,N), NewN is N+1, nb_setarg(1,Counter,NewN). +inc_counter(Counter) :- inc_counter(Counter,_). + +:- use_module(library(assoc)). +count_occurrences(L,Pairs) :- count_occurrences(L,_TopN,Pairs). + +% count_occurrences(List,TopN,Pairs) Pairs is a list of ListValue-Count, ordered descendently by Count; if TopN is bound, only the TopN elements are returned +count_occurrences(L,TopN,Pairs) :- assertion(ground(L)), + empty_assoc(Assoc), count_occurrences_(L,Assoc,NewAssoc), assoc_to_list(NewAssoc,Pairs_), + sort(2,@>=,Pairs_,Pairs__), + (var(TopN) -> Pairs__=Pairs ; (length(Pairs__,N), N Pairs__=Pairs; length(Pairs,TopN), append(Pairs,_,Pairs__)). + +count_occurrences_([X|L],Assoc,NewAssoc) :- get_assoc(X, Assoc, Count), !, + NewCount is Count+1, put_assoc(X, Assoc, NewCount, Assoc2), count_occurrences_(L,Assoc2,NewAssoc). +count_occurrences_([X|L],Assoc,NewAssoc) :- !, put_assoc(X, Assoc, 1, Assoc2), !, + count_occurrences_(L,Assoc2,NewAssoc). +count_occurrences_([],A,A). + +:- if(current_module(swish)). % On SWISH: +sandbox:safe_primitive(spacy:content(_,_)). +sandbox:safe_primitive(spacy:spaCyParseTokens(_,_,_)). +sandbox:safe_primitive(spacy:spaCyParseTokens(_,_,_,_)). +sandbox:safe_primitive(spacy:spaCyParseTokens(_,_,_,_,_,_)). +sandbox:safe_primitive(prolog_pretty_print:print_term_2(_,_)). % Somehow print_term/2 on SWISS is considered unsafe by default +sandbox:safe_primitive(spacy:depgraph(Tokens,_G)) :- is_list(Tokens). +sandbox:safe_primitive(spacy:hierplane(Tokens,_G)) :- is_list(Tokens). +sandbox:safe_primitive(spacy:sentence(_,_)). +sandbox:safe_primitive(spacy:parseAndSee(_,_,_,_,_)). +sandbox:safe_primitive(spacy:chunkVerbs(Tokens,_)) :- is_list(Tokens). +sandbox:safe_primitive(spacy:count_solutions(G,_)) :- sandbox:safe_goal(spacy:G). +sandbox:safe_primitive(spacy:count_occurrences(_,_)). +sandbox:safe_primitive(spacy:count_occurrences(_,_,_)). + +% hooks for authentication +user_can_parse. +user_can_see_content. + +:- else. % On command-line SWI-Prolog, no user restrictions: +user_can_parse. +user_can_see_content. +:- endif. + diff --git a/examples/multi-file-generation/project/prolog/syntax.pl b/examples/multi-file-generation/project/prolog/syntax.pl new file mode 100755 index 00000000..0643058e --- /dev/null +++ b/examples/multi-file-generation/project/prolog/syntax.pl @@ -0,0 +1,308 @@ +/* Copyright [2021] Initial copyright holders by country: +LodgeIT (AU), AORA Law (UK), Bob Kowalski (UK), Miguel Calejo (PT), Jacinto Dávila (VE) + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +*/ + +:- module(_,[ + op(1195,fx, user:(++)), % for hypothetical facts and rules + op(1190,xfx,user:(if)), + op(1187,xfx,user:(then)), + op(1187,xfx,user:(must)), + op(1185,fx,user:(if)), + op(1185,xfy,user:else), + op(1000,xfy,user:and), % same as , + op(1050,xfy,user:or), % same as ; + op(900,fx,user:not), % same as \+ + op(700,xfx,user:in), + op(600,xfx,user:on), + op(1150,xfx,user:because), % to support because(on(p,t),why) if ... + op(700,xfx,user:at), % note vs. negation...incompatible with LPS fluents + % date operators + op(700,xfx,user:is_not_before), + op(700,xfx,user:before), + op(700,xfx,user:after), + taxlog2prolog/3, + semantics2prolog/3, + semantics2prolog2/3, + current_source/1 + ]). + +:- use_module(kp_loader,[kp_location/3,my_xref_defined/3]). + +:- use_module(library(prolog_xref)). +:- use_module(library(prolog_colour)). +:- use_module(library(pengines)). + + +:- if(current_module(swish)). +:- use_module('le_swish.pl'). % module to handle the gitty filesystem +:- else. +:- use_module('le_local.pl'). % module to handle the local filesystem +:- endif. + + +/* +Transforms source rules into our "no time on heads" representation, using a body wrapper to carry extra information: + targetBody(RealBody,HasTimeOnHead,Time,URL,Why,LE_line or taxlog) % i.e. the line number in LE or the label taxlog + +P on T if Body --> P :- targetBody(Body,true,T,'',[],LE_line or taxlog) +P on T because Why :- PrologBody --> P :- targetBody(PrologBody,true,T,'',Why,LE_line or taxlog) +P if Body --> P :- targetBody(Body,false,_,'',[],LE_line or taxlog) +Admissible variants with a specific URL: +P on T at URL if Body --> P :- targetBody(Body,true,T,URL,[],LE_line or taxlog) +P at URL if Body --> P :- targetBody(Body,false,_,URL,[],LE_line or taxlog) +*/ + +semantics2prolog2(if(N,H,B),neck(if)-[],(H:-targetBody(B,false,_,'',[],NN))) :- !, % working rule with line number + NN is N + 3. % correction to linecount + %taxlogHeadSpec(H,SpecH), taxlogBodySpec(B,SpecB). +semantics2prolog2(if(H,B),neck(if)-[],(H:-targetBody(B,false,_,'',[],3))) :- !. % pre-settings without line numbers + %taxlogHeadSpec(H,SpecH), taxlogBodySpec(B,SpecB), + %this_capsule(SwishModule), + %declare_facts_as_dynamic(SwishModule, [H]). +%semantics2prolog2(if(H,B),neck(if)-[SpecH,SpecB],(H:-B)) :- !, +% SpecH=classify, SpecB=classify. + %taxlogHeadSpec(H,SpecH), taxlogBodySpec(B,SpecB). +%semantics2prolog2(mainGoal(G,Description),delimiter-[Spec,classify],(mainGoal(G,Description):-(_=1->true;GG))) :- !, % hack to avoid 'unreferenced' highlight in SWISH +% functor(G,F,N), functor(GG,F,N), % avoid "Singleton-marked variable appears more than once" +% taxlogBodySpec(G,Spec). +semantics2prolog2(abducible(Abd,Body),delimiter-[classify,classify],abducible(Abd,Body)) :- !. + % this_capsule(SwishModule), + % declare_facts_as_dynamic(SwishModule, [abducible(_,_)]), !. +semantics2prolog2(example(T,Sequence),delimiter-[classify,Spec],example(T,Sequence)) :- !, + % this_capsule(SwishModule), + % declare_facts_as_dynamic(SwishModule, [example(_,_)]), !, + Spec = classify. % just a hack - scenarioSequenceSpec must be different for prolog's scenarios + %(Sequence==[]->Spec=classify ; (Spec=list-SeqSpec, scenarioSequenceSpec(Sequence,SeqSpec))). +semantics2prolog2(query(Name,Goal),delimiter-[classify,classify],query(Name,Goal)) :- !. + % this_capsule(SwishModule), + % declare_facts_as_dynamic(SwishModule, [query(_,_)]), !. +semantics2prolog2(metapredicates(Assumptions), delimiter-[classify,classify],metapredicates([N])) :- !, + % this_capsule(SwishModule), + lists:length(Assumptions,N). + % declare_facts_as_dynamic(SwishModule, Assumptions), !. +semantics2prolog2(predicates(Assumptions), delimiter-[classify,classify],predicates([N])) :- !, + % this_capsule(SwishModule), + lists:length(Assumptions,N). + % declare_facts_as_dynamic(SwishModule, Assumptions), !. + %print_message(informational, "asserted: ~w"-[Assumptions]). +semantics2prolog2(events(Assumptions), delimiter-[classify,classify],events([N])) :- !, + % this_capsule(SwishModule), + lists:length(Assumptions,N). + % declare_facts_as_dynamic(SwishModule, [happens(_,_), initiates(_,_,_), terminates(_,_,_)|Assumptions]), !. +semantics2prolog2(fluents(Assumptions), delimiter-[classify,classify],fluents([N])) :- !, + % this_capsule(SwishModule), + lists:length(Assumptions,N). + % declare_facts_as_dynamic(SwishModule, [it_is_illegal(_,_)|Assumptions]), !. +semantics2prolog2(target(T), delimiter-[classify,classify],target(T)). + % this_capsule(SwishModule), + % declare_facts_as_dynamic(SwishModule, [just_saved_scasp(_, _)]), !. + +taxlog2prolog(if(_LineNumber,H,B), Spec, New) :- !, taxlog2prolog(if(H,B),Spec,New). % hack for LogicalEnglish +taxlog2prolog(if(function(Call,Result),Body), neck(if)-[delimiter-[head(meta,Call),classify],SpecB], (function(Call,Result):-Body)) :- !, + taxlogBodySpec(Body,SpecB). +taxlog2prolog(if(at(on(H,T),Url),B), neck(if)-[delimiter-[delimiter-[SpecH,classify],classify],SpecB], (H:-targetBody(B,true,T,Url,[],taxlog))) :- !, + taxlogHeadSpec(H,SpecH), taxlogBodySpec(B,SpecB). +taxlog2prolog(if(at(H,Url),B), neck(if)-[delimiter-[SpecH,classify],SpecB], (H:-targetBody(B,false,_T,Url,[],taxlog))) :- !, + taxlogHeadSpec(H,SpecH), taxlogBodySpec(B,SpecB). +taxlog2prolog(if(on(H,T),B), neck(if)-[delimiter-[SpecH,classify],SpecB], (H:-targetBody(B,true,T,'',[],taxlog))) :- !, + taxlogHeadSpec(H,SpecH), taxlogBodySpec(B,SpecB). +taxlog2prolog(if(H,B),neck(if)-[SpecH,SpecB],(H:-targetBody(B,false,_,'',[],taxlog))) :- !, + taxlogHeadSpec(H,SpecH), taxlogBodySpec(B,SpecB). +taxlog2prolog((because(on(H,T),Why):-B), neck(clause)-[ delimiter-[delimiter-[SpecH,classify],classify], SpecB ], (H:-targetBody(call(B),true,T,'',Why,taxlog))) :- Why\==[], !, + taxlogHeadSpec(H,SpecH), taxlogBodySpec(B,SpecB). +taxlog2prolog(mainGoal(G,Description),delimiter-[Spec,classify],(mainGoal(G,Description):-(_=1->true;GG))) :- !, % hack to avoid 'unreferenced' highlight in SWISH + functor(G,F,N), functor(GG,F,N), % avoid "Singleton-marked variable appears more than once" + taxlogBodySpec(G,Spec). +taxlog2prolog((example(T,Sequence):-Body), neck(clause)-[delimiter-[classify,Spec],classify],(example(T,Sequence):-Body)) :- !, + (Sequence==[]->Spec=classify ; (Spec=list-SeqSpec, scenarioSequenceSpec(Sequence,SeqSpec))). +taxlog2prolog(example(T,Sequence),delimiter-[classify,Spec],example(T,Sequence)) :- !, + (Sequence==[]->Spec=classify ; (Spec=list-SeqSpec, scenarioSequenceSpec(Sequence,SeqSpec))). +taxlog2prolog(question(X,QuestionTerm),delimiter-[classify,classify],question(X,QuestionTerm)) :- !. +taxlog2prolog(question(X,QuestionTerm,Answer),delimiter-[classify,classify,classify],question(X,QuestionTerm,Answer)) :- !. +taxlog2prolog(irrelevant_explanation(G),delimiter-[Spec],irrelevant_explanation(G)) :- !, + taxlogBodySpec(G,Spec). +taxlog2prolog(query(Name,Goal),delimiter-[classify,classify],query(Name,Goal)). + +% extending to cover new structural changes at semantical level + +semantics2prolog(if(N,H,B),neck(if)-[SpecH,SpecB],(H:-targetBody(B,false,_,'',[],NN))) :- !, % working rule with line number + NN is N + 3, % correction to linecount + taxlogHeadSpec(H,SpecH), taxlogBodySpec(B,SpecB). +semantics2prolog(if(H,B),neck(if)-[SpecH,SpecB],(H:-targetBody(B,false,_,'',[],3))) :- !, % pre-settings without line numbers + taxlogHeadSpec(H,SpecH), taxlogBodySpec(B,SpecB), + this_capsule(SwishModule), + declare_facts_as_dynamic(SwishModule, [H]). +%semantics2prolog(if(H,B),neck(if)-[SpecH,SpecB],(H:-B)) :- !, +% SpecH=classify, SpecB=classify. + %taxlogHeadSpec(H,SpecH), taxlogBodySpec(B,SpecB). +%semantics2prolog(mainGoal(G,Description),delimiter-[Spec,classify],(mainGoal(G,Description):-(_=1->true;GG))) :- !, % hack to avoid 'unreferenced' highlight in SWISH +% functor(G,F,N), functor(GG,F,N), % avoid "Singleton-marked variable appears more than once" +% taxlogBodySpec(G,Spec). +semantics2prolog(abducible(Abd,Body),delimiter-[classify,classify],abducible(Abd,Body)) :- + this_capsule(SwishModule), + declare_facts_as_dynamic(SwishModule, [abducible(_,_)]), !. +semantics2prolog(example(T,Sequence),delimiter-[classify,Spec],example(T,Sequence)) :- + this_capsule(SwishModule), + declare_facts_as_dynamic(SwishModule, [example(_,_)]), !, + Spec = classify. % just a hack - scenarioSequenceSpec must be different for prolog's scenarios + %(Sequence==[]->Spec=classify ; (Spec=list-SeqSpec, scenarioSequenceSpec(Sequence,SeqSpec))). +semantics2prolog(query(Name,Goal),delimiter-[classify,classify],query(Name,Goal)) :- + this_capsule(SwishModule), + declare_facts_as_dynamic(SwishModule, [query(_,_)]), !. +semantics2prolog(metapredicates(Assumptions), delimiter-[classify,classify],metapredicates([N])) :- + this_capsule(SwishModule), lists:length(Assumptions,N), + declare_facts_as_dynamic(SwishModule, Assumptions), !. +semantics2prolog(predicates(Assumptions), delimiter-[classify,classify],predicates([N])) :- + this_capsule(SwishModule), lists:length(Assumptions,N), + declare_facts_as_dynamic(SwishModule, Assumptions), !. + %print_message(informational, "asserted: ~w"-[Assumptions]). +semantics2prolog(events(Assumptions), delimiter-[classify,classify],events([N])) :- + this_capsule(SwishModule), lists:length(Assumptions,N), + declare_facts_as_dynamic(SwishModule, [happens(_,_), initiates(_,_,_), terminates(_,_,_)|Assumptions]), !. +semantics2prolog(fluents(Assumptions), delimiter-[classify,classify],fluents([N])) :- + this_capsule(SwishModule), lists:length(Assumptions,N), + declare_facts_as_dynamic(SwishModule, [it_is_illegal(_,_)|Assumptions]), !. +semantics2prolog(target(T), delimiter-[classify,classify],target(T)) :- + this_capsule(SwishModule), + declare_facts_as_dynamic(SwishModule, [just_saved_scasp(_, _)]), !. + +% assuming one example -> one scenario -> one list of facts. % deprecated +% declare_dynamic(Module, [scenario(Facts, _)]) :- declare_facts_as_dynamic(Module, Facts). + +declare_facts_as_dynamic(_, []) :- !. +declare_facts_as_dynamic(M, [F|R]) :- functor(F, P, A), % facts are the templates now + dynamic([M:P/A], [thread(local), discontiguous(true)]), declare_facts_as_dynamic(M, R). + +% note: keep the above cases coherent with kp_loader:system_predicate/1 + +scenarioSequenceSpec([S|Scenarios],[Spec|Specs]) :- !, + scenarioSpec(S,Spec), + scenarioSequenceSpec(Scenarios,Specs). +scenarioSequenceSpec([],[]). + +scenarioSpec(scenario(Facts,Assertion),delimiter-[FactsSpec,Spec]) :- + (Facts==[] -> FactsSpec=classify ; (factsSpecs(Facts,FS), FactsSpec=list-FS)), + taxlogBodySpec(Assertion,Spec). + +factsSpecs(Facts,classify) :- var(Facts), !. +factsSpecs([Fact_|Facts],[FactSpec|Specs]) :- !, + (Fact_= -Fact -> FactSpec= delimiter-[FS] ; Fact_= '++'(Fact) -> FactSpec= delimiter-[FS]; (Fact=Fact_,FactSpec=FS)), + nonvar(Fact), + (Fact=if(H,B)->( + taxlogHeadSpec(H,FSH),taxlogBodySpec(B,FSB),FS=neck(if)-[FSH,FSB]); + taxlogHeadSpec(Fact,FS) ), + factsSpecs(Facts,Specs). +factsSpecs([],[]). + +taxlogHeadSpec(H,head(Class, H)) :- current_source(UUID), + !, + xref_module(UUID,Me), + (H=on(RealH,_T)->true;H=RealH), + (xref_called(_Other,Me:RealH, _) -> (Class=exported) ; + xref_called(UUID, RealH, _By) -> (Class=head) ; + Class=unreferenced). +taxlogHeadSpec(H,head(head, H)). + +:- multifile swish_highlight:style/3. +swish_highlight:style(neck(if), neck, [ text(if) ]). + +% :- thread_local current_module/1. +% :- multifile prolog_colour:directive_colours/2. +% prolog_colour:directive_colours((:- module(M,_)),null) :- +% mylog(detected_module/M), % NOT CALLED AT ALL??? +% retractall(current_module(_)), assert(current_module(M)), fail. + + +% this must be in sync with the interpreter i(...) and prolog:meta_goal(...) hooks +taxlogBodySpec(V,classify) :- var(V), !. +taxlogBodySpec(and(A,B),delimiter-[SpecA,SpecB]) :- !, + taxlogBodySpec(A,SpecA), taxlogBodySpec(B,SpecB). +taxlogBodySpec((A,B),delimiter-[SpecA,SpecB]) :- !, + taxlogBodySpec(A,SpecA), taxlogBodySpec(B,SpecB). +taxlogBodySpec(or(A,B),delimiter-[SpecA,SpecB]) :- !, + taxlogBodySpec(A,SpecA), taxlogBodySpec(B,SpecB). +taxlogBodySpec((A;B),delimiter-[SpecA,SpecB]) :- !, + taxlogBodySpec(A,SpecA), taxlogBodySpec(B,SpecB). +taxlogBodySpec(must(if(I),M),delimiter-[delimiter-SpecI,SpecM]) :- !, + taxlogBodySpec(I,SpecI), taxlogBodySpec(M,SpecM). +taxlogBodySpec(not(G),delimiter-[Spec]) :- !, + taxlogBodySpec(G,Spec). +taxlogBodySpec((\+G),delimiter-[Spec]) :- !, + taxlogBodySpec(G,Spec). +taxlogBodySpec(then(if(C),else(T,Else)),delimiter-[delimiter-[SpecC],delimiter-[SpecT,SpecE]]) :- !, + taxlogBodySpec(C,SpecC), taxlogBodySpec(T,SpecT), taxlogBodySpec(Else,SpecE). +taxlogBodySpec(then(if(C),Then),delimiter-[delimiter-[SpecC],SpecT]) :- !, + taxlogBodySpec(C,SpecC), taxlogBodySpec(Then,SpecT). +taxlogBodySpec(forall(C,Must),control-[SpecC,SpecMust]) :- !, + taxlogBodySpec(C,SpecC), taxlogBodySpec(Must,SpecMust). +taxlogBodySpec(setof(_X,G,_L),control-[classify,SpecG,classify]) :- !, + taxlogBodySpec(G,SpecG). +taxlogBodySpec(bagof(_X,G,_L),control-[classify,SpecG,classify]) :- !, + taxlogBodySpec(G,SpecG). +taxlogBodySpec(_^G,delimiter-[classify,SpecG]) :- !, + taxlogBodySpec(G,SpecG). +% this is needed only to deal with multiline instances of aggregate... (or of any predicate of our own colouring, apparently:-( ) +taxlogBodySpec(aggregate(_X,G,_L),control-[classify,SpecG,classify]) :- !, + taxlogBodySpec(G,SpecG). +taxlogBodySpec(aggregate_all(_X,G,_L),control-[classify,SpecG,classify]) :- !, + taxlogBodySpec(G,SpecG). +taxlogBodySpec(findall(_X,G,_L),control-[classify,SpecG,classify]) :- !, + taxlogBodySpec(G,SpecG). +% questions are no longer goals, just annotations for (rendering unknown) goal literals +%taxlogBodySpec(question(_,_),delimiter-[classify,classify]). % to avoid multiline colouring bug +%taxlogBodySpec(question(_),delimiter-[classify]). +taxlogBodySpec(M:G,delimiter-[classify,SpecG]) :- !, taxlogBodySpec(at(G,M),delimiter-[SpecG,classify]). +taxlogBodySpec(at(G_,M_),Spec) :- nonvar(M_), nonvar(G_), !, % assuming atomic goals + atom_string(M,M_), %TODO: this might be cleaned up/refactored with the next clauses: + (G_=on(G,_) -> Spec=delimiter-[delimiter-[SpecG,classify],classify]; (G=G_, Spec=delimiter-[SpecG,classify])), + (my_xref_defined(M,G,_)-> SpecG=goal(imported(M),G)-classify ; SpecG=goal(undefined,G)-classify). +taxlogBodySpec(on(G,_T),delimiter-[SpecG,classify] ) :- !, + taxlogBodySpec(G,SpecG). +taxlogBodySpec(G,Spec) :- + (compound(G)->Spec=goal(Class,G)-classify;Spec=goal(Class,G)), + current_source(UUID), taxlogGoalSpec(G, UUID, Class), + !. +taxlogBodySpec(_G,classify). + +taxlogGoalSpec(G, UUID, Class) :- + (my_xref_defined(UUID, G, Class) -> true ; + %prolog_colour:built_in_predicate(G)->Class=built_in ; + my_goal_classification(G,Class) -> true; + Class=undefined). + +:- if(current_prolog_flag(version_data,swi(8, 2, _, _))). +my_goal_classification(G,Class) :- + prolog_colour:call_goal_classification(G, Class). +:- elif(( current_prolog_flag(version_data,V), V@>= swi(8, 3, 0, []))). +my_goal_classification(G,Class) :- + prolog_colour:call_goal_classification(G, _Module, Class). +:- else. +:- print_message(error,"You need SWI-Prolog 8.2 or later"-[]), halt(1). +:- endif. + +:- if(current_module(swish)). %%% only when running with the SWISH web server: +% hack to find the editor (e.g. its module name) that triggered the present highlighting +current_source(UUID) :- + swish_highlight:current_editor(UUID, _TB, source, Lock, _), mutex_property(Lock,status(locked(_Owner, _Count))), !. +current_source(UUID) :- + %mylog('Could not find locked editor, going with the first one'), + swish_highlight:current_editor(UUID, _TB, source, _Lock, _), !. + +:- else. %% barebones SWI-Prolog: +% find the module in the file being coloured (which has been xref'd already) +current_source(Source) :- + prolog_load_context(source,File), kp_location(Source,File,false). +:- endif. + diff --git a/examples/multi-file-generation/project/prolog/tokenize/prolog/tokenize.pl b/examples/multi-file-generation/project/prolog/tokenize/prolog/tokenize.pl new file mode 100755 index 00000000..e1d2b6c4 --- /dev/null +++ b/examples/multi-file-generation/project/prolog/tokenize/prolog/tokenize.pl @@ -0,0 +1,344 @@ +:- module(tokenize, + [ tokenize/2, + tokenize/3, + tokenize_file/2, + tokenize_file/3, + untokenize/2 + ]). + +/** tokenize + +This module offers a simple tokenizer with flexible options. + +@author Shon Feder +@license + +Rational: + +tokenize_atom/2, in library(porter_stem), is inflexible, in that it doesn't +allow for the preservation of white space or control characters, and it only +tokenizes into a list of atoms. + +The `tokenize` library is meant to be easy to use while allowing for relatively +flexible input and output. Features include + + * options for tokenization of spaces, numbers, strings, control characters and punctuation + * options to output packed tokens + * options to represent tokens in any of the common SWI-Prolog text formats + * option to preserve or ignore case + * a predicate to emit text given a list of tokens + +E.g., + +== +?- tokenize('Tokenizes: words,"strings", 1234.5\n', Tokens, [cased(true), spaces(false)]), +| untokenize(Tokens, Codes). +Tokens = [word('Tokenizes'), punct(:), word(words), punct(','), string(strings), punct(','), number(1234.5), cntrl('\n')], +Codes = "Tokenizes:words,"strings"...34.5 +". +== + +`tokenize` is much more limited and much less performant than a lexer generator, +but it is dead simple to use and flexible enough for many common use cases. +*/ + +:- use_module(library(dcg/basics), [eos//0, number//1]). +:- use_module(tokenize_opts). + +% Ensure we interpret back ticks as enclosing code lists in this module. +:- set_prolog_flag(back_quotes, codes). + +%! tokenize(+Text:text, -Tokens:list(term)) is semidet. +% +% @see tokenize/3 when called with an empty list of options: thus, with defaults. + +% TODO: add support for unicode + +tokenize(Text, Tokens) :- + tokenize(Text, Tokens, []). + +%! tokenize(+Text:text, -Tokens:list(term), +Options:list(term)) is semidet. +% +% True when Tokens is unified with a list of tokens representing the text from +% Text, according to the options specified in Options. +% +% Each token in Tokens will be one of: +% +% * word(W) +% Where W is comprised of contiguous alpha-numeric chars. +% * punct(P) +% Where char_type(P, punct). +% * cntrl(C) +% Where char_type(C, cntrl). +% * space(S) +% Where `S == ' '`. +% * number(N) +% Where number(N). +% * string(S) +% Where S was a sequence of bytes enclosed by double quotation marks. +% +% Note that the above describes the default behavior, in which the token is +% represented as an `atom`. This representation can be changed by using the +% `to` option described below. +% +% Valid Options are: +% +% * cased(+boolean) +% Determines whether tokens perserve cases of the source text. Defaults to `cased(false)`. +% * spaces(+boolean) +% Determines whether spaces are represted as tokens or discarded. Defaults to `spaces(true)`. +% * cntrl(+boolean) +% Determines whether control characters are represented as tokens or discarded. Defaults to `cntrl(true)`. +% * punct(+boolean) +% Determines whether punctuation characters are represented as tokens or discarded. Defaults to `punct(true)`. +% * numbers(+boolean) +% Determines whether the tokenizer represents and tags numbers. Defaults to `numbers(true)`. +% * strings(+boolean) +% Determines whether the tokenizer represents and tags strings. Defaults to `strings(true)`. +% * pack(+boolean) +% Determines whether tokens are packed or repeated. Defaults to `pack(false)`. +% * to(+one_of([strings,atoms,chars,codes])) +% Determines the representation format used for the tokens. Defaults to `to(atoms)`. + +% TODO is it possible to achieve the proper semidet without the cut? +% Annie sez some parses are ambiguous, not even sure the cut should be +% there + +tokenize(Text, ProcessedTokens, Options) :- + must_be(nonvar, Text), + string_codes(Text, Codes), + process_options(Options, PreOpts, TokenOpts, PostOpts), + preprocess(PreOpts, Codes, ProcessedCodes), + phrase(tokens(TokenOpts, Tokens), ProcessedCodes), + postprocess(PostOpts, Tokens, ProcessedTokens), + !. + +non_tokens([T]) --> T. +non_tokens([T|Ts]) --> T, non_tokens(Ts). + +%! tokenize_file(+File:atom, -Tokens:list(term)) is semidet. +% +% @see tokenize_file/3 when called with an empty list of options: thus, with defaults. +% + +% Note: does not use phrase_from_file/3, thus not lazy or transparent +% This choice was made so that tokenize_file will work with remotely +% accessed files. +% TODO: make this configurable, so it can be used in the different modes + +% TODO: add more source options + +tokenize_file(File, Tokens) :- + tokenize_file(File, Tokens, []). + +%! tokenize_file(+File:atom, -Tokens:list(term), +Options:list(term)) is semidet. +% +% True when Tokens is unified with a list of tokens represening +% the text of File. +% +% @see tokenize/3 which has the same available options and behavior. + +tokenize_file(File, Tokens, Options) :- + read_file_to_codes(File, Codes, [encoding(utf8)]), + tokenize(Codes, Tokens, Options). + +%! untokenize(+Tokens:list(term), -Untokens:list(codes)) is semidet. +% +% True when Untokens is unified with a code list representation of each +% token in Tokens. + +% TODO structure(Options:[lines, brackets]) +% TODO mode(generate) ; mode(parse) +% TODO add output format option +% TODO is it possible to achieve the proper semidet without the cut? + +untokenize(Tokens, Untokens) :- + untokenize(Tokens, Untokens, []). +untokenize(Tokens, Untokens, _Options) :- + maplist(token_to(codes), Tokens, TokenCodes), + phrase(non_tokens(TokenCodes), Untokens), + !. + +/*********************************** +* {PRE,POST}-PROCESSING HELPERS * +***********************************/ + +preprocess(PreOpts, Codes, ProcessedCodes) :- + preopts_data(cased, PreOpts, Cased), + DCG_Rules = ( + preprocess_case(Cased) + ), + phrase(process_dcg_rules(DCG_Rules, ProcessedCodes), Codes). + +postprocess(PostOpts, Tokens, ProcessedTokens) :- + postopts_data(spaces, PostOpts, Spaces), + postopts_data(cntrl, PostOpts, Cntrl), + postopts_data(punct, PostOpts, Punct), + postopts_data(to, PostOpts, To), + postopts_data(pack, PostOpts, Pack), + DCG_Rules = ( + keep_token(space(_), Spaces), + keep_token(cntrl(_), Cntrl), + keep_token(punct(_), Punct), + convert_token(To) + ), + phrase(process_dcg_rules(DCG_Rules, PrePackedTokens), Tokens), + (Pack + -> phrase(pack_tokens(ProcessedTokens), PrePackedTokens) + ; ProcessedTokens = PrePackedTokens + ). + + +/*********************************** +* POSTPROCESSING HELPERS * +***********************************/ + +% Process a stream through a pipeline of DCG rules +process_dcg_rules(_, []) --> eos, !. +process_dcg_rules(DCG_Rules, []) --> DCG_Rules, eos, !. +process_dcg_rules(DCG_Rules, [C|Cs]) --> + DCG_Rules, + [C], + process_dcg_rules(DCG_Rules, Cs). + +preprocess_case(true), [C] --> [C]. +preprocess_case(false), [CodeOut] --> [CodeIn], + { to_lower(CodeIn, CodeOut) }. + +keep_token(_, true), [T] --> [T]. +keep_token(Token, false) --> [Token]. +keep_token(Token, false), [T] --> [T], {T \= Token}. + +convert_token(Type), [Converted] --> [Token], + {token_to(Type, Token, Converted)}. + +% Convert tokens to alternative representations. +token_to(_, number(X), number(X)) :- !. +token_to(Type, Token, Converted) :- + ( Type == strings -> Conversion = inverse(string_codes) + ; Type == atoms -> Conversion = inverse(atom_codes) + ; Type == chars -> Conversion = inverse(string_chars) + ; Type == codes -> Conversion = string_codes + ), + call_into_term(Conversion, Token, Converted). + +% Packing repeating tokens +pack_tokens([T]) --> pack_token(T). +pack_tokens([T|Ts]) --> pack_token(T), pack_tokens(Ts). + +pack_token(P) --> pack(Token, N), {Token =.. [F,T], P =.. [F,T,N]}. + +pack(X, Count) --> [X], pack(X, 1, Count). + +pack(_, Total, Total) --> eos. +pack(X, Total, Total), [Y] --> [Y], { Y \= X }. +pack(X, Count, Total) --> [X], { succ(Count, NewCount) }, + pack(X, NewCount, Total). + + +/************************** +* TOKENIZATION * +**************************/ + +tokenize_text --> state(Text, Tokenized), + { phrase(tokens(Tokenized), Text) }. + + +% PARSING + +tokens(Opts, [T]) --> token(Opts, T), eos, !. +tokens(Opts, [T|Ts]) --> token(Opts, T), tokens(Opts, Ts). + +% NOTE for debugging +% tokens(_) --> {length(L, 200)}, L, {format(L)}, halt, !. + +token(Opts, string(S)) --> + { tokenopts_data(strings, Opts, true) }, + string(S). + +token(Opts, number(N)) --> + { tokenopts_data(numbers, Opts, true) }, + number(N), !. + +token(_Opts, word(W)) --> word(W), eos, !. +token(_Opts, word(W)),` ` --> word(W), ` `. +token(_Opts, word(W)), C --> word(W), (punct(C) ; cntrl(C) ; nasciis(C)). + +token(_Opts, space(S)) --> space(S). +token(_Opts, punct(P)) --> punct(P). +token(_Opts, cntrl(C)) --> cntrl(C). +token(_Opts, other(O)) --> nasciis(O). + +space(` `) --> ` `. + +sep --> ' '. +sep --> eos, !. + +word(W) --> csyms(W). + +% TODO Make open and close brackets configurable +string(S) --> string(`"`, `"`, S). +string(OpenBracket, CloseBracket, S) --> string_start(OpenBracket, CloseBracket, S). + +% A string starts when we encounter an OpenBracket +string_start(OpenBracket, CloseBracket, Cs) --> + OpenBracket, string_content(OpenBracket, CloseBracket, Cs). + +% String content is everything up until we hit a CloseBracket +string_content(_OpenBracket, CloseBracket, []) --> CloseBracket, !. +% String content includes a bracket following an escape, but not the escape +string_content(OpenBracket, CloseBracket, [C|Cs]) --> + escape, (CloseBracket | OpenBracket), + {[C] = CloseBracket}, + string_content(OpenBracket, CloseBracket, Cs). +% String content includes any character that isn't a CloseBracket or an escape. +string_content(OpenBracket, CloseBracket, [C|Cs]) --> + [C], + {[C] \= CloseBracket}, + string_content(OpenBracket, CloseBracket, Cs). + +csyms([L]) --> csym(L). +csyms([L|Ls]) --> csym(L), csyms(Ls). + +csym(L) --> [L], {code_type(L, csym)}. + + +% non ascii's +nasciis([C]) --> nascii(C), eos, !. +nasciis([C]),[D] --> nascii(C), [D], {D < 127}. +nasciis([C|Cs]) --> nascii(C), nasciis(Cs). + +nascii(C) --> [C], {C > 127}. + +' ' --> space. +' ' --> space, ' '. + +escape --> `\\`. + +% Any +... --> []. +... --> [_], ... . + +space --> [S], {code_type(S, white)}. + +punct([P]) --> [P], {code_type(P, punct)}. +cntrl([C]) --> [C], {code_type(C, cntrl)}. + +% TODO move to general module + +codes_to_lower([], []). +codes_to_lower([U|Uppers], [L|Lowers]) :- + code_type(U, to_upper(L)), + codes_to_lower(Uppers, Lowers). + +call_into_term(P, Term, Result) :- + Term =.. [F, Arg], + call(P, Arg, ResultArg), + Result =.. [F, ResultArg]. + +inverse(P, A, B) :- + call(P, B, A). + +pad(T_Args, X, T_X_Args) :- + T_Args =.. [T|Args], + T_X_Args =.. [T, X| Args]. diff --git a/examples/multi-file-generation/project/prolog/tokenize/prolog/tokenize_opts.pl b/examples/multi-file-generation/project/prolog/tokenize/prolog/tokenize_opts.pl new file mode 100755 index 00000000..fe606207 --- /dev/null +++ b/examples/multi-file-generation/project/prolog/tokenize/prolog/tokenize_opts.pl @@ -0,0 +1,46 @@ +:- module(tokenize_opts, + [process_options/4, + preopts_data/3, + tokenopts_data/3, + postopts_data/3]). + +:- use_module(library(record)). + +/** tokenize_opts + +This is an internal module used for option processing. The predicates exported +are not meant for use by client code. +*/ + +% pre-processing options +:- record preopts( + cased:boolean=false + ). + +% tokenization options +:- record tokenopts( + numbers:boolean=true, + strings:boolean=true + ). + +% post-processing options +:- record postopts( + spaces:boolean=true, + cntrl:boolean=true, + punct:boolean=true, + to:oneof([strings,atoms,chars,codes])=atoms, + pack:boolean=false + ). + +%! process_options(+Options:list(term), -PreOpts:term, TokenOpts:term, -PostOpts:term) is semidet. + +process_options(Options, PreOpts, TokenOpts, PostOpts) :- + make_preopts(Options, PreOpts, Rest0), + make_postopts(Rest0, PostOpts, Rest1), + make_tokenopts(Rest1, TokenOpts, InvalidOpts), + throw_on_invalid_options(InvalidOpts). + +throw_on_invalid_options(InvalidOpts) :- + InvalidOpts \= [] + -> throw(invalid_options_given(InvalidOpts)) + ; true. diff --git a/package-lock.json b/package-lock.json index 7c9a9af9..d4e48a22 100644 --- a/package-lock.json +++ b/package-lock.json @@ -10,7 +10,8 @@ "license": "BSD-2-Clause", "dependencies": { "@inrupt/universal-fetch": "^1.0.1", - "@types/emscripten": "^1.39.6" + "@types/emscripten": "^1.39.6", + "fs-extra": "^11.1.1" }, "bin": { "swipl-generate": "dist/bin/index.js" @@ -23,7 +24,6 @@ "@typescript-eslint/eslint-plugin": "^5.59.6", "@typescript-eslint/parser": "^5.59.6", "eslint": "^8.40.0", - "fs-extra": "^11.1.1", "http-server": "^14.1.1", "mocha": "^10.2.0", "node-static": "^0.7.11", @@ -3786,8 +3786,8 @@ }, "node_modules/fs-extra": { "version": "11.1.1", - "dev": true, - "license": "MIT", + "resolved": "https://registry.npmjs.org/fs-extra/-/fs-extra-11.1.1.tgz", + "integrity": "sha512-MGIE4HOvQCeUCzmlHs0vXpih4ysz4wg9qiSAu6cd42lVwPbTM1TjV7RusoyQqMmk/95gdQZX72u+YW+c3eEpFQ==", "dependencies": { "graceful-fs": "^4.2.0", "jsonfile": "^6.0.1", @@ -4106,7 +4106,6 @@ }, "node_modules/graceful-fs": { "version": "4.2.11", - "dev": true, "license": "ISC" }, "node_modules/grapheme-splitter": { @@ -4958,7 +4957,6 @@ }, "node_modules/jsonfile": { "version": "6.1.0", - "dev": true, "license": "MIT", "dependencies": { "universalify": "^2.0.0" @@ -11507,7 +11505,6 @@ }, "node_modules/universalify": { "version": "2.0.0", - "dev": true, "license": "MIT", "engines": { "node": ">= 10.0.0" diff --git a/package.json b/package.json index 830a276d..7aabcf57 100644 --- a/package.json +++ b/package.json @@ -26,7 +26,6 @@ "@typescript-eslint/eslint-plugin": "^5.59.6", "@typescript-eslint/parser": "^5.59.6", "eslint": "^8.40.0", - "fs-extra": "^11.1.1", "http-server": "^14.1.1", "mocha": "^10.2.0", "node-static": "^0.7.11", @@ -116,6 +115,7 @@ }, "dependencies": { "@inrupt/universal-fetch": "^1.0.1", - "@types/emscripten": "^1.39.6" + "@types/emscripten": "^1.39.6", + "fs-extra": "^11.1.1" } }