├── LICENSE ├── LICENSE.LarKC ├── clyc.asd ├── larkc-cycl ├── api-control-vars.lisp ├── api-kernel.lisp ├── arguments.lisp ├── arity.lisp ├── assertion-handles.lisp ├── assertion-manager.lisp ├── assertions-high.lisp ├── assertions-interface.lisp ├── assertions-low.lisp ├── at-macros.lisp ├── at-vars.lisp ├── auxiliary-indexing.lisp ├── binary-tree.lisp ├── cache-utilities.lisp ├── cache.lisp ├── cfasl-compression.lisp ├── cfasl-kernel.lisp ├── cfasl-utilities.lisp ├── cfasl.lisp ├── clause-strucs.lisp ├── clause-utilities.lisp ├── constant-completion-high.lisp ├── constant-completion-interface.lisp ├── constant-completion-low.lisp ├── constant-completion.lisp ├── constant-handles.lisp ├── constant-index-manager.lisp ├── constant-reader.lisp ├── constants-high.lisp ├── constants-interface.lisp ├── constants-low.lisp ├── control-vars.lisp ├── cyc-revision-extraction.lisp ├── cyc-testing.lisp ├── cycl-grammar.lisp ├── cycl-utilities.lisp ├── cycl-variables.lisp ├── czer-vars.lisp ├── deck.lisp ├── deduction-handles.lisp ├── deduction-manager.lisp ├── deductions-high.lisp ├── deductions-interface.lisp ├── deductions-low.lisp ├── dictionary-utilities.lisp ├── el-grammar.lisp ├── el-utilities.lisp ├── enumeration-types.lisp ├── eval-in-api.lisp ├── file-utilities.lisp ├── file-vector-utilities.lisp ├── file-vector.lisp ├── fort-types-interface.lisp ├── forts.lisp ├── function-terms.lisp ├── ghl-search-vars.lisp ├── graph-utilities.lisp ├── graphl-search-vars.lisp ├── gt-vars.lisp ├── hash-table-utilities.lisp ├── hl-interface-infrastructure.lisp ├── hl-modifiers.lisp ├── hl-storage-modules.lisp ├── hlmt-czer.lisp ├── hlmt.lisp ├── id-index.lisp ├── integer-sequence-generator.lisp ├── iteration.lisp ├── kb-accessors.lisp ├── kb-control-vars.lisp ├── kb-gp-mapping.lisp ├── kb-hl-support-manager.lisp ├── kb-hl-supports.lisp ├── kb-indexing-datastructures.lisp ├── kb-indexing-declarations.lisp ├── kb-indexing-macros.lisp ├── kb-indexing.lisp ├── kb-macros.lisp ├── kb-mapping-macros.lisp ├── kb-mapping-utilities.lisp ├── kb-mapping.lisp ├── kb-object-manager.lisp ├── kb-utilities.lisp ├── list-utilities.lisp ├── map-utilities.lisp ├── memoization-state.lisp ├── misc-utilities.lisp ├── modules.lisp ├── mt-relevance-macros.lisp ├── mt-vars.lisp ├── nart-handles.lisp ├── nart-hl-formula-manager.lisp ├── nart-index-manager.lisp ├── narts-high.lisp ├── number-utilities.lisp ├── numeric-date-utilities.lisp ├── obsolete.lisp ├── pattern-match.lisp ├── pred-relevance-macros.lisp ├── process-utilities.lisp ├── psc.lisp ├── queues.lisp ├── relation-evaluation.lisp ├── sbhl │ ├── sbhl-link-vars.lisp │ ├── sbhl-macros.lisp │ ├── sbhl-marking-vars.lisp │ ├── sbhl-module-vars.lisp │ ├── sbhl-paranoia.lisp │ ├── sbhl-search-datastructures.lisp │ └── sbhl-search-vars.lisp ├── set-contents.lisp ├── set-utilities.lisp ├── set.lisp ├── simple-indexing.lisp ├── somewhere-cache.lisp ├── special-variable-state.lisp ├── stacks.lisp ├── string-utilities.lisp ├── subl-macros.lisp ├── subl-promotions.lisp ├── system-info.lisp ├── system-parameters.lisp ├── system-version.lisp ├── tcp-server-utilities.lisp ├── tcp.lisp ├── term.lisp ├── transform-list-utilities.lisp ├── tries.lisp ├── unrepresented-term-index-manager.lisp ├── unrepresented-terms.lisp ├── utilities-macros.lisp ├── variables.lisp ├── vector-utilities.lisp ├── virtual-indexing.lisp ├── wff-macros.lisp └── wff-vars.lisp ├── readme.md └── subl-support.lisp /larkc-cycl/api-control-vars.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | (defparameter *cfasl-constant-handle-func* nil 45 | "[Cyc] Fucntion used to determine constant handles during CFASL output. 46 | If nIL, the default used is CONSTANT-INTERNAL-ID") 47 | (defparameter *cfasl-constant-handle-lookup-func* nil 48 | "[Cyc] Function used to look up constants from their handles during CFASL input. 49 | If NIL, the default used is FIND-CONSTANT-BY-INTERNAL-ID") 50 | (defparameter *cfasl-nart-handle-func* nil 51 | "[Cyc] Function used to determine NART handles during CFASL output. 52 | If NIL, the default used is NART-ID.") 53 | (defparameter *cfasl-nart-handle-lookup-func* nil 54 | "[Cyc] Function used to look up NARTs from their handles during CFASL input. 55 | If NIL, the default used is FIND-NART-BY-ID") 56 | (defparameter *cfasl-assertion-handle-func* nil 57 | "[Cyc] Function used to determine assertion handles during CFASL output. 58 | If NIL, the default used is ASSERTION-ID") 59 | (defparameter *cfasl-assertion-handle-lookup-func* nil 60 | "[Cyc] Function used to look up assertions from their handles during CFASL input. 61 | If NIL, the default used is FIND-ASSERTION-BY-ID") 62 | (defparameter *cfasl-deduction-handle-func* nil 63 | "[Cyc] Function used to determine deduction handles during CFASL output. 64 | If NIL, the default used is DEDUCTION-ID") 65 | (defparameter *cfasl-deduction-handle-lookup-func* nil 66 | "[Cyc] Function used to look up deductions from their handles during CFASL input. 67 | If NIL, the default used is FIND-DEDUCTION-BY-ID") 68 | (defparameter *cfasl-kb-hl-support-handle-func* nil 69 | "[Cyc] Function used to determine KB HL supports during CFASL output. 70 | If NIL, the default used is KB-HL-SUPPORT-ID") 71 | (defparameter *cfasl-kb-hl-support-handle-lookup-func* nil 72 | "[Cyc] Function used to look up KB HL supports from their handles during CFASL input. 73 | If NIL, the default used is FIND-KB-HL-SUPPORT-BY-ID") 74 | (defparameter *cfasl-clause-struc-handle-func* nil 75 | "[Cyc] Function used to determine clause-struc handles during CFASL output. 76 | If NIL, the default used is CLAUSE-STRUC-ID") 77 | (defparameter *cfasl-clause-struc-handle-lookup-func* nil 78 | "[Cyc] Function used to look up clause-strucs from their handles during CFASL input. 79 | If NIL, the default used is FIND-CLAUSE-STRUC-BY-ID") 80 | (defvar *the-cyclist* nil) 81 | (defparameter *use-local-queue?* t) 82 | (defparameter *default-ke-purpose* nil 83 | "[Cyc] The purpose to use for KE by default. NIL = General Cyc KE.") 84 | (defparameter *ke-purpose* *default-ke-purpose* 85 | "[Cyc] This variable constains current KE purpose for asserting formulas to the system. 86 | NIL means that the KB purpose is generic extension of Cyc's knowledge.") 87 | (defparameter *generate-readable-fi-results* t) 88 | -------------------------------------------------------------------------------- /larkc-cycl/arity.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | 40 | (deflexical *kb-arity-table-equality-test* #'eq 41 | "[Cyc] The equality test used for the KB arity tables.") 42 | 43 | (defglobal *kb-arity-table* nil) 44 | 45 | (defun* arity-lookup (relation) (:inline t) 46 | (gethash relation *kb-arity-table*)) 47 | 48 | (defun* set-arity (relation arity) (:inline t) 49 | (setf (gethash relation *kb-arity-table*) arity)) 50 | 51 | (defun* rem-arity (relation) (:inline t) 52 | (remhash relation *kb-arity-table*)) 53 | 54 | (defun arity (relation) 55 | (cond 56 | ((fort-p relation) (arity-lookup relation)) 57 | ((reifiable-nat? relation #'cyc-var? *anect-mt*) (missing-larkc 10320)) 58 | ((kappa-predicate-p relation) (missing-larkc 30572)) 59 | ((lambda-function-p relation) (missing-larkc 30574)))) 60 | 61 | (defun* possibly-simplify-arity (arity) (:inline t) 62 | arity) 63 | 64 | (defun maybe-add-arity-for-relation (relation arity) 65 | (setf arity (possibly-simplify-arity arity)) 66 | (let ((arity-in-table (arity relation))) 67 | (when (and arity-in-table 68 | (not (eql arity-in-table arity))) 69 | (error "Trying to overload arity for ~a from ~a to ~a" relation arity-in-table arity)) 70 | (set-arity relation arity))) 71 | 72 | (defun maybe-remove-arity-for-relation (relation arity) 73 | (let ((dont-remove nil) 74 | (other-arity nil) 75 | (pred-var #$arity)) 76 | (kmu-do-index-iteration (assertion gaf-arg (relation 1 pred-var) (:gaf :true nil) 77 | :done-place dont-remove) 78 | (let ((asserted-arity (gaf-arg2 assertion))) 79 | (if (= arity asserted-arity) 80 | (setf dont-remove (assertion-still-there? assertion :true)) 81 | (setf other-arity asserted-arity)))) 82 | (unless dont-remove 83 | (rem-arity relation)) 84 | (when other-arity 85 | (set-arity relation other-arity)))) 86 | 87 | (defglobal *kb-arity-min-table* nil) 88 | 89 | (defun* arity-min-lookup (relation) (:inline t) 90 | (gethash relation *kb-arity-min-table*)) 91 | 92 | (defun arity-min (relation) 93 | "[Cyc] Return the arity-min for RELATION." 94 | (or (arity-min-int relation) 95 | 0)) 96 | 97 | (defun arity-min-int (relation) 98 | (cond 99 | ((fort-p relation) 100 | (or (arity-min-lookup relation) 101 | (missing-larkc 12071))) 102 | 103 | ((reifiable-nat? relation #'cyc-var? *anect-mt*) 104 | (missing-larkc 10321)))) 105 | 106 | (defglobal *kb-arity-max-table* nil) 107 | 108 | (defun* arity-max-lookup (relation) (:inline t) 109 | (gethash relation *kb-arity-max-table*)) 110 | 111 | (defun arity-max (relation) 112 | "[Cyc] Return the arityMax for RELATION." 113 | (cond 114 | ((fort-p relation) 115 | (or (arity-max-lookup relation) 116 | (initialize-arity-max-for-relation relation))) 117 | 118 | ((reifiable-nat? relation #'cyc-var? *anect-mt*) 119 | (missing-larkc 10322)))) 120 | 121 | (defun initialize-arity-max-for-relation (relation) 122 | (and (fpred-value-in-any-mt relation #$arityMax) 123 | (missing-larkc 12068))) 124 | 125 | (defun* binary? (relation) (:inline t) 126 | (eql (arity relation) 2)) 127 | 128 | (defun binary-arg-swap (arg) 129 | (case arg 130 | (1 2) 131 | (2 1) 132 | (otherwise arg))) 133 | 134 | (defun variable-arity? (relation) 135 | (isa-variable-arity-relation? relation *anect-mt*)) 136 | 137 | (defun* arity-cache-unbuilt? () (:inline t) 138 | (not *kb-arity-table*)) 139 | 140 | (defun load-arity-cache-from-stream (stream) 141 | (setf *kb-arity-table* (cfasl-input stream)) 142 | (setf *kb-arity-min-table* (cfasl-input stream)) 143 | (setf *kb-arity-max-table* (cfasl-input stream)) 144 | (cfasl-input stream)) 145 | -------------------------------------------------------------------------------- /larkc-cycl/assertion-manager.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | (defglobal *arete-assertions-touched* (make-hash-table :test #'eq)) 40 | 41 | (defun arete-note-assertion-touched (assertion) 42 | (possibly-note-kb-access-assertion assertion) 43 | (when *arete-log-kb-touches?* 44 | (dictionary-increment *arete-assertions-touched* assertion))) 45 | 46 | (defglobal *assertion-content-manager* :uninitialized 47 | "[Cyc] The KB object manager for assertions.") 48 | 49 | (deflexical *assertion-lru-size-percentage* 16 50 | "[Cyc] Based on arete experiments, only 16% of all assertions are needed for normal inference.") 51 | 52 | (defun setup-assertion-content-table (size exact?) 53 | (setf *assertion-content-manager* (new-kb-object-manager "assertion" size *assertion-lru-size-percentage* #'load-assertion-def-from-cache exact?))) 54 | 55 | (defun clear-assertion-content-table () 56 | (clear-kb-object-content-table *assertion-content-manager*)) 57 | 58 | (defun* cached-assertion-count () (:inline t) 59 | "[Cyc] Return the number of assertions whose content is cached in memory." 60 | (cached-kb-object-count *assertion-content-manager*)) 61 | 62 | (defun* lookup-assertion-content (id) (:inline t) 63 | (arete-note-assertion-touched (find-assertion-by-id id)) 64 | (lookup-kb-object-content *assertion-content-manager* id)) 65 | 66 | (defun* register-assertion-content (id assertion-content) (:inline t) 67 | "[Cyc] Note that ID will be used as the id for ASSERTION-CONTENT." 68 | (register-kb-object-content *assertion-content-manager* id assertion-content)) 69 | 70 | (defun* deregister-assertion-content (id) (:inline t) 71 | "[Cyc] Note that ID is not in use as an ASSERTION-CONTENT id." 72 | (deregister-kb-object-content *assertion-content-manager* id)) 73 | 74 | (defun* mark-assertion-content-as-muted (id) (:inline t) 75 | (mark-kb-object-content-as-muted *assertion-content-manager* id)) 76 | 77 | (defun* swap-out-all-pristine-assertions () (:inline t) 78 | (swap-out-all-pristine-kb-objects-int *assertion-content-manager*)) 79 | 80 | (defun initialize-assertion-hl-store-cache () 81 | (initialize-kb-object-hl-store-cache *assertion-content-manager* 82 | "assertion" 83 | "assertion-index")) 84 | -------------------------------------------------------------------------------- /larkc-cycl/at-macros.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | (defun make-defn-fn-history-table () 40 | (make-hash-table :size *defn-fn-history-default-size*)) 41 | 42 | (defun make-defn-col-history-table () 43 | (make-hash-table :size *defn-col-history-default-size*)) 44 | 45 | (defun* possibly-make-defn-fn-history-table () 46 | (:inline t) 47 | (let ((val *defn-fn-history*)) 48 | (if (uninitialized-p val) 49 | (make-defn-fn-history-table) 50 | val))) 51 | 52 | (defun* possibly-make-quoted-defn-fn-history-table () (:inline t) 53 | (possibly-make-defn-fn-history-table)) 54 | 55 | (defun* possibly-make-defn-col-history-table () (:inline t) 56 | (let ((val *defn-col-history*)) 57 | (if (uninitialized-p val) 58 | (make-defn-col-history-table) 59 | val))) 60 | 61 | (defun* possibly-make-quoted-defn-col-history-table () (:inline t) 62 | (possibly-make-defn-col-history-table)) 63 | 64 | -------------------------------------------------------------------------------- /larkc-cycl/cfasl-compression.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | (defconstant *cfasl-opcode-open-compressed-block* 54) 45 | (defconstant *cfasl-opcode-compression-pair* 55) 46 | (defconstant *cfasl-opcode-compression-key* 56) 47 | (defconstant *cfasl-opcode-close-compressed-block* 57) 48 | (defglobal *cfasl-decompression-index* (make-hash-table :test #'eq) 49 | "[Cyc] A dictionary mapping streams to a stack of decompression tables, the topmost of which is the active one.") 50 | (defglobal *cfasl-compression-not-found* (make-symbol "NOT-FOUND")) 51 | (defparameter *cfasl-output-compression-options* nil) 52 | (defparameter *cfasl-output-compression-table* nil) 53 | (defparameter *cfasl-outputcompression-code-isg* nil) 54 | (defparameter *within-cfasl-compression-analysis?* nil) 55 | (deflexical *cfasl-compression-options-properties* '(:all? :analyze :not :verbose?) 56 | "[Cyc] The valid properties for the CFASL compression options property list.") 57 | 58 | (defun cfasl-compress-object? (object) 59 | (declare (ignore object)) 60 | (cond 61 | ((not *cfasl-output-compression-table*) nil) 62 | ((missing-larkc 12990)))) 63 | -------------------------------------------------------------------------------- /larkc-cycl/cfasl-utilities.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | (defun cfasl-load (filename) 45 | "[Cyc] Return the first object saved in FILENAME in CFASL format." 46 | (with-open-file (stream filename :element-type '(unsigned-byte 8)) 47 | (cfasl-input stream))) 48 | -------------------------------------------------------------------------------- /larkc-cycl/constant-completion-high.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | (defun valid-constant-name-char-p (char) 45 | "[Cyc] Return T iff CHAR is a character which is allowed in a valid constant name." 46 | (declare (character char)) 47 | (or (alphanumericp char) 48 | (find char "-_:"))) 49 | 50 | (defun valid-constant-name-p (string) 51 | "[Cyc] Return T iff STRING is a valid name for a constant." 52 | (and (stringp string) 53 | (>= (length string) 2) 54 | (not (find-if #'invalid-constant-name-char-p string)))) 55 | 56 | (defun invalid-constant-name-char-p (char) 57 | "[Cyc] Return T iff CHAR is a character which is not allowed in a valid constant name." 58 | (not (valid-constant-name-char-p char))) 59 | 60 | (defparameter *require-case-insensitive-name-uniqueness* t 61 | "[Cyc] Do we require that constant names be case-insensitively unique?") 62 | 63 | (defun constant-name-case-collisions (string) 64 | "[Cyc] Return a list of constants whose names differ from STRING only by case." 65 | (check-type string 'valid-constant-name-p) 66 | (let ((uses (constant-complete string nil t))) 67 | (delete string uses :test #'equal :key #'constant-name))) 68 | 69 | (defun constant-name-case-collision (string) 70 | "[Cyc] Return a constant whose name differs from STRING only by case." 71 | (check-type string 'valid-constant-name-p) 72 | (first (constant-name-collisions string))) 73 | 74 | 75 | (defun constant-complete-exact (string &optional (start 0) end) 76 | "[Cyc] Return a valid constant whose name exactly matches STRING. Optionally the START and END character positions can be specified, such that the STRING matches characters between the START and END range. If no constant exists, return NIL." 77 | (declare (string string) 78 | (fixnum start)) 79 | (kb-constant-complete-exact string start end)) 80 | 81 | (defun constant-complete (prefix &optional case-sensitive? exact-length? (start 0) end) 82 | "[Cyc] Return all valid constants with PREFIX as a prefix of their name. 83 | When CASE-SENSITIVE? is non-NIL, the comparison is done in a case-sensitive fashion. 84 | When EXACT-LENGTH? is non-NIL, the prefix must be the entire string. 85 | Optionally the START and END character positions can be specified, such that the PREFIX matches characters between the START and END range. If no constant exists, return NIL." 86 | (kb-constant-complete prefix case-sensitive? exact-length? start end)) 87 | 88 | (defun new-constant-completion-iterator (&optional (forward? t) (buffer-size 1)) 89 | (kb-new-constant-completion-iterator forward? buffer-size)) 90 | 91 | (defun map-constants-in-completions (function) 92 | (let ((iterator (new-constant-completion-iterator))) 93 | (map-iterator function iterator))) 94 | -------------------------------------------------------------------------------- /larkc-cycl/constant-completion-interface.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | (defun kb-constant-complete-exact (string &optional (start 0) (end (length string))) 45 | "[Cyc] Return a valid constant whose name exactly matches STRING. 46 | Optionally the START and END character positions can be specified, such that the STRING matches the characters between the START and END range. 47 | If no constant exists, return NIL." 48 | (if (hl-access-remote?) 49 | (missing-larkc 29536) 50 | (kb-constant-complete-exact-internal string start end))) 51 | 52 | (defun kb-constant-complete (prefix &optional case-sensitive? exact-length? (start 0) (end (length prefix))) 53 | "[Cyc] Return all valid constants with PREFIX as a prefix of their name. 54 | When CASE-SENSITIVE? is non-NIL, the comparison is done in a case-sensitive fashion. 55 | When EXACT-LENGTH? is non-NIL, the prefix must be the entire string. 56 | Optionally the START and END character positions can be specified, such that the PREFIX matches characters between the START and END range. 57 | If no constant exists, return NIL." 58 | (if (hl-access-remote?) 59 | (missing-larkc 29537) 60 | (kb-constant-complete-internal prefix case-sensitive? exact-length? start end))) 61 | 62 | (defun kb-new-constant-completion-iterator (&optional (forward? t) (buffer-size 1)) 63 | "[Cyc] Returns an iterator for the constants in the constant completion table." 64 | (new-hl-store-iterator (list 'kb-new-constant-completion-iterator-internal (quotify forward?)) 65 | buffer-size)) 66 | -------------------------------------------------------------------------------- /larkc-cycl/constant-completion-low.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | 45 | (defglobal *constant-completion-table* (create-trie t "Constant Completion Table") 46 | "[Cyc] Table for indexing constants by the string for their name.") 47 | 48 | (defparameter *require-valid-constants* t) 49 | 50 | (defun constant-shell-from-name (string) 51 | "[Cyc] Return a constant or constant shell whose name exactly matches STRING." 52 | (declare (string string)) 53 | (trie-exact *constant-completion-table* string t 0 nil)) 54 | 55 | (defun kb-constant-complete-exact-internal (string start end) 56 | (let ((answer (trie-exact *constant-completion-table* string t start end))) 57 | (unless (and (constant-p answer) 58 | *require-valid-constants* 59 | (not (valid-constant-handle-p answer))) 60 | answer))) 61 | 62 | (defun kb-constant-complete-internal (prefix case-sensitive? exact-length? start end) 63 | (let ((answer (trie-prefix *constant-completion-table* prefix case-sensitive? exact-length? start end))) 64 | (if *require-valid-constants* 65 | (delete-if #'invalid-constant-handle answer) 66 | answer))) 67 | 68 | (defun add-constant-to-completions (constant string) 69 | "[Cyc] Add CONSTANT to the completions table under the name STRING." 70 | (declare (constant constant) 71 | (string string)) 72 | (trie-insert *constant-completion-table* string constant) 73 | constant) 74 | 75 | (defun remove-constant-from-completions (constant string) 76 | (declare (constant constant) 77 | (string string)) 78 | (trie-remove *constant-completion-table* string constant) 79 | constant) 80 | 81 | (defun kb-new-constant-completion-iterator-internal (&optional (forward? t)) 82 | (new-trie-iterator *constant-completion-table* forward?)) 83 | -------------------------------------------------------------------------------- /larkc-cycl/constant-completion.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | ;; No macro declarations in original 44 | 45 | (defglobal *constant-names-in-code* nil) 46 | (defglobal *bogus-constant-names-in-code* nil) 47 | 48 | (defun initialize-constant-names-in-code () 49 | (when (zerop (constant-count)) 50 | (setf *constant-names-in-code* nil) 51 | (dolist (invalid-constant-name (invalid-constant-names)) 52 | (push invalid-constant-name *constant-names-in-code*))) 53 | (length *constant-names-in-code*)) 54 | 55 | (defun compute-bogus-constant-names-in-code () 56 | (when *constant-names-in-code* 57 | (noting-progress ("Computing bogus constant names in code...") 58 | (setf *bogus-constant-names-in-code* nil) 59 | (dolist (name *constant-names-in-code*) 60 | (when (uninstalled-constant-p (find-constant name)) 61 | (push name *bogus-constant-names-in-code*))) 62 | (setf *bogus-constant-names-in-code* (sort *bogus-constant-names-in-code* #'string<)))) 63 | (length *bogus-constant-names-in-code*)) 64 | 65 | -------------------------------------------------------------------------------- /larkc-cycl/constant-index-manager.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | 40 | (defglobal *constant-index-manager* :uninitialized 41 | "[Cyc] The KB object manager for constant indices.") 42 | 43 | (deflexical *constant-index-lru-size-percentage* 16 44 | "[Cyc] Based on arete experiments, only 16% of all constants are touched during normal inference, so we'll make a conservative guess that every one of those touched the constant's index.") 45 | 46 | (defun setup-constant-index-table (size exact?) 47 | (setf *constant-index-manager* (new-kb-object-manager "constant-index" 48 | size 49 | *constant-index-lru-size-percentage* 50 | #'load-constant-index-from-cache 51 | exact?))) 52 | 53 | (defun* cached-constant-index-count () (:inline t) 54 | "[Cyc] Return the number of constant-indices whose content is cached in memory." 55 | (cached-kb-object-count *constant-index-manager*)) 56 | 57 | (defun* lookup-constant-index (id) (:inline t) 58 | (lookup-kb-object-content *constant-index-manager* id)) 59 | 60 | (defun register-constant-index (id constant-index) 61 | "[Cyc] Note that ID will be used as the id for CONSTANT-INDEX." 62 | (register-kb-object-content *constant-index-manager* id constant-index)) 63 | 64 | (defun deregister-constant-index (id) 65 | (deregister-kb-object-content *constant-index-manager* id)) 66 | 67 | (deflexical *permanently-cached-constant-indices* (list #$isa 68 | #$genls) 69 | "[Cyc] We never want to swap out the indices of these constants.") 70 | 71 | (defun mark-constant-index-as-permanently-cached (id) 72 | "[Cyc] Firstly make sure it's swapped in. Then make sure it won't ever get swapped out." 73 | (lookup-constant-index id) 74 | (mark-constant-index-as-muted id)) 75 | 76 | (defun swap-out-all-pristine-constant-indices () 77 | (swap-out-all-pristine-kb-objects-int *constant-index-manager*)) 78 | 79 | (defun initialize-constant-index-hl-store-cache () 80 | (prog1 (initialize-kb-object-hl-store-cache *constant-index-manager* 81 | "indices" 82 | "indices-index") 83 | (dolist (constant *permanently-cached-constant-indices*) 84 | (mark-constant-index-as-permanently-cached (constant-suid constant))))) 85 | -------------------------------------------------------------------------------- /larkc-cycl/constant-reader.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | ;; Clyc hoists this file up earlier in the load order, so that the #$ is available everywhere. 45 | ;; This also splits up the behavior between read-time capturing of the name, and macro-expansion time resolving of the name, which defers this code from needing its dependencies compiled in. 46 | 47 | ;; Initial external dependencies: 48 | ;; simple-reader-error 49 | ;; valid-constant-name-char-p 50 | ;; *read-suppress* 51 | ;; reader-make-constant-shell 52 | ;; *read-require-constant-exists* 53 | ;; constant-complete-exact-name 54 | ;; find-invalid-constant 55 | 56 | (defconstant *constant-reader-macro-char* #\$ 57 | "[Cyc] The character that signals the reader that what follows is to be treated as a CycL constant name.") 58 | 59 | (defun constant-reader-macro-char () 60 | "[Cyc] Returns the character that signals the reader that what follows is to be treated as a CycL constant name." 61 | *constant-reader-macro-char*) 62 | 63 | (defconstant *constant-reader-prefix* (format nil "#~c" *constant-reader-macro-char*) 64 | "[Cyc] The string that prefixes all CycL constant names") 65 | 66 | (declaim (inline stream-forbids-constant-creation)) 67 | (defun stream-forbids-constant-creation (stream) 68 | "[Cyc] Return T iff STREAM forbids the creation of constant shells for unknown constants." 69 | (declare (ignore stream)) 70 | ;; TODO DESIGN - surely some test should happen on the stream. Differentiate fundamental .lisp code from user streams. 71 | *read-require-constant-exists*) 72 | 73 | ;; TODO DESIGN - Compile-time side effects, like filling in the trie of constant names, do not get saved through to load time. The biggest issue is that we can't easily use #$ in the fundamental source code to define constants at compile-time with this setup, although it would work for interactive use after the system is up and running. For now, constants will be resolved at runtime. Later, we could try performing existence checks at load-time, but we have to ensure that the world has been loaded first. 74 | (defun sharpsign-dollar-rmf (stream ch arg) 75 | (when arg 76 | (simple-reader-error "The ~s reader macro does not take an argument." ch)) 77 | (let ((buffer (make-array '(64) :element-type 'character :adjustable t :fill-pointer 0))) 78 | (loop for next = (peek-char nil stream nil nil) 79 | while (and next (valid-constant-name-char-p next)) 80 | do (vector-push-extend (read-char stream) buffer)) 81 | (if *read-suppress* 82 | (values nil t) 83 | (let* (;; Copy from adjustable vector to a plain one 84 | (name (subseq buffer 0))) 85 | (values (or (reader-make-constant-shell name 86 | (not (stream-forbids-constant-creation stream))) 87 | (error "~s is not an existing constant" name)) 88 | t))))) 89 | 90 | (defun find-constant-by-name (name) 91 | (let ((constant (let ((*require-valid-constants* nil)) 92 | (constant-complete-exact name)))) 93 | (or constant 94 | (find-invalid-constant name)))) 95 | 96 | ;; Make a contained readtable, instead of mutating the global one 97 | '(named-readtables:defreadtable clyc 98 | (:merge :standard) 99 | (:dispatch-macro-char #\# *constant-reader-macro-char* #'sharpsign-dollar-rmf)) 100 | 101 | ;; TODO HACK - remove this later, use the named-readtable instead to scope subl-ish code 102 | 103 | (set-dispatch-macro-character #\# #\$ #'sharpsign-dollar-rmf) 104 | 105 | 106 | (defmethod make-load-form ((obj constant) &optional environment) 107 | (declare (ignore environment)) 108 | "Common Lisp support for constant literals in source code." 109 | ;; This is always allowed to create constants? 110 | `(reader-make-constant-shell ,(c-name obj) t)) 111 | 112 | -------------------------------------------------------------------------------- /larkc-cycl/constants-interface.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | (defun kb-create-constant (name external-id) 45 | "[Cyc] Return a new constant named NAME with EXTERNAL-ID. 46 | If NAME is :UNNAMED, returns a constant with no name." 47 | (define-hl-modifier-preamble) 48 | (note-hl-modifier-invocation 'kb-create-constant name external-id) 49 | (when (hl-modify-anywhere?) 50 | (bt:with-lock-held (*hl-lock*) 51 | (prog1 (if (hl-modify-remote?) 52 | (missing-larkc 32155) 53 | (kb-create-constant-local name external-id)) 54 | (define-hl-modifier-postamble))))) 55 | 56 | (defun kb-create-constant-local (name external-id) 57 | (find-constant-by-internal-id (kb-create-constant-kb-store name external-id))) 58 | 59 | (defun kb-remove-constant (constant) 60 | "[Cyc] Remove CONSTANT from the KB." 61 | (let ((result nil)) 62 | (define-hl-modifier-preamble) 63 | (note-hl-modifier-invocation 'kb-remove-constant constant) 64 | (when (hl-modify-remote?) 65 | (setf result (missing-larkc 29543))) 66 | (if (hl-modify-local?) 67 | (let ((*override-hl-store-remote-access?* t)) 68 | (bt:with-lock-held (*hl-lock*) 69 | (kb-remove-constant-internal constant))) 70 | result))) 71 | 72 | (defun kb-lookup-constant-by-name (name) 73 | "[Cyc] Return the constant named NAME, if it exists. Return NIL otherwise." 74 | (if (hl-access-remote?) 75 | (missing-larkc 29544) 76 | (constant-shell-from-name name))) 77 | 78 | (defun kb-constant-name (constant) 79 | "[Cyc] Return the name for CONSTANT." 80 | (if (hl-access-remote?) 81 | (missing-larkc 29545) 82 | (constant-name-internal constant))) 83 | 84 | (defun kb-lookup-constant-by-guid (guid) 85 | "[Cyc] Return the constant with GUID, if it exists. Return NIL otherwise." 86 | (if (hl-access-remote?) 87 | (missing-larkc 29546) 88 | (lookup-constant-by-guid guid))) 89 | 90 | (defun kb-constant-guid (constant) 91 | "[Cyc] Return the external ID for CONSTANT." 92 | (if (hl-access-remote?) 93 | (missing-larkc 29548) 94 | (constant-merged-guid-internal constant))) 95 | 96 | (defun kb-rename-constant (constant new-name) 97 | "[Cyc] Rename CONSTANT to have NEW-NAME as its name. The constant is returned." 98 | (let ((result nil)) 99 | (define-hl-modifier-preamble) 100 | (note-hl-modifier-invocation 'kb-rename-constant constant new-name) 101 | (when (hl-modify-remote?) 102 | (setf result (missing-larkc 29549))) 103 | (if (hl-modify-local?) 104 | (let ((*override-hl-store-remote-access?* t)) 105 | (bt:with-lock-held (*hl-lock*) 106 | ;; TODO - this was stored to an unused variable, "old_name" 107 | (constant-name constant) 108 | (kb-rename-constant-internal constant new-name))) 109 | result))) 110 | 111 | -------------------------------------------------------------------------------- /larkc-cycl/cyc-revision-extraction.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | (defun extract-cyc-revision-string (raw-revision-string) 45 | (let* ((first-space (position #\Space raw-revision-string)) 46 | (second-space (and first-space 47 | (position #\Space raw-revision-string :start (incf first-space))))) 48 | (when second-space 49 | (subseq raw-revision-string first-space second-space)))) 50 | 51 | (defun extract-cyc-revision-numbers (revision-string &optional (system-version 10)) 52 | (when (stringp revision-string) 53 | (let ((start 0) 54 | (period (position #\. revision-string)) 55 | (numbers nil)) 56 | (loop while start 57 | do (let ((integer (ignore-errors (read-from-string revision-string nil nil :start start :end period)))) 58 | (when integer 59 | (push integer numbers)) 60 | (if period 61 | (setf start (1+ period) 62 | period (position #\. revision-string :start start)) 63 | (return)))) 64 | (setf numbers (nreverse numbers)) 65 | (if (= 1 (length numbers)) 66 | (cons system-version numbers) 67 | numbers)))) 68 | 69 | (defun construct-cyc-revision-string-from-numbers (revision-numbers) 70 | (format nil "~{~a~^.~}" revision-numbers)) 71 | 72 | -------------------------------------------------------------------------------- /larkc-cycl/deck.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | ;; No macros declared 45 | 46 | (defstruct deck 47 | type 48 | data) 49 | 50 | (defun create-deck (type) 51 | "[Cyc] Return a new, empty deck." 52 | (make-deck :type type 53 | :data (case type 54 | (:queue (create-queue)) 55 | (:stack (create-stack))))) 56 | 57 | (defun clear-deck (deck) 58 | "[Cyc] Clear DECK and return it." 59 | (setf (deck-data deck) (case (deck-type deck) 60 | (:queue (create-queue)) 61 | (:stack (create-stack)))) 62 | deck) 63 | 64 | (defun deck-empty-p (deck) 65 | "[Cyc] Return T iff DECK is empty." 66 | (case (deck-type deck) 67 | (:queue (queue-empty-p (deck-data deck))) 68 | (:stack (stack-empty-p (deck-data deck))))) 69 | 70 | (defun deck-push (elt deck) 71 | "[Cyc] Add an element ELT to DECK. Returns DECK." 72 | (case (deck-type deck) 73 | (:queue (enqueue elt (deck-data deck))) 74 | (:stack (stack-push elt (deck-data deck)))) 75 | deck) 76 | 77 | (defun deck-pop (deck) 78 | "[Cyc] Remove and return the next accessible element from DECK." 79 | (case (deck-type deck) 80 | (:queue (dequeue (deck-data deck))) 81 | (:stack (stack-pop (deck-data deck))))) 82 | 83 | 84 | -------------------------------------------------------------------------------- /larkc-cycl/deduction-handles.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | 40 | (defglobal *deduction-from-id* nil 41 | "[Cyc] The ID -> DEDUCTION mapping table.") 42 | 43 | (defun* do-deductions-table () (:inline t) 44 | *deduction-from-id*) 45 | 46 | (defun setup-deduction-table (size exact?) 47 | (declare (ignore exact?)) 48 | (unless *deduction-from-id* 49 | (setf *deduction-from-id* (new-id-index size 0)))) 50 | 51 | (defun finalize-deductions (&optional max-deduction-id) 52 | (set-next-deduction-id max-deduction-id) 53 | (unless max-deduction-id 54 | (missing-larkc 30888))) 55 | 56 | (defun clear-deduction-table () 57 | (clear-id-index *deduction-from-id*)) 58 | 59 | (defun deduction-count () 60 | "[Cyc] Return the total number of deductions." 61 | (let ((index *deduction-from-id*)) 62 | (if index 63 | (id-index-count index) 64 | 0))) 65 | 66 | (defun* lookup-deduction (id) (:inline t) 67 | (id-index-lookup *deduction-from-id* id)) 68 | 69 | (defun set-next-deduction-id (&optional max-deduction-id) 70 | (let ((next-id (1+ (or max-deduction-id 71 | (let ((max -1)) 72 | (do-id-index (id deduction *deduction-from-id* 73 | :progress-message "Determining maximum deduction ID.") 74 | (setf max (max max id))) 75 | max))))) 76 | (set-id-index-next-id *deduction-from-id* next-id) 77 | next-id)) 78 | 79 | (defun register-deduction-id (deduction id) 80 | "[Cyc] Note that ID will eb used as the id for DEDUCTION." 81 | (reset-deduction-id deduction id) 82 | (id-index-enter *deduction-from-id* id deduction)) 83 | 84 | (defun deregister-deduction-id (id) 85 | "[Cyc] Note that ID is not in use as a deduction id." 86 | (id-index-remove *deduction-from-id* id)) 87 | 88 | (defun* make-deduction-id () (:inline t) 89 | "[Cyc] Return a new integer id for a deduction." 90 | (id-index-reserve *deduction-from-id*)) 91 | 92 | (defstruct (deduction (:conc-name "D-")) 93 | id) 94 | 95 | (defmethod sxhash ((object deduction)) 96 | (let ((id (d-id object))) 97 | (or id 786))) 98 | 99 | (defun* get-deduction () (:inline t) 100 | "[Cyc] Make a new deduction shell, potentially in static space." 101 | (make-deduction)) 102 | 103 | (defun free-deduction (deduction) 104 | "[Cyc] Invalidate DEDUCTION." 105 | (setf (d-id deduction) nil)) 106 | 107 | (defun valid-deduction-handle? (object) 108 | (and (deduction-p object) 109 | (deduction-handle-valid? object))) 110 | 111 | (defun* valid-deduction (deduction &optional robust?) (:inline t) 112 | (valid-deduction? deduction robust?)) 113 | 114 | (defun valid-deduction? (deduction &optional robust?) 115 | (if (valid-deduction-handle? deduction) 116 | (or (not robust?) 117 | (let ((supports (deduction-supports deduction))) 118 | (and (valid-support? (deduction-assertion deduction)) 119 | (consp supports) 120 | (every-in-list #'valid-support? supports)))))) 121 | 122 | (defun make-deduction-shell (&optional id) 123 | (unless id 124 | (setf id (make-deduction-id))) 125 | (let ((deduction (get-deduction))) 126 | (register-deduction-id deduction id) 127 | deduction)) 128 | 129 | (defun* create-sample-invalid-deduction () (:inline t) 130 | (get-deduction)) 131 | 132 | (defun free-all-deductions () 133 | (do-id-index (id deduction (do-deductions-table) 134 | :progress-message "Freeing deductions") 135 | (free-deduction deduction)) 136 | (clear-deduction-table) 137 | (clear-deduction-content-table)) 138 | 139 | (defun* deduction-id (deduction) (:inline t) 140 | "[Cyc] Return the id of DEDUCTION." 141 | (d-id deduction)) 142 | 143 | (defun reset-deduction-id (deduction new-id) 144 | "[Cyc] Primitively change the id of DEDUCTION to NEW-ID." 145 | (setf (d-id deduction) new-id)) 146 | 147 | (defun* deduction-valid-handle? (deduction) (:inline t) 148 | ;; TODO - original checked for integerp 149 | (d-id deduction)) 150 | 151 | (defun* find-deduction-by-id (id) (:inline t) 152 | (lookup-deduction id)) 153 | 154 | -------------------------------------------------------------------------------- /larkc-cycl/deduction-manager.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | (defglobal *deduction-content-manager* :uninitialized 40 | "[Cyc] The KB object manager for deductions.") 41 | 42 | (deflexical *deduction-lru-size-percentage* 8 43 | "[Cyc] This is a guess based on *ASSERTION-LRU-SIZE-PERCENTAGE*.") 44 | 45 | (defun setup-deduction-content-tagle (size exact?) 46 | (setf *deduction-content-manager* (new-kb-object-manager "deduction" size *deduction-lru-size-percentage* 47 | #'load-deduction-def-from-cache exact? ))) 48 | 49 | (defun clear-deduction-content-table () 50 | (clear-kb-object-content-table *deduction-content-manager*)) 51 | 52 | (defun* cached-deduction-count () (:inline t) 53 | "[Cyc] Return the number of deductions whose content is cached in memory." 54 | (cached-kb-object-count *deduction-content-manager*)) 55 | 56 | (defun* deduction-content-completely-cached? () (:inline t) 57 | (= (deduction-count) (cached-deduction-count))) 58 | 59 | (defun* lookup-deduction-content (id) (:inline t) 60 | (lookup-kb-object-content *deduction-content-manager* id)) 61 | 62 | (defun* register-deduction-content (id deduction-content) (:inline t) 63 | "[Cyc] Note that ID will be used as the id for DEDUCTION-CONTENT." 64 | (register-kb-object-content *deduction-content-manager* id deduction-content)) 65 | 66 | (defun* deregister-deduction-content (id) (:inline t) 67 | "[Cyc] Note that ID is not in use as a NART id, i.e. points to no hl-formula." 68 | (deregister-kb-object-content *deduction-content-manager* id)) 69 | 70 | (defun* mark-deduction-content-as-muted (id) (:inline t) 71 | (mark-kb-object-content-as-muted *deduction-content-manager* id)) 72 | 73 | (defun swap-out-all-pristine-deductions () 74 | (swap-out-all-pristine-kb-objects-int *deduction-content-manager*)) 75 | 76 | (defun initialize-deduction-hl-store-cache () 77 | (initialize-kb-object-hl-store-cache *deduction-content-manager* 78 | "deduction" 79 | "deduction-index")) 80 | -------------------------------------------------------------------------------- /larkc-cycl/deductions-high.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | (defun* create-deduction-spec (supports) (:inline t) 40 | (cons :deduction (canonicalize-supports supports t))) 41 | 42 | (defun* deduction-spec-supports (deduction-spec) (:inline t) 43 | "[Cyc] Returns the list of supports specified by DEDUCTION-SPEC." 44 | (cdr deduction-spec)) 45 | 46 | (defun create-deduction-with-tv (assertion supports tv) 47 | (prog1-let ((deduction (create-deduction assertion supports (tv-truth tv)))) 48 | (set-deduction-strength deduction (tv-strength tv)))) 49 | 50 | (defun create-deduction-for-hl-support (hl-support justification) 51 | (create-deduction-with-tv hl-support 52 | justification 53 | (hl-support-tv hl-support))) 54 | 55 | (defun* create-deduction (assertion supports truth) (:inline t) 56 | (kb-create-deduction assertion supports truth)) 57 | 58 | (defun* remove-deduction (deduction) (:inline t) 59 | (kb-remove-deduction deduction)) 60 | 61 | (defun* set-deduction-strength (deduction new-strength) (:inline t) 62 | (kb-set-deduction-strength deduction new-strength)) 63 | 64 | (defun* find-deduction (assertion supports &optional (truth :true)) (:inline t) 65 | "[Cyc] Find the deduction that justifies ASSERTION via SUPPORTS having TRUTH. 66 | Return NIL if not present." 67 | (kb-lookup-deduction assertion supports truth)) 68 | 69 | (defun deduction-supports-equal (supports1 supports2) 70 | ;; TODO - could create a LENGTH-SAME helper function that doesn't bother with numeric length at all. 71 | (and (length= supports1 (length supports2)) 72 | (sets-equal? supports1 supports2 #'support-equal))) 73 | 74 | (defun* deduction-assertion (deduction) (:inline t) 75 | "[Cyc] Return the support for which DEDUCTION is a deduction." 76 | (and (deduction-handle-valid? deduction) 77 | (kb-deduction-assertion deduction))) 78 | 79 | (defun deduction-truth (deduction) 80 | "[Cyc] Return the truth of DEDUCTION -- either :TRUE or :FALSE or :UNKNOWN." 81 | (if (deduction-handle-valid? deduction) 82 | (kb-deduction-truth deduction) 83 | :unknown)) 84 | 85 | (defun deduction-strength (deduction) 86 | (and (deduction-handle-valid? deduction) 87 | (possibly-unreify-kb-hl-supports (kb-deduction-supports deduction)))) 88 | 89 | (defparameter *deduction-dump-id-table* nil) 90 | 91 | (defun* find-deduction-by-dump-id (dump-id) (:inline t) 92 | (find-deduction-by-id dump-id)) 93 | -------------------------------------------------------------------------------- /larkc-cycl/deductions-interface.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | 40 | (define-hl-creator kb-create-deduction (assertion supports truth) 41 | "[Cyc] Create a new deduction consisting of SUPPORTS for ASSERTION. 42 | TRUTH is the truth value of the deduction. 43 | Hook up the indexing for the new deduction." 44 | nil 45 | (if (hl-modify-remote?) 46 | (missing-larkc 32156) 47 | (kb-create-deduction-local assertion supports truth))) 48 | 49 | (defun kb-create-deduction-local (assertion supports truth) 50 | (let ((internal-id (create-deduction-kb-store assertion supports truth))) 51 | (find-deduction-by-id internal-id))) 52 | 53 | (define-hl-modifier kb-remove-deduction (deduction) 54 | "[Cyc] Remove DEDUCTION from the KB, and unhook its indexing." 55 | nil 56 | (remove-deduction-dependents deduction) 57 | (let ((deduction-assertion (deduction-assertion deduction))) 58 | (cond 59 | ((assertion-p deduction-assertion) 60 | (when (valid-assertion? deduction-assertion) 61 | (remove-assertion-argument deduction-assertion deduction))) 62 | ((hl-support-p deduction-assertion) 63 | (let ((kb-hl-support (find-kb-hl-support deduction-assertion))) 64 | (when kb-hl-support 65 | (missing-larkc 11044))))) 66 | (kb-remove-deduction-internal deduction))) 67 | 68 | ;; Reusing helper macro from assertions-interface 69 | 70 | (define-kb-non-remote lookup-deduction (assertion supports truth) 71 | "[Cyc] Return the deduction with ASSERTION, SUPPORTS, and TRUTH, if it exists. Return NIL otherwise." 72 | find-deduction-internal) 73 | 74 | (define-kb-non-remote deduction-assertion (deduction) 75 | "[Cyc] Return the assertion for DEDUCTION.") 76 | 77 | (define-kb-non-remote deduction-supports (deduction) 78 | "[Cyc] Return the supports for DEDUCTION.") 79 | 80 | (define-kb-non-remote deduction-truth (deduction) 81 | "[Cyc] Return the truth for DEDUCTION.") 82 | 83 | (define-kb-non-remote deduction-strength (deduction) 84 | "[Cyc] Return the strength for DEDUCTION.") 85 | 86 | (define-hl-modifier kb-set-deduction-strength (deduction new-strength) 87 | "[Cyc] Change the strength of DEDUCTION to NEW-STRENGTH." 88 | nil 89 | (kb-set-deduction-strength-internal deduction new-strength)) 90 | 91 | 92 | -------------------------------------------------------------------------------- /larkc-cycl/el-grammar.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | 40 | (defun el-non-formula-sentence-p (sentence) 41 | "[Cyc] Returns T iff SENTENCE is an EL sentence, but not an EL formula. 42 | currently (11/9/99) the only such animals are #$True, #$False, and EL variables." 43 | (and (el-formula-p sentence) 44 | (missing-larkc 6562))) 45 | 46 | (defun el-literal-p (object) 47 | "[Cyc] Like CYCL-LITERAL-P except it only permits EL constructs." 48 | (let ((*grammar-permits-hl?* nil)) 49 | (cycl-literal-p object))) 50 | -------------------------------------------------------------------------------- /larkc-cycl/enumeration-types.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | 45 | (defconstant *valid-directions* '(:backward :forward :code)) 46 | 47 | (declaim (inline valid-directions)) 48 | (defun valid-directions () 49 | *valid-directions*) 50 | 51 | (defun direction-p (object) 52 | "[Cyc] Return T iff OBJECT is a valid assertion inference direction 53 | :backward :forward or :code." 54 | (member-eq? object *valid-directions*)) 55 | 56 | (defun encode-direction (direction) 57 | (position direction *valid-directions*)) 58 | 59 | (defun decode-direction (fixnum) 60 | (nth fixnum *valid-directions*)) 61 | 62 | (defconstant *valid-assertion-types* '(:gaf :rule)) 63 | (defconstant *valid-el-strengths* '(:default :monotonic)) 64 | 65 | (defun el-strength-p (object) 66 | "[Cyc] Return T iff OBJECT is a valid CycL assertion strength 67 | :default or :monotonic." 68 | (member-eq? object *valid-el-strengths*)) 69 | 70 | (defun el-strength-implies (strength1 strength2) 71 | "[Cyc] Return T iff STRENGTH2 is subsumed by STRENGTH1" 72 | (not (position-< strength1 strength2 *valid-el-strengths*))) 73 | 74 | (defconstant *valid-truths* '(:true :unknown :false)) 75 | (defun valid-truths () 76 | *valid-truths*) 77 | 78 | (defun truth-sense (truth) 79 | (case truth 80 | (:true :pos) 81 | (:false :neg) 82 | (:unknown :neg) 83 | (otherwise (error "~s is not a TRUTH-P" truth)))) 84 | 85 | (defconstant *valid-senses* '(:neg :pos)) 86 | 87 | (defun sense-p (object) 88 | "[Cyc] Return T iff OBJECT is a valid CycL literal sense 89 | :neg or :pos." 90 | (member-eq object *valid-senses*)) 91 | 92 | (defun inverse-sense (sense) 93 | (case sense 94 | (:pos :neg) 95 | (:neg :pos) 96 | (otherwise (error "~s is not a SENSE-P" sense)))) 97 | 98 | (defun sense-truth (sense) 99 | (case sense 100 | (:pos :true) 101 | (:neg :false) 102 | (otherwise (error "~s is not a SENSE-P" sense)))) 103 | 104 | (defconstant *valid-hl-truth-values* '(:true-mon :true-def :unknown :false-def :false-mon)) 105 | (defun valid-hl-truth-values () 106 | *valid-hl-truth-values*) 107 | 108 | (defun encode-tv (tv) 109 | (position tv *valid-hl-truth-values*)) 110 | 111 | (defun decode-tv (fixnum) 112 | (nth fixnum *valid-hl-truth-values*)) 113 | 114 | (defun tv-strength (tv) 115 | (case tv 116 | (:true-def :default) 117 | (:true-mon :monotonic) 118 | (:false-def :default) 119 | (:false-mon :monotonic) 120 | (:unknown :default) 121 | (otherwise (error "~s does not satisfy TV-P" tv)))) 122 | 123 | (defun tv-truth (tv) 124 | (case tv 125 | (:true-def :true) 126 | (:true-mon :true) 127 | (:false-def :false) 128 | (:false-mon :false) 129 | (:unknown :unknown) 130 | (otherwise (error "~s does not satisfy TV-P" tv)))) 131 | 132 | (defun tv-from-truth-strength (truth strength) 133 | (case truth 134 | (:true (case strength 135 | (:default :true-def) 136 | (:monotonic :true-mon) 137 | (otherwise (error "~s is not a STRENGTH-P" strength)))) 138 | (:false (case strength 139 | (:default :false-def) 140 | (:monotonic :false-mon) 141 | (otherwise (error "~s is not a STRENGTH-P" strength)))) 142 | (:unknown :unknown) 143 | (otherwise (error "~s is not a TRUTH-P" truth)))) 144 | 145 | (defconstant *term-args* '(1 2 0 :neg :pos 3 4 5 :ist :other)) 146 | -------------------------------------------------------------------------------- /larkc-cycl/eval-in-api.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | ;; TODO DESIGN - setting this to T is not supported 45 | (defvar *eval-in-api?* nil 46 | "[Cyc] Process all API commands using a SubL interpreter which validates API function calls.") 47 | 48 | (defun cyc-api-eval (api-request) 49 | "[Cyc] Evaluate API-REQUEST under the evaluation assumptions of the CYC-API server" 50 | (if *eval-in-api?* 51 | (missing-larkc 10828) 52 | (eval-in-api-subl-eval api-request))) 53 | 54 | (defun possibly-cyc-eval (api-request) 55 | "[Cyc] Call EVAL on API-REQUEST. 56 | Functions defined via the Cyc API are also supported." 57 | (if *eval-in-api?* 58 | (missing-larkc 10829) 59 | (eval api-request))) 60 | 61 | (defun possibly-cyc-api-function-spec-p (object) 62 | "[Cyc] Return T iff OBJECT is suitable for FUNCALL. 63 | Functions defined via the Cyc API are also supported." 64 | (or (function-spec-p object) 65 | (and (symbolp object) 66 | (api-function-p object)))) 67 | 68 | (defun possibly-cyc-api-funcall (func &rest args) 69 | "[Cyc] Funcall FUNC on ARGS. 70 | Functions defined via the Cyc API are also supported." 71 | ;; Note that the original had fixed arity funcall-1, funcall-2, etc 72 | (if (function-spec-p func) 73 | (apply func args) 74 | (cyc-api-eval (cons func (mapcar #'quotify args))))) 75 | 76 | (defglobal *eval-in-api-mutable-global* nil) 77 | 78 | (defun register-api-mutable-global (var) 79 | (push var *eval-in-api-mutable-global*) 80 | var) 81 | 82 | (defglobal *eval-in-api-immutable-global* nil) 83 | 84 | (defun register-api-immutable-global (var) 85 | (push var *eval-in-api-immutable-global*) 86 | var) 87 | 88 | (defparameter *eval-in-api-env* nil 89 | "[Cyc] The association list of API variables and bound values.") 90 | (defglobal *api-special-verify-table* (make-hash-table :test #'eq)) 91 | 92 | (defun register-api-special-verify (operator handler) 93 | (setf (gethash operator *api-special-verify-table*) handler) 94 | operator) 95 | 96 | (defglobal *api-function-table* (make-hash-table :test #'eq)) 97 | 98 | (defun api-function-p (operator) 99 | (gethash operator *api-function-table*)) 100 | 101 | (defglobal *api-macro-table* (make-hash-table :test #'eq)) 102 | (defglobal *subl-eval-method* 'eval) 103 | 104 | (defun eval-in-api-subl-eval (form) 105 | "[Cyc] Trampoline to EVAL from within EVAL-IN-API" 106 | ;; TODO - this is defined in Eval.Java, but nothing seems to use it. Probably configures how full SubL runs EVAL, especially if there are EVAL forms inside FORM. 107 | ;;(let ((*evaluator-method* *subl-eval-method*))) 108 | (funcall *subl-eval-method* form)) 109 | 110 | (defparameter *eval-in-api-traced-fns* nil 111 | "[Cyc] The lsit of functions to be traced.") 112 | (defparameter *eval-in-api-trace-log* nil 113 | "[Cyc] The log of trace events.") 114 | 115 | (defun initialize-eval-in-api-env () 116 | nil) 117 | 118 | (defparameter *eval-in-api-level* -1 119 | "[Cyc] Indicates top level evaluation when value equals 0.") 120 | (defparameter *eval-in-api-function-level* -1 121 | "[Cyc] Indicates function level for diagnostic trace output.") 122 | (defparameter *eval-in-api-macro-stack* nil 123 | "[Cyc] The stack of macros that we're currently evalling in the context of.") 124 | (defparameter *verify-in-api-verbose-mode?* nil) 125 | (defparameter *verify-in-api-bound-symbols* nil 126 | "[Cyc] A list of the symbols introduced in the form being verified.") 127 | (defparameter *verify-in-api-fbound-symbols* nil 128 | "[Cyc] A list of the function symbols introduced in the form being verified.") 129 | (defparameter *verify-in-api-macro-stack* nil 130 | "[Cyc] The stack of macros that we're currently verifying in the context of.") 131 | (deflexical *api-user-variables* nil 132 | "[Cyc] The dictionary of persistent api user variables and values.") 133 | -------------------------------------------------------------------------------- /larkc-cycl/file-vector.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | 40 | #| 41 | A fvector is saved over 2 files: 42 | 43 | The index file holds 4-byte offset pointers into the data stream. 44 | The data stream is a concatenation of presumably arbitrary-length binary items. 45 | 46 | This seems limited to holding a bit over 4GiB of data. 47 | 48 | Reads are performed by having this position the data-stream to the selected index, and then using external cfasl stuff on the data-stream. 49 | Unfortunately, writing seems to be missing-larkc. 50 | 51 | Presumably, data items are mutated by appending the end of the data stream if they don't fit in the prior value's footprint, then updating the index entry to point to it. However, this would require eventual vacuuming. 52 | 53 | Hmm, there doesn't seem to be any place in the struct or index file to hold the footprint of the prior object, so it would actually have to be incompatibly reworked to add that in somehow. But an append-only system would function without issue. 54 | 55 | |# 56 | 57 | 58 | (defstruct fvector 59 | data-stream 60 | index-stream) 61 | 62 | (defun* get-file-vector-data-stream (fvector) (:inline t) 63 | (fvector-data-stream fvector)) 64 | 65 | (defun new-fvector (data-stream index-stream) 66 | (make-fvector :data-stream data-stream 67 | :index-stream index-stream)) 68 | 69 | (defun file-vector-p (object) 70 | "[Cyc] Return T iff OBJECT is a FILE-VECTOR datastructure." 71 | (fvector-p object)) 72 | 73 | (defun new-file-vector (data-filename index-filename &optional (direction :input)) 74 | (with-open-file (data-stream data-filename :element-type '(unsigned-byte 8) 75 | :direction direction) 76 | (with-open-file (index-stream index-filename :element-type '(unsigned-byte 8) 77 | :direction direction) 78 | (create-file-vector data-stream index-stream)))) 79 | 80 | (defun create-file-vector (data-stream index-stream) 81 | (new-fvector data-stream index-stream)) 82 | 83 | (defun close-file-vector (fvector) 84 | "[Cyc] Close the streams associated wihth the file vector under question." 85 | (close (fvector-data-stream fvector)) 86 | (close (fvector-index-stream fvector)) 87 | fvector) 88 | 89 | (defun file-vector-length (fvector) 90 | "[Cyc] Return the FIXNUMP number of entries in the file vector." 91 | (fvector-raw-byte-size-to-length (file-length (fvector-index-stream fvector)))) 92 | 93 | (defun file-vector-length-from-index (index-filename) 94 | "[Cyc] A helper function that allows getting the index without allocating the file-vector object." 95 | (unless (probe-file index-filename) 96 | (error "Invalid index filename ~a." index-filename)) 97 | (with-open-file (stream index-filename) 98 | (fvector-raw-byte-size-to-length (file-length stream)))) 99 | 100 | (defun* fvector-raw-byte-size-to-length (bytes) (:inline t) 101 | (declare (fixnum bytes)) 102 | (ash bytes -2)) 103 | 104 | (defun position-file-vector (fvector &optional index) 105 | "[Cyc] Position the data stream of the file vector. If an INDEX is supplied, the data stream is positioned to the data offset stored in the index file for that nth entry. If no index is supplied, it is positioned to th enext value in the index-stream (e.g. in the case of a loop)." 106 | (let ((data-stream (fvector-data-stream fvector))) 107 | (set-file-position data-stream (read-file-vector-index-entry fvector index)) 108 | data-stream)) 109 | 110 | (defun read-file-vector-index-entry (fvector &optional index) 111 | "[Cyc] Fetch a specific entry from the file vector index. move first to the specified INDEX if provided. 112 | Returns the NON-NEGATIVE-INTEGER-P file position in the data stream." 113 | (when index 114 | (position-file-vector fvector index)) 115 | ;; Read big endian, the opposite order of CFASL-INPUT-INTEGER 116 | (read-32bit-be (fvector-index-stream fvector))) 117 | 118 | 119 | 120 | -------------------------------------------------------------------------------- /larkc-cycl/forts.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | (defun* fort-p (object) (:inline t) 45 | "[Cyc] Return T iff OBJECT is a first order reified term (FORT)." 46 | (or (constant-p object) 47 | (nart-p object))) 48 | 49 | (defun* non-fort-p (object) (:inline t) 50 | (not (fort-p object))) 51 | 52 | (defun fort-count () 53 | "[Cyc] Return the total number of FORTs." 54 | (+ (constant-count) (nart-count))) 55 | 56 | (defun reset-fort-index (fort new-index) 57 | "[Cyc] Primitively change the assertion index for FORT to NEW-INDEX." 58 | (if (constant-p fort) 59 | (reset-constant-index fort new-index) 60 | (missing-larkc 208))) 61 | 62 | (defun valid-fort? (fort) 63 | "[Cyc] Return T if FORT is a valid FORT." 64 | (cond 65 | ((constant-p fort) (valid-constant? fort)) 66 | ((nart-p fort) (missing-larkc 30880)) 67 | (t nil))) 68 | 69 | (defun remove-fort (fort) 70 | "[Cyc] Remove FORT from the KB." 71 | (if (constant-p fort) 72 | (missing-larkc 10431))) 73 | 74 | (defstruct fort-id-index 75 | constants 76 | narts) 77 | 78 | (defun new-fort-id-index () 79 | "[Cyc] Constructor" 80 | (make-fort-id-index :constants (new-fort-id-index-constants) 81 | :narts (new-fort-id-index-narts))) 82 | 83 | (defun fort-id-index-lookup (fort-id-index fort) 84 | "[Cyc] Accessor. Returns the object associated with FORT in FORT-ID-INDEX." 85 | (when (valid-fort? fort) 86 | (let ((id-index (if (constant-p fort) 87 | (fort-id-index-constants fort-id-index) 88 | (missing-larkc 23142))) 89 | (id (if (constant-p fort) 90 | (constant-internal-id fort) 91 | (missing-larkc 30869)))) 92 | (id-index-lookup id-index id)))) 93 | 94 | (defun fort-id-index-enter (fort-id-index fort object) 95 | "[Cyc] Modifier. Enter OBJECT in FORT-ID-INDEX as the object associated with FORT." 96 | (when (valid-fort? fort) 97 | (let ((id-index (if (constant-p fort) 98 | (fort-id-index-constants fort-id-index) 99 | (missing-larkc 23143))) 100 | (id (if (constant-p fort) 101 | (constant-internal-id fort) 102 | (missing-larkc 30870)))) 103 | (id-index-enter id-index id object)))) 104 | 105 | (defun fort-id-index-remove (fort-id-index fort) 106 | "[Cyc] Modifier. Remove all FORT associations in FORT-ID-INDEX." 107 | (when (valid-fort? fort) 108 | (let ((id-index (if (constant-p fort) 109 | (fort-id-index-constants fort-id-index) 110 | (missing-larkc 23144))) 111 | (id (if (constant-p fort) 112 | (constant-internal-id fort) 113 | (missing-larkc 30871)))) 114 | (id-index-remove id-index id)))) 115 | 116 | (defun new-fort-id-index-constants () 117 | (new-id-index (new-constant-internal-id-threshold))) 118 | 119 | (defun new-fort-id-index-narts () 120 | (new-id-index (new-nart-id-threshold))) 121 | 122 | (defconstant *cfasl-opcode-fort-id-index* 99) 123 | 124 | (defun cfasl-input-fort-id-index (stream) 125 | (let ((fort-id-index (new-fort-id-index)) 126 | (count (cfasl-input stream))) 127 | (dotimes (i count) 128 | (let ((fort (cfasl-input-object stream)) 129 | (value (cfasl-input-object stream))) 130 | (fort-id-index-enter fort-id-index fort value))) 131 | fort-id-index)) 132 | -------------------------------------------------------------------------------- /larkc-cycl/function-terms.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | 40 | (defun term-of-unit-assertion-p (object) 41 | (when (gaf-assertion? object) 42 | (eq #$termOfUnit (gaf-predicate object)))) 43 | 44 | (defun nat-formula-p (object) 45 | "[Cyc] Return T iff OBJECT could be interpreted as a nat formula." 46 | (possibly-naut-p object)) 47 | 48 | (defun* tou-assertion? (assertion) (:obsolete t) 49 | "[Cyc] Obsolete." 50 | (term-of-unit-assertion-p assertion)) 51 | 52 | (defun term-functional-complexity (object) 53 | "[Cyc] Return the maximum functional nesting depth of OBJECT." 54 | (with-all-mts 55 | (term-functional-complexity-internal object))) 56 | 57 | (defpolymorphic term-functional-complexity-internal (object) 58 | 0) 59 | 60 | (defmethod term-functional-complexity-internal ((object constant)) 61 | 0) 62 | 63 | (defmethod term-functional-complexity-internal ((object nart)) 64 | (missing-larkc 10746)) 65 | 66 | (defmethod term-functional-complexity-internal ((object cons)) 67 | "[Cyc] Fancy way of returning max term functional complexity within a NART." 68 | (destructuring-bind (function &rest args) object 69 | (if (and (fort-p function) 70 | (not (non-predicate-function? function))) 71 | 0 72 | (let ((arg-max-complexity (term-functional-complexity-internal function))) 73 | (dolist (arg args) 74 | (let ((arg-complexity (term-functional-complexity-internal arg))) 75 | (setf arg-max-complexity (max arg-max-complexity arg-complexity)))) 76 | (1+ arg-max-complexity))))) 77 | 78 | ;; TODO - no default implementation, only specialized methods? so defgeneric instead of defpolymorphic for here 79 | (defgeneric term-relational-complexity-internal (object)) 80 | 81 | (defmethod term-relational-complexity-internal ((object constant)) 82 | 0) 83 | 84 | (defmethod term-relational-complexity-internal ((object nart)) 85 | (missing-larkc 10766)) 86 | 87 | (defmethod term-relational-complexity-internal ((object cons)) 88 | (missing-larkc 10764)) 89 | 90 | (defun naut-to-nart (obj) 91 | "[Cyc] If OBJ is a ground NAUT (EL nat), convert it to an HL nart and return it, else return OBJ." 92 | (if (possibly-naut-p obj) 93 | (or (find-nart obj) 94 | obj) 95 | obj)) 96 | -------------------------------------------------------------------------------- /larkc-cycl/graphl-search-vars.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | ;; TODO - this is mostly just a structure, without behavior. See if this is used in larkc, or should be elided for now. 40 | 41 | 42 | (defstruct graphl-search 43 | direction 44 | type 45 | order 46 | cutoff 47 | marking 48 | marking-space 49 | goal-space 50 | goal 51 | goal-fn 52 | goal-found-p 53 | satisfy-fn 54 | map-fn 55 | justify? 56 | add-to-result? 57 | unwind-fn-tobble 58 | result 59 | graph) 60 | 61 | (defun new-graphl-search (plist) 62 | (let ((graphl-search (make-graphl-search))) 63 | ;; TODO - this will work if no initialization parameters are given. The make-graphl-search had a missing-larkc for every slot keyword initializer. 64 | (do-plist (property value plist) 65 | (missing-larkc 31969)) 66 | (possibly-initialize-graphl-marking-spaces graphl-search) 67 | (set-graphl-search-result graphl-search nil) 68 | graphl-search)) 69 | 70 | (defun destroy-graphl-search (graphl-search) 71 | (setf (graphl-search-direction graphl-search) :free) 72 | (setf (graphl-search-marking-space graphl-search) :free) 73 | (setf (graphl-search-result graphl-search) :free) 74 | (setf (graphl-search-graph graphl-search) :free)) 75 | 76 | ;; Renamed getters 77 | (symbol-mapping graphl-direction graphl-search-direction 78 | graphl-order graphl-search-order 79 | graphl-space graphl-search-marking-space 80 | graphl-compute-justify? graphl-search-justify? 81 | graphl-result graphl-search-result) 82 | 83 | (defun graphl-depth-first-search-p (search) 84 | (eq (graphl-order search) :depth-first)) 85 | 86 | ;; Renamed setters 87 | (defun set-graphl-search-type (search type) 88 | (setf (graphl-search-type search) type)) 89 | (defun set-graphl-search-direction (search direction) 90 | (setf (graphl-search-direction search) direction)) 91 | (defun set-graphl-search-order (search order) 92 | (setf (graphl-search-order search) order)) 93 | (defun set-graphl-search-marking (search marking) 94 | (setf (graphl-search-marking search) marking)) 95 | (defun set-graphl-search-marking-space (search marking-space) 96 | (setf (graphl-search-marking-space search) marking-space)) 97 | (defun set-graphl-search-goal (search goal) 98 | (setf (graphl-search-goal search) goal)) 99 | (defun set-graphl-search-goal-found-p (search found-p) 100 | (setf (graphl-search-goal-found-p search) found-p)) 101 | (defun set-graphl-search-justify? (search justify?) 102 | (setf (graphl-search-justify? search) justify?)) 103 | (defun set-graphl-search-result (search result) 104 | (setf (graphl-search-result search) result)) 105 | 106 | (defun possibly-initialize-graphl-marking-spaces (search) 107 | (unless (graphl-search-marking-space search) 108 | (setf (graphl-search-marking-space search) (graphl-instantiate-new-space))) 109 | search) 110 | 111 | (defun* graphl-add-to-result (search addition &optional (test #'eq)) (:inline t) 112 | (pushnew addition (graphl-search-result search) :test test)) 113 | 114 | (deflexical *graphl-search-size* 200) 115 | 116 | (defun* graphl-search-size () (:inline t) 117 | *graphl-search-size*) 118 | 119 | (defun graphl-instantiate-new-space () 120 | (make-hash-table :size (graphl-search-size))) 121 | 122 | (defun* graphl-forward-direction-p (direction) (:inline t) 123 | (eq direction :forward)) 124 | 125 | (defun* determine-graphl-relevant-directions (graphl-direction) (:inline t) 126 | (case graphl-direction 127 | (:accessible '(:forward :backward)) 128 | (:forward '(:forward)) 129 | (:backward '(:backward)))) 130 | 131 | -------------------------------------------------------------------------------- /larkc-cycl/hash-table-utilities.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | (defconstant *valid-hash-test-symbols* '(eq eql equal equalp) 45 | "[Cyc] All function symbols which are permitted tests for hashtable-based algorithms.") 46 | (defconstant *valid-hash-test-functions* (list #'eq #'eql #'equal #'equalp) 47 | "[Cyc] All functions which are permitted test for hashtable-based algorithms.") 48 | 49 | (defun valid-hash-test-symbols () 50 | *valid-hash-test-symbols*) 51 | 52 | (defun hash-test-to-symbol (test) 53 | "[Cyc] Return the symbol form of TEST, which is a valid hash-test function." 54 | (check-type test 'valid-hash-test-p) 55 | (if (symbolp test) 56 | test 57 | (find test *valid-hash-test-symbols* :key #'symbol-function))) 58 | 59 | (defun hash-table-empty-p (table) 60 | "[Cyc] Return T iff TABLE is an empty hashtable" 61 | (zerop (hash-table-count table))) 62 | 63 | (defun rehash (table) 64 | "[Cyc] Rehash every KEY VALUE pair in the hashtable TABLE." 65 | ;; Relying on CL doing a good job on its own 66 | table) 67 | 68 | (defun push-hash (key item table) 69 | (push item (gethash key table))) 70 | 71 | (defun pop-hash (key table) 72 | "[Cyc] Pops off the first element of the value of KEY in TABLE. More precisely, returns the first element of the value of KEY in TABLE, and sets that value to be the rest of itself." 73 | (pop (gethash key table))) 74 | 75 | (defun delete-hash (key item table &optional (test #'eql) (test-key #'identity)) 76 | (setf (gethash key table) 77 | (delete item (gethash key table) :test test :key test-key))) 78 | 79 | (defun hash-table-keys (hash-table) 80 | "[Cyc] Return a list of all the keys of HASH-TABLE." 81 | (loop for key being the hash-key of hash-table 82 | collect key)) 83 | 84 | (defun hash-table-values (hash-table) 85 | (loop for val being the hash-value of hash-table 86 | collect val)) 87 | 88 | -------------------------------------------------------------------------------- /larkc-cycl/hl-modifiers.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | 40 | (defun kb-create-asserted-argument-with-tv (assertion tv) 41 | (kb-create-asserted-argument assertion 42 | (tv-truth tv) 43 | (tv-strength tv))) 44 | 45 | (define-hl-modifier kb-create-asserted-argument (assertion truth strength) 46 | "[Cyc] Create an asserted argument for ASSERTION from TRUTH and STRENGTH, and hook up all the indexing between them." 47 | nil 48 | (let* ((tv (tv-from-truth-strength truth strength)) 49 | (asserted-argument (create-asserted-argument assertion tv))) 50 | (add-new-assertion-argument assertion asserted-argument) 51 | asserted-argument)) 52 | 53 | (define-hl-modifier kb-remove-asserted-argument (assertion asserted-argument) 54 | "[Cyc] Remove ASSERTED-ARGUMENT for ASSERTION." 55 | nil 56 | (set-assertion-asserted-by assertion nil) 57 | (set-assertion-asserted-when assertion nil) 58 | (set-assertion-asserted-why assertion nil) 59 | (set-assertion-asserted-second assertion nil) 60 | (remove-assertion-argument assertion asserted-argument) 61 | (kb-remove-asserted-argument-internal asserted-argument)) 62 | 63 | (define-hl-modifier hl-assert-bookkeeping-binary-gaf (pred arg1 arg2 mt) 64 | "[Cyc] Assert (PRED ARG1 ARG2) in MT to the bookkeeping store." 65 | nil 66 | (assert-bookkeeping-binary-gaf pred arg1 arg2 mt)) 67 | -------------------------------------------------------------------------------- /larkc-cycl/hlmt-czer.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | (defun canonicalize-hlmt (mt) 40 | "[Cyc] Returns the mt that MT denotes, in a canonical form. Will reify the monad if it is a closed nat. Returns NIL if MT is ill-formed." 41 | (check-type mt #'possibly-mt-p) 42 | (multiple-value-bind (mt dummy-mt) (safe-precanonicalizations mt #$BaseKB) 43 | (declare (ignore dummy-mt)) 44 | (unless mt 45 | (setf mt (reduce-hlmt mt (within-query?))) 46 | (setf mt (reify-when-closed-naut mt)) 47 | (when (and (within-forward-inference?) 48 | (not (within-wff?)) 49 | (possibly-naut-p (hlmt-monad-mt mt)) 50 | (tree-find-if #'skolemize-forward? (hlmt-monad-mt mt))) 51 | (setf mt (canonicalize-hlmt-int mt)))) 52 | mt)) 53 | 54 | (defun canonicalize-hlmt-int (hlmt) 55 | (unless (mt-space-naut-p hlmt) 56 | (missing-larkc 12283)) 57 | (unless (and (within-assert?) 58 | (hlmt-with-anytime-psc-p hlmt)) 59 | hlmt)) 60 | -------------------------------------------------------------------------------- /larkc-cycl/integer-sequence-generator.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | (defstruct (integer-sequence-generator (:conc-name "ISG-")) 45 | lock 46 | current 47 | start 48 | limit 49 | delta) 50 | 51 | (defun new-integer-sequence-generator (&optional (start 0) limit (delta 1)) 52 | (must-not (zerop delta) "DELTA must not be zero") 53 | (make-integer-sequence-generator :lock (bt:make-lock "ISG") 54 | :current start 55 | :start start 56 | :limit limit 57 | :delta delta)) 58 | 59 | (defun integer-sequence-generator-reset (isg) 60 | "[Cyc] Reset an Integer Sequence Generator to its original state." 61 | (bt:with-lock-held ((isg-lock isg)) 62 | (setf (isg-current isg) (isg-start isg)))) 63 | 64 | (defconstant *cfasl-wide-opcode-isg* 130) 65 | 66 | ;; TODO DESIGN - This is a complete conversion from the .java version, but doesn't seem enough to be useful. 67 | ;; Other code creates these, but they don't ever seem to be stepped. 68 | -------------------------------------------------------------------------------- /larkc-cycl/kb-control-vars.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | ;; TODO - this file should probably go up pretty early in the load order 45 | 46 | (defglobal *backchain-forbidden-unless-arg-chosen* #$backchainForbiddenWhenUnboundInArg) 47 | (deflexical *kb-features* nil 48 | "[Cyc] The list of KB feature symbols") 49 | (defglobal *reformulator-kb-loaded?* nil) 50 | (defglobal *sksi-kb-loaded?* nil) 51 | (defglobal *paraphrase-kb-loaded?* nil) 52 | (defglobal *nl-kb-loaded?* nil) 53 | (defglobal *lexicon-kb-loaded?* nil) 54 | (defglobal *rtp-kb-loaded?* nil) 55 | (defglobal *rkf-kb-loaded?* nil) 56 | (defglobal *thesaurus-kb-loaded?* nil) 57 | (defglobal *quant-kb-loaded?* nil) 58 | (defglobal *time-kb-loaded?* nil) 59 | (defglobal *date-kb-loaded?* nil) 60 | (defglobal *cyc-task-scheduler-kb-loaded?* nil) 61 | (defglobal *wordnet-kb-loaded?* nil) 62 | (defglobal *cyc-secure-kb-loaded?* nil) 63 | (defglobal *planner-kb-loaded?* nil) 64 | (defglobal *kct-kb-loaded?* nil) 65 | 66 | (defun* kct-kb-loaded-p () (:inline t) 67 | "[Cyc] Is the portion of the KB necessary for KCTs loaded? There is currently no code analogue of this KB feature." 68 | *kct-kb-loaded?*) 69 | 70 | (defun* unset-kct-kb-loaded () (:inline t) 71 | (setf *kct-kb-loaded?* nil)) 72 | 73 | (defparameter *forward-inference-enabled?* t) 74 | (defparameter *forward-propagate-from-negation* nil 75 | "[Cyc] Do we allow forward propagation from negated gafs.") 76 | (defparameter *forward-propagate-to-negations* nil 77 | "[Cyc] Do we allow conclusion of negated fags in forward propagation.") 78 | (defparameter *within-forward-inference?* nil) 79 | 80 | (defun* within-forward-inference? () (:inline t) 81 | *within-forward-inference?*) 82 | 83 | (defparameter *within-assertion-forward-propagation?* nil) 84 | (defparameter *relax-type-restrictions-for-nats* nil) 85 | (defparameter *forward-inference-time-cutoff* nil 86 | "[Cyc] Amount of time we are willing to spend on each forward inference. NIL means unlimited time.") 87 | (defparameter *forward-inference-allowed-rules* :all 88 | "[Cyc] When a value other than :ALL, the list of the only rules allowed for forward inference.") 89 | (defparameter *forward-inference-environment* (create-queue) 90 | "[Cyc] Environment used for performing forward inference.") 91 | (defparameter *recursive-ist-justifications?* t 92 | "[Cyc] Do we give full justifications for ist gafs?") 93 | (defparameter *recording-hl-transcript-operations?* nil 94 | "[Cyc] Whether the HL storage modules should store the operations they perform") 95 | (defparameter *hl-transcript-operations* nil 96 | "[Cyc] A list of the operations noted by the HL storage modules") 97 | 98 | ;; TODO - these are probably part of a def* macro for the variables. Odd that flag names instead of values are put into a *features* value, but that's what the Java code seems to do. 99 | 100 | (toplevel 101 | (dolist (item '(*reformulator-kb-loaded?* 102 | *sksi-kb-loaded?* 103 | *paraphrase-kb-loaded?* 104 | *nl-kb-loaded?* 105 | *lexicon-kb-loaded?* 106 | *rtp-kb-loaded?* 107 | *rkf-kb-loaded?* 108 | *thesauraus-kb-loaded?* 109 | *quant-kb-loaded?* 110 | *time-kb-loaded?* 111 | *date-kb-loaded?* 112 | *cyc-task-scheduler-kb-loaded?* 113 | *wordnet-kb-loaded?* 114 | *cyc-secure-kb-loaded?* 115 | *planner-kb-loaded?* 116 | *kct-kb-loaded?* 117 | *forward-inference-environment*)) 118 | (pushnew item *kb-features*))) 119 | -------------------------------------------------------------------------------- /larkc-cycl/kb-gp-mapping.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | 40 | (defparameter *mapping-arg-swap* nil) 41 | 42 | (defun* dgaigp-binary? (predicate) (:inline t) 43 | (binary? predicate)) 44 | 45 | (defun gp-map-arg-index (function term arg predicate) 46 | "[Cyc] Like MAP-ARG-INDEX, except all spec-predicates of PREDICATE are relevant, and :true is assumed for TRUTH." 47 | (catch :mapping-done 48 | ;; TODO - pred macro, similar to mt macro? 49 | (let ((*relevant-pred-function* #'relevant-pred-is-spec-pred) 50 | (*pred* predicate)) 51 | (kmu-do-index-iteration (assertion gaf-arg (term arg predicate) (:gaf :true nil)) 52 | (funcall function assertion))) 53 | 54 | (when (dgaigp-binary? predicate) 55 | ;; TODO - pred macro 56 | (let ((*relevant-pred-function* #'relevant-pred-is-spec-inverse) 57 | (*pred* predicate)) 58 | (kmu-do-index-iteration (assertion gaf-arg (term (binary-arg-swap arg) predicate) (:gaf :true nil)) 59 | (let ((*mapping-arg-swap* (not *mapping-arg-swap*))) 60 | (funcall function assertion))))))) 61 | 62 | (defun num-spec-pred-index (pred &optional mt) 63 | "[Cyc] only use this where PRED is a predicate." 64 | (let ((count 0)) 65 | (possibly-in-mt (mt) 66 | (dolist (spec-pred (all-spec-preds pred)) 67 | (incf count (Num-predicate-extent-index spec-pred)))) 68 | count)) 69 | 70 | -------------------------------------------------------------------------------- /larkc-cycl/kb-hl-support-manager.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | 40 | (defglobal *kb-hl-support-content-manager* :uninitialized 41 | "[Cyc] The KB object manager for kb-hl-supports.") 42 | 43 | (deflexical *kb-hl-support-lru-size-percentage* 5 44 | "[Cyc] A wild guess.") 45 | 46 | (defun setup-kb-hl-support-content-table (size exact?) 47 | (setf *kb-hl-support-content-manager* 48 | (new-kb-object-manager "kb-hl-support" 49 | size 50 | *kb-hl-support-lru-size-percentage* 51 | #'load-kb-hl-support-def-from-cache 52 | exact?))) 53 | 54 | (defun* clear-kb-hl-support-content-table () (:inline t) 55 | (clear-kb-object-content-table *kb-hl-support-content-manager*)) 56 | 57 | (defun* cached-kb-hl-support-count () (:inline t) 58 | "[Cyc] Return the number of kb-hl-supports whose content is cached in memory." 59 | (cached-kb-object-count *kb-hl-support-content-manager*)) 60 | 61 | (defun* lookup-kb-hl-support-content (id) (:inline t) 62 | (lookup-kb-object-content *kb-hl-support-content-manager* id)) 63 | 64 | (defun* register-kb-hl-supoprt-content (id kb-hl-support-content) (:inline t) 65 | "[Cyc] Note that ID will be used as the id for KB-HL-SUPPORT-CONTENT." 66 | (register-kb-object-content *kb-hl-support-content-manager* id kb-hl-support-content)) 67 | 68 | (defun* deregister-kb-hl-support-content (id) (:inline t) 69 | (deregister-kb-object-content *kb-hl-support-content-manager* id)) 70 | 71 | (defun* mark-kb-hl-support-content-as-muted (id) (:inline t) 72 | (mark-kb-object-content-as-muted *kb-hl-support-content-manager* id)) 73 | 74 | (defun* swap-out-all-pristine-kb-hl-supports () (:inline t) 75 | (swap-out-all-pristine-kb-objects-int *kb-hl-support-content-manager*)) 76 | 77 | (defun initialize-kb-hl-support-hl-store-cache () 78 | (initialize-kb-object-hl-store-cache *kb-hl-support-content-manager* 79 | "kb-hl-support" 80 | "kb-hl-support-index")) 81 | 82 | (defglobal *kb-hl-support-contents-from-ids* nil) 83 | 84 | -------------------------------------------------------------------------------- /larkc-cycl/kb-indexing-declarations.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | 40 | (deflexical *default-intermediate-index-equal-test* #'eq) 41 | (defglobal *kb-indexing-declaration-store* (make-hash-table :test #'eq)) 42 | 43 | (defun* kb-indexing-declaration-store () (:inline t) 44 | *kb-indexing-declaration-store*) 45 | 46 | (defun* add-index-to-kb-indexing-declaration-store (index plist) (:inline t) 47 | (setf (gethash index *kb-indexing-declaration-store*) plist)) 48 | 49 | (defun* get-index-from-kb-indexing-declaration-store (index) (:inline t) 50 | (gethash index *kb-indexing-declaration-store*)) 51 | 52 | (defun find-index-by-top-level-key (top-level-key) 53 | "[Cyc] Returns the index with a top-level key of TOP-LEVEL-KEY." 54 | (let ((index (get-index-from-kb-indexing-declaration-store top-level-key))) 55 | (if (and index 56 | (eq top-level-key (get-index-prop index :top-level-key))) 57 | index 58 | (dohash (index plist (kb-indexing-declaration-store)) 59 | (when (eq top-level-key (get-index-prop index :top-level-key)) 60 | (return index)))))) 61 | 62 | (defun* get-index-key-prop (key-info indicator &optional default) (:inline t) 63 | (getf key-info indicator default)) 64 | 65 | (defun* get-index-prop (index indicator) (:inline t) 66 | (getf (get-index-from-kb-indexing-declaration-store index) indicator)) 67 | 68 | (defun* declare-index (index plist) (:inline t) 69 | "[Cyc] See below for an explanation of what fields go in the plist, what they mean, and a bunch of examples." 70 | (add-index-to-kb-indexing-declaration-store index plist)) 71 | 72 | (defun index-equality-test-for-keys (keys) 73 | "[Cyc] Return the test appropriate for distinguishing the last key in KEYS. 74 | KEYS: a list of keys, starting from the top level." 75 | (destructuring-bind (top-level-key . rest-keys) keys 76 | (let ((index (find-index-by-top-level-key top-level-key))) 77 | (must index 78 | "Could not find an index with top-level key ~s" top-level-key) 79 | (let* ((key-info-list (get-index-prop index :keys)) 80 | (levels-deep (length rest-keys)) 81 | (key-info-for-this-level (nth levels-deep key-info-list)) 82 | (equal-test (get-index-key-prop key-info-for-this-level :equal-test 83 | *default-intermediate-index-equal-test*))) 84 | equal-test)))) 85 | -------------------------------------------------------------------------------- /larkc-cycl/kb-indexing-macros.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | 40 | 41 | (defun* number-has-reached-cutoff? (number cutoff) (:inline t) 42 | (>= number cutoff)) 43 | 44 | (defun number-of-non-null-args-in-order (&optional arg1 arg2 arg3 arg4 arg5) 45 | "[Cyc] Stops counting if it hits a null one." 46 | (cond 47 | ((not arg1) 0) 48 | ((not arg2) 1) 49 | ((not arg3) 2) 50 | ((not arg4) 3) 51 | ((not arg5) 4) 52 | (t 5))) 53 | 54 | -------------------------------------------------------------------------------- /larkc-cycl/kb-macros.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | (defparameter *forts-being-removed* nil 45 | "[Cyc] A list of forts which we are in the process of removing.") 46 | 47 | (defun some-fort-being-removed? () 48 | "[Cyc] Return T iff we are in the process of removing some fort." 49 | *forts-being-removed*) 50 | 51 | -------------------------------------------------------------------------------- /larkc-cycl/map-utilities.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | ;; TODO DESIGN - These utilities abstract Dictionary & hashtable. But since we eliminated dictionary and only work on hashtables, this is moot. Deprecate all of this and wrap into hash-table-utilities. 45 | ;; TODO - add file-level deprecation to the FILE form. 46 | 47 | (symbol-mapping map-p hash-table-p 48 | map-size hash-table-count 49 | map-empty-p hash-table-empty-p 50 | map-get-without-values map-get) 51 | 52 | ;; Stuff that doesn't have a direction function that exactly matches the params 53 | (defun* map-put (map key value) (:inline t) 54 | (setf (gethash key map) value)) 55 | 56 | (defun* map-get (map key default) (:inline t) 57 | (gethash key map default)) 58 | 59 | (defun* map-remove (map key) (:inline t) 60 | (remhash key map)) 61 | -------------------------------------------------------------------------------- /larkc-cycl/modules.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | (deflexical *module-lock* (bt:make-lock "Module Lock")) 44 | (deflexical *system-lock* (bt:make-lock "System Lock")) 45 | 46 | (defstruct module 47 | basis ;; field2 48 | name 49 | system 50 | pathname 51 | test-cases 52 | test-suites 53 | provisional-p ;; field8 54 | ) 55 | 56 | (defglobal *module-index* (make-hash-table :test #'equalp)) 57 | 58 | (defstruct system 59 | basis ;; field2 60 | name 61 | default-pathname 62 | modules 63 | provisional-p ;; field6 64 | ) 65 | 66 | (deflexical *system-index* nil 67 | "[Cyc] List of systems") 68 | 69 | 70 | (defun module-store (module) 71 | (bt:with-lock-held (*module-lock*) 72 | (setf (gethash (list (module-name module) (module-system module)) *module-index*) module))) 73 | 74 | (defun module-new (name system-name &optional provisional-p pathname) 75 | (declare (string name system-name) 76 | (ignore provisional-p pathname)) 77 | (let ((system (system-lookup system-name))) 78 | (must (system-p system) "~a is not the name of a known system." system-name) 79 | (let* ((name (string-downcase name)) 80 | (system-name (string-downcase system-name)) 81 | (new (make-module :name name :system system-name))) 82 | (module-store new) 83 | (system-add-module system new) 84 | new))) 85 | 86 | (defun create-module (name system-name) 87 | (module-new name system-name)) 88 | 89 | (defun module-get-name (module) 90 | (module-name module)) 91 | 92 | (defun module-get-system (module) 93 | (module-system module)) 94 | 95 | (defun system-store (system) 96 | (bt:with-lock-held (*system-lock*) 97 | (pushnew system *system-index*))) 98 | 99 | (defun system-lookup (system-name) 100 | (declare (string system-name)) 101 | (find system-name *system-index* :test #'equal :key #'system-name)) 102 | 103 | (defun system-new (system-name &optional provisional-p default-pathname) 104 | (declare (string system-name) 105 | (ignore provisional-p default-pathname)) 106 | (let ((new (make-system :name system-name))) 107 | (system-store new) 108 | new)) 109 | 110 | (defun create-system (system-name) 111 | (system-new system-name)) 112 | 113 | (defun system-get-name (system) 114 | (system-name system)) 115 | 116 | (defun system-add-module (system module) 117 | "[Cyc] This is only called when MODULE is a provisional module, or we are running translated C code!" 118 | (declare (system system) 119 | (module module)) 120 | (bt:with-lock-held (*system-lock*) 121 | (pushnew module (system-modules system)))) 122 | -------------------------------------------------------------------------------- /larkc-cycl/nart-handles.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | (file "nart-handles") 43 | 44 | (defglobal *nart-from-id* nil 45 | "[Cyc] The ID -> NART mapping table.") 46 | 47 | (defun* do-narts-table () (:inline t) 48 | *nart-from-id*) 49 | 50 | (defun setup-nart-table (size exact?) 51 | (declare (ignore exact?)) 52 | (unless *nart-from-id* 53 | (setf *nart-from-id* (new-id-index size 0)) 54 | t)) 55 | 56 | (defun finalize-narts (&optional max-nart-id) 57 | (set-next-nart-id max-nart-id) 58 | (unless max-nart-id 59 | (missing-larkc 30878))) 60 | 61 | (defun* clear-nart-table () (:inline t) 62 | (clear-id-index *nart-from-id*)) 63 | 64 | (defun nart-count () 65 | "[Cyc] Return the total number of NARTs." 66 | (if *nart-from-id* 67 | (id-index-count *nart-from-id*) 68 | 0)) 69 | 70 | (defun* lookup-nart (id) (:inline t) 71 | (id-index-lookup *nart-from-id* id)) 72 | 73 | (defun* new-nart-id-threshold () (:inline t) 74 | "[Cyc] Return the internal ID where new NARTs started." 75 | (id-index-new-id-threshold *nart-from-id*)) 76 | 77 | ;; The inner loop seems to have an unconditional missing-larkc, and doesn't seem to be called anyway. However, it shouldn't be hard to complete, as we have the intent message and funcname. 78 | '(defun set-next-nart-id (&optional max-nart-id) 79 | ;; TODO - this is a macroexpansion that optionally skips over tombstones. There's do-narts, do-old-narts, and do-new-narts declared, whose expansion this likely is. 80 | (let* ((max (or max-nart-id -1)) 81 | (idx (do-narts-table)) 82 | (mess "Determining maximum NART ID") 83 | (total (id-index-count idx)) 84 | (sofar 0)) 85 | (noting-percent-progress (mess) 86 | (unless (id-index-objects-empty-p idx :skip) 87 | (dovector (id nart (id-index-old-objects idx)) 88 | ()))))) 89 | 90 | (defun register-nart-id (nart id) 91 | "[Cyc] Note that ID will be used as the id for NART." 92 | (reset-nart-id nart id) 93 | (id-index-enter *nart-from-id* id nart) 94 | nart) 95 | 96 | (defstruct (nart (:conc-name "N-")) 97 | id) 98 | 99 | (defmethod sxhash ((object nart)) 100 | (let ((id (n-id object))) 101 | (if (integerp id) id 0))) 102 | 103 | (defun* get-nart () (:inline t) 104 | "[Cyc] Make a new nart shell, potentially in static space." 105 | (make-nart)) 106 | 107 | (defun valid-nart-handle? (object) 108 | "[Cyc] Return T iff OBJECT is a valid NART handle." 109 | (and (nart-p object) 110 | (missing-larkc 30862))) 111 | 112 | (defun make-nart-shell (&optional id) 113 | (unless id 114 | (missing-larkc 30861)) 115 | (let ((nart (get-nart))) 116 | (register-nart-id nart id) 117 | nart)) 118 | 119 | (defun create-sample-invalid-nart () 120 | "[Cyc] Create a sample invalid NART." 121 | (get-nart)) 122 | 123 | ;; TODO - uses same macroexpansion as set-next-nart-id, with the missing-larkc 124 | '(defun free-all-narts () 125 | ) 126 | 127 | (defun* reset-nart-id (nart new-id) (:inline t) 128 | "[Cyc] Primitively change the internal id for NART to NEW-ID." 129 | (setf (n-id nart) new-id) 130 | nart) 131 | 132 | (defun* find-nart-by-id (id) (:inline t) 133 | (lookup-nart id)) 134 | -------------------------------------------------------------------------------- /larkc-cycl/nart-hl-formula-manager.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | 40 | (defglobal *nart-hl-formula-manager* :uninitialized 41 | "[Cyc] The KB object manager for nart-hl-formlas.") 42 | 43 | (deflexical *nart-hl-formula-lru-size-percentage* 5 44 | "[Cyc] A wild guess.") 45 | 46 | (defun setup-nart-hl-formula-table (size exact?) 47 | (setf *nart-hl-formula-manager* (new-kb-object-manager "nart-hl-formula" 48 | size 49 | *nart-hl-formula-lru-size-percentage* 50 | #'load-nart-hl-formula-from-cache 51 | exact?))) 52 | 53 | (defun clear-nart-hl-formula-table () 54 | (clear-kb-object-content-table *nart-hl-formula-manager*)) 55 | 56 | (defun* cached-nart-hl-formula-count () (:inline t) 57 | "[Cyc] Return the number of nart-hl-formulas whose content is cached in memory." 58 | (cached-kb-object-count *nart-hl-formula-manager*)) 59 | 60 | (defun nart-hl-formulas-unbuilt? () 61 | (unless (zerop (nart-count)) 62 | (kb-object-manager-unbuilt? *nart-hl-formula-manager*))) 63 | 64 | (defun swap-out-all-pristine-nart-hl-formulas () 65 | (swap-out-all-pristine-kb-objects-int *nart-hl-formula-manager*)) 66 | 67 | (defun initialize-nart-hl-formula-hl-store-cache () 68 | (initialize-kb-object-hl-store-cache *nart-hl-formula-manager* 69 | "nart-hl-formula" 70 | "nart-hl-formula-index")) 71 | 72 | (defglobal *nart-hl-formula-table* nil) 73 | -------------------------------------------------------------------------------- /larkc-cycl/nart-index-manager.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | ;; TODO - very similar in form to constant-index-manager. there's also unrepresented-term-index-manager, nart-hl-formula-manager 40 | 41 | (defglobal *nart-index-manager* :uninitialized 42 | "[Cyc] The KB object manager for nart indices.") 43 | 44 | (deflexical *nart-index-lru-size-percentage* 20 45 | "[Cyc] Based on arete experiments, only 20% of all narts are touched during normal inference, so we'll make a conservative guess that every one of those touched the nart's index.") 46 | 47 | (defun setup-nart-index-table (size exact?) 48 | (setf *nart-index-manager* (new-kb-object-manager "nart-index" 49 | size 50 | *nart-index-lru-size-percentage* 51 | #'load-nart-index-from-cache 52 | exact?))) 53 | 54 | (defun swap-out-all-pristine-nart-indices () 55 | (swap-out-all-pristine-kb-objects-int *nart-index-manager*)) 56 | 57 | (defun initialize-nart-index-hl-store-cache () 58 | (initialize-kb-object-hl-store-cache *nart-index-manager* 59 | "nat-indices" 60 | "nat-indices-index")) 61 | -------------------------------------------------------------------------------- /larkc-cycl/narts-high.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | (defun naut-p (object) 45 | "[Cyc] Return T iff OBJECT is a datastructure implementing a non-atomic unreified term (NAUT). 46 | By definition, this satisfies CYCL-NAT-P but not NART-P." 47 | (and (possibly-naut-p object) 48 | (cycl-nat-p object))) 49 | 50 | (defun find-nart (nart-hl-formula) 51 | "[Cyc] Return the nart implementing NART-HL-FORMULA, or NIL if none is present. 52 | Subsitutions for existing sub-NARTs are performed." 53 | (let ((nart (nart-substitute nart-hl-formula))) 54 | (and (nart-p nart) 55 | nart))) 56 | 57 | '(defun remove-dependent-narts (fort) 58 | "[Cyc] Remove all current NARTs which are functions of FORT." 59 | (dolist (dependent (dependent-narts fort)) 60 | (missing-larkc 30883))) 61 | 62 | (defun nart-expand (object) 63 | "[Cyc] Recursively expand all NARTs in OBJECT into their EL forms (NAUTs)." 64 | (if (tree-find-if #'nart-p object) 65 | (transform object #'nart-p) 66 | object)) 67 | 68 | (defun nart-substitute (object) 69 | "[Cyc] Substitute into OBJECT as many NARTs as possible. 70 | If the entire formula can be converted to a NART, it will. 71 | Returns OBJECT itself if no substitutions can be made." 72 | (if (possibly-naut-p object) 73 | (nart-substitute-recursive object) 74 | object)) 75 | 76 | (defun nart-substitute-recursive (tree) 77 | (if (subl-escape-p tree) 78 | tree 79 | (let ((result tree)) 80 | (if (contains-nat-formula-as-element? tree) 81 | (let ((new-tree (copy-list tree))) 82 | (do ((list new-tree)) 83 | ((atom list) 84 | (setf result new-tree)) 85 | (let ((arg (car list))) 86 | (when (nat-formula-p arg) 87 | (let ((sub-nart (nart-substitute-recursive arg))) 88 | (when sub-nart 89 | (rplaca list sub-nart))))))) 90 | (setf result tree)) 91 | (let ((nart (nart-lookup result))) 92 | (if (nart-p nart) 93 | nart 94 | result))))) 95 | 96 | (defun contains-nat-formula-as-element? (list) 97 | "[Cyc] Return T iff LIST contains at least one element that could be reified as a nart. It does not consider whether LIST itself could be reified as a nart, and it does not look deeper than one level of nesting." 98 | (do ((rest list (cdr rest))) 99 | ((atom list)) 100 | (when (nat-formula-p (car rest)) 101 | (return t)))) 102 | 103 | (defun nart-lookup (nart-hl-formula) 104 | "[Cyc] Return the NART implementing NART-HL-FORMULA, or NIL if none is present. 105 | No substitutions for sub-NARTs are performed." 106 | (if (and (not *bootstrapping-kb*) 107 | (or (not (reifiable-functor? (nat-functor nart-hl-formula))) 108 | (not (fully-bound-p nart-hl-formula)))) 109 | nil 110 | (missing-larkc 871))) 111 | 112 | (defparameter *nart-dump-id-table* nil) 113 | 114 | (defun find-nart-by-dump-id (dump-id) 115 | "[Cyc] Return the NART with DUMP-ID during a KB load." 116 | (find-nart-by-id dump-id)) 117 | 118 | -------------------------------------------------------------------------------- /larkc-cycl/obsolete.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | ;; TODO - mark everything as deprecated. Presumably things in this file are still referenced. 40 | 41 | (defun cycl-system-number () 42 | "[Cyc] Obsolete -- use CYC-REVISION-NUMBERS." 43 | (or (first (cyc-revision-numbers)) 44 | 0)) 45 | 46 | (defun cycl-patch-number () 47 | "[Cyc] Obsolete -- use CYC-REVISION-NUMBERS." 48 | (or (second (cyc-revision-numbers)) 49 | 0)) 50 | 51 | (defun reifiable-nat? (term &optional (var? #'cyc-var?) mt) 52 | (reifiable-naut? term var? mt)) 53 | 54 | (defun cnat-p (object &optional (var? #'cyc-var?)) 55 | (closed-naut? object var?)) 56 | 57 | -------------------------------------------------------------------------------- /larkc-cycl/pred-relevance-macros.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | (defparameter *pred* nil) 40 | (defparameter *relevant-preds* nil) 41 | (declaim ((or null function) *relevant-pred-function*)) 42 | (defparameter *relevant-pred-function* nil) 43 | 44 | (defun* relevant-pred-is-eq (pred) (:inline t) 45 | (eq *pred* pred)) 46 | 47 | (defun* relevant-pred-is-spec-pred (pred) (:inline t) 48 | (or (relevant-pred-is-eq pred) 49 | (cached-spec-pred? *pred* pred))) 50 | 51 | (defun* relevant-pred-is-spec-inverse (pred) (:inline t) 52 | (cached-spec-inverse? *pred* pred)) 53 | 54 | (defun* relevant-pred? (pred) (:inline t) 55 | "[Cyc] Return T iff PRED is a relevant predicate at this point." 56 | (or (pred-relevant-undefined-p) 57 | ;; TODO - skipped the large case test to directly call various function names. This skips over various missing-larkc reports, and would end up in a 'Function X is undefined' style error instead. 58 | (funcall *relevant-pred-function* pred))) 59 | 60 | (defun* pred-relevance-undefined-p () (:inline t) 61 | (null *relevant-pred-function*)) 62 | 63 | (defun* all-preds-are-relevant? () (:inline t) 64 | (or (pred-relevant-undefined-p) 65 | (eq #'relevant-pred-is-everything *relevant-pred-function*))) 66 | 67 | (defun inference-genl-predicate-of? (pred) 68 | (let ((inference-pred (literal-predicate *inference-literal*))) 69 | (and inference-pred 70 | (not (eq pred inference-pred)) 71 | (cached-spec-pred? inference-pred pred)))) 72 | 73 | (defun inference-genl-inverse-of? (pred) 74 | (let ((inference-pred (literal-prediate *inference-literal*))) 75 | (and inference-pred 76 | (not (eq pred inference-pred)) 77 | (cached-spec-inverse? inference-pred pred)))) 78 | 79 | (defun determine-inference-genl-or-spec-pred-relevance (sense) 80 | (if (eq :pos sense) 81 | #'inference-genl-predicate-of? 82 | #'inference-genl-predicate?)) 83 | 84 | (defun determine-inference-genl-or-spec-inverse-relevance (sense) 85 | (if (eq :pos sense) 86 | #'inference-genl-inverse-of 87 | #'inference-genl-inverse)) 88 | 89 | (defstruct (pred-info-object (:conc-name "PRED-INFO-")) 90 | pred 91 | relevance-function) 92 | -------------------------------------------------------------------------------- /larkc-cycl/process-utilities.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | ;; Note that this uses ye olde LISP definition of "process" to mean what we now call "thread" 45 | 46 | ;; TODO - lots of useful stuff is missing, not sure how meaningful this will be. 47 | 48 | (defstruct task 49 | process 50 | completed) 51 | 52 | (defstruct (thinking-task (:conc-name "T-TASK-")) 53 | lock 54 | thread 55 | name 56 | status 57 | progress-message 58 | progress-so-far 59 | progress-total 60 | start-time 61 | finish-time 62 | result 63 | error-message 64 | properties) 65 | 66 | (defparameter *thinking-task* nil) 67 | 68 | (defstruct ipc-queue 69 | lock 70 | semaphore 71 | data-queue) 72 | 73 | (defstruct (ordered-ipc-queue (:conc-name "ORDRD-IPCQ-")) 74 | lock 75 | producer-isg 76 | consumer-isg 77 | payload) 78 | 79 | (defconstant *ordered-ipcq-empty* (make-symbol "empty ordered IPC queue entry")) 80 | 81 | (defun process-exhaust-immediately-fn () 82 | nil) 83 | 84 | (defun make-exhausted-process (name) 85 | "[Cyc] A wrapper for creating an already exhausted process." 86 | (bt:make-thread #'process-exhaust-immediately-fn :name name)) 87 | 88 | ;; TODO - can't dispatch on a CL type, only a class, so hitting internals 89 | (defmethod visit-defstruct-object ((object sb-thread:thread) visitor-fn) 90 | (visit-defstruct-object-process object visitor-fn)) 91 | 92 | (defun visit-defstruct-object-process (process visitor-fn) 93 | (funcall visitor-fn process :begin 'make-exhausted-process 1) 94 | (funcall visitor-fn process :slot :name (bt:thread-name process)) 95 | (funcall visitor-fn process :end 'make-exhausted-process 1) 96 | process) 97 | 98 | ;; TODO - can't dispatch on a CL type, only a class, so hitting internals 99 | (defmethod visit-defstruct-object ((object sb-thread:mutex) visitor-fn) 100 | (visit-defstruct-object-lock object visitor-fn)) 101 | 102 | (defun visit-defstruct-object-lock (lock visitor-fn) 103 | (funcall visitor-fn lock :begin 'bt:make-lock 1) 104 | ;; TODO - bordeaux-threads doesn't expose accessing the name? 105 | (funcall visitor-fn lock :slot :name #+sbcl (sb-thread:mutex-name lock)) 106 | (funcall visitor-fn lock :end 'bt:make-lock 1)) 107 | 108 | (defstruct process-wrapper 109 | id 110 | process 111 | state 112 | lock 113 | plist) 114 | 115 | ;; TODO DESIGN - never used 116 | (defglobal *process-wrapper-isg* (new-integer-sequence-generator)) 117 | 118 | -------------------------------------------------------------------------------- /larkc-cycl/psc.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | ;; No declared macros 44 | 45 | (defun mt-inference-function (mt) 46 | (cond 47 | ((eq mt #$EverythingPSC) 'all-mts-inference) 48 | ((eq mt #$InferencePSC) 'psc-inference) 49 | ((not (possibly-naut-p mt)) 'normal-inference) 50 | ((mt-union-naut-p mt) 'mt-union-inference) 51 | ((hlmt-with-anytime-psc-p mt) 'anytime-psc-inference) 52 | (t 'normal-inference))) 53 | 54 | 55 | -------------------------------------------------------------------------------- /larkc-cycl/sbhl/sbhl-macros.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | 40 | (defun do-sbhl-non-fort-links? (node module) 41 | (and (eq module (get-sbhl-module #$isa)) 42 | (collection-supports-non-fort-instances? node))) 43 | 44 | (defun* collection-supports-non-fort-instances? (col) (:inline t) 45 | t) 46 | 47 | (defun get-sbhl-accessible-modules (module) 48 | "[Cyc] Returns the list of SBHL modules allowed by MODULE for following links." 49 | (if-let ((preds (get-sbhl-accessible-link-preds module))) 50 | (mapcar #'get-sbhl-module preds) 51 | (list module))) 52 | -------------------------------------------------------------------------------- /larkc-cycl/sbhl/sbhl-paranoia.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | ;; A bunch of checking, debug reporting, & error handling stuff for the sbhl layer 38 | 39 | (in-package :clyc) 40 | 41 | (defparameter *sbhl-object-type-checking-p* t 42 | "[Cyc] Parameter that governs whether we perform work within SBHL-CHECK-TYPE.") 43 | 44 | (defun* sbhl-object-type-checking-p () (:inline t) 45 | ;; TODO - the cyc comments use "accessor" when they mean "reader" which goes against the CLHS definition. 46 | "[Cyc] The boolean value of *SBHL-OBJECT-TYPE-CHECKING-P*." 47 | (or *sbhl-object-type-checking-p* 48 | (not (suspend-sbhl-type-checking?)))) 49 | 50 | (defparameter *sbhl-type-error-action* :error 51 | "[Cyc] Parameter that guides error behavior.") 52 | 53 | (defparameter *sbhl-trace-level* 1 54 | "[Cyc] Controls extent of tracing, warnings, etc., for the sbhl modules [0 .. 5].") 55 | 56 | (defun sbhl-error (level format-str &rest args) 57 | "[Cyc] If *SBHL-TRACE_LEVEL* si greater than or equal to LEVEL, signal a cerror with FORMAT-STR. If *SBHL-TRACE_LEVEL* is within 2 of LEVEL, warn with FORMAT-STR." 58 | (cond 59 | ((>= *sbhl-trace-level* level) 60 | (apply #'cerror "Continue anyway" args)) 61 | ((>= (+ 2 *sbhl-trace-level*) level) 62 | (apply #'warn format-str args)))) 63 | 64 | (defun sbhl-cerror (level continue-str format-str &rest args) 65 | "[Cyc] If *SBHL-TRACE-LEVEL* is greater than or equal to LEVEL, signal a cerror with CONTINUE-STR and FORMAT-STR. If *SBHL-TRACE-LEVEL* is within 2 of LEVEL, warn with FORMAT-STR." 66 | (cond 67 | ((>= *sbhl-trace-level* level) 68 | (apply #'cerror continue-str format-str args)) 69 | ((>= (+ 2 *sbhl-trace-level*) level) 70 | (apply #'warn format-str args)))) 71 | 72 | (defun sbhl-warn (level format-str &rest args) 73 | "[Cyc] If *SBHL-TRACE-LEVEL* is greater than or equal to LEVEL, warn with FORMAT-STR." 74 | (when (>= *sbhl-trace-level* level) 75 | (apply #'warn format-str args))) 76 | 77 | (defun suspend-sbhl-type-checking? () 78 | (or *suspend-type-checking?* 79 | *suspend-sbhl-type-checking?* 80 | (some-fort-being-removed?) 81 | *within-unassert*)) 82 | 83 | (defparameter *sbhl-test-level* 3 84 | "[Cyc] Controls extent of integrity testing for teh sbhl modules [0 .. 5].") 85 | (defparameter *sbhl-test-max?* nil 86 | "[Cyc] Controls very expensive sbhl testing.") 87 | (defparameter *sbhl-trace-max?* nil 88 | "[Cyc] Controls very expensive sbhl tracing.") 89 | (defparameter *suppress-sbhl-recaching?* nil 90 | "[Cyc] Suppress retyping of forts iff this is non-NIL.") 91 | (defparameter *suspend-sbhl-cache-use?* nil 92 | "[Cyc] Suppress use of fort types, and call the SBHL instead. 93 | This should be set to NIL during for types initialization.") 94 | 95 | (defun check-sbhl-caches? () 96 | (and *suspend-sbhl-cache-use?* 97 | (sbhl-caches-initialized-p))) 98 | 99 | 100 | ;; TODO DESIGN - maybe an option to disable typechecking at compilation time, too 101 | 102 | ;; Expansion taken from multiple instances in sbhl-module-vars 103 | ;; This macro used to contain the following function body inside it. 104 | ;; To me, that's a waste of instruction cache, so we'll just macro the check, and call when it's enabled. 105 | ;; Disablable error handling doesn't need to be fast anyway, as long as the inline portion of the check is small. 106 | (defmacro sbhl-check-type (object type-test &optional (level 1)) 107 | `(when (and (sbhl-object-type-checking-p) 108 | (,type-test ,object)) 109 | (sbhl-handle-type-check-failure ,object ',type-test ,level))) 110 | 111 | (defun sbhl-handle-type-check-failure (object type-test level) 112 | ;; TODO - this is kind of dumb. Can't we register a function instead of a keyword? 113 | (case *sbhl-type-error-action* 114 | (:error (sbhl-error level "~a is not a ~a." object type-test)) 115 | ;; TODO - is this supposed to be sbhl-cerror? it does exist 116 | (:cerror (missing-larkc 2198)) 117 | (:warn (warn "~a is not a ~a." object type-test)) 118 | (otherwise 119 | (warn "~a is not a valid *SBHL-TYPE-ERROR-ACTION* value." *sbhl-type-error-action*) 120 | (cerror "Continue anyway" "~a is not a ~a." object type-test)))) 121 | -------------------------------------------------------------------------------- /larkc-cycl/sbhl/sbhl-search-datastructures.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | ;; This only constains structs, but given the filename and the minimal function declarations in the java declare function, this is probably by design. 40 | 41 | (defstruct sbhl-stack 42 | num 43 | elements) 44 | 45 | (defstruct sbhl-link-node-search-state 46 | node 47 | module 48 | direction 49 | mt 50 | tv 51 | parent-node 52 | genl-inverse-mode? 53 | link-generator) 54 | -------------------------------------------------------------------------------- /larkc-cycl/set-contents.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | 42 | (in-package :clyc) 43 | 44 | 45 | 46 | ;; This seems to treat single values, lists, and hashtables as sets, transitioning between them as they grow & shrink 47 | ;; Has to do introspection and branching off returned keywords and stuff, probably faster just to hashtable it 48 | ;; Besides, this introspection is pretty dangerous if you're using lists as data elements 49 | ;; The modern rule of thumb is that at 10 or so elements, hash tables become cheaper. This one keeps lists up to 128 elements, which is nuts. If that's a common size range for this datastructure, then we're better off just sticking with hashtables. 50 | ;; Plus it's much faster to use the baked-in hashtable tests than manually funcalling test in lists and such 51 | 52 | ;; TODO - mark all functions as deprecated 53 | 54 | ;; TODO - if we're solely going to use hashtables, then wait on defining this and see where it's used 55 | ;; (defun set-contents-p (object) 56 | ;; "[Cyc] Return T iff OBJECT can be interpreted as the contents of a set." 57 | ;; ;; Degenerate, there's no wrapper 58 | ;; (declare (ignore object)) 59 | ;; t) 60 | 61 | (defun new-set-contents (&optional (size 0) (test #'eql)) 62 | "[Cyc] Allocate a new set-contents. Assume that SIZE elements will likely be immediately added, with TEST as the assumed equality test." 63 | (make-hash-table :test test :size size)) 64 | 65 | (defun copy-set-contents (set-contents) 66 | "[Cyc] Return a new copy of SET-CONTENTS. TEST is the assumed equality test." 67 | (let ((new-ht (make-hash-table :test (hash-table-test set-contents) 68 | :size (hash-table-size set-contents)))) 69 | (maphash (lambda (key value) 70 | (setf (gethash key new-ht) value)) 71 | set-contents) 72 | new-ht)) 73 | 74 | (defun set-contents-size (set-contents) 75 | "[Cyc] Return the number of items currently entered in SET." 76 | (hash-table-count set-contents)) 77 | 78 | (defun set-contents-empty? (set-contents) 79 | "[Cyc] non-nil iff SET-CONTENTS is empty, NIL otherwise" 80 | (hash-table-empty-p set-contents)) 81 | 82 | (defun set-contents-singleton? (set-contents) 83 | "[Cyc] non-NIL iff SET-CONTENTS has exactly one element" 84 | (= 1 (hash-table-count set-contents))) 85 | 86 | (defun set-contents-member? (element set-contents) 87 | "[Cyc] T iff ELEMENT is in SET-CONTENTS. TEST is the assumed equality test." 88 | (gethash element set-contents)) 89 | 90 | (defun set-contents-add (element set-contents) 91 | "[Cyc] Add this ELEMENT into the SET-CONTENTS. TEST is the assumed equality test." 92 | (setf (gethash element set-contents) t)) 93 | 94 | (defun set-contents-delete (element set-contents) 95 | "[Cyc] If ELEMENT is present in SET-CONTENTS, then take it out of SET-CONTENTS. TEST is the assumed equality test." 96 | (remhash element set-contents)) 97 | 98 | (defun clear-set-contents (set-contents) 99 | "[Cyc] Reset SET-CONTENTS to the status of being just allocated." 100 | (clrhash set-contents)) 101 | 102 | (defun new-set-contents-iterator (set-contents) 103 | "[Cyc] Returns an iterator for the elements of SET-CONTENTS." 104 | ;; TODO - is this used on lists without going through new-set-contents? 105 | ;; TODO - not great performance, but returning a closure with WITH-HASH-TABLE-ITERATOR is undefined behavior 106 | (new-list-iterator (hash-table-keys set-contents))) 107 | 108 | (defun cfasl-input-set-contents (stream set-contents size) 109 | (dotimes (i size) 110 | (setf set-contents (set-contents-add (cfasl-input stream) set-contents))) 111 | set-contents) 112 | 113 | (defun set-contents-element-list (set-contents) 114 | "[Cyc] return a list of the elements of SET-CONTENTS." 115 | (hash-table-keys set-contents)) 116 | 117 | (defun set-contents-rebuild (set-contents) 118 | "[Cyc] Rehashes SET-CONTENTS if it's a keyhash style" 119 | ;; No, trust the implementation. 120 | set-contents) 121 | -------------------------------------------------------------------------------- /larkc-cycl/set-utilities.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | (defun set-union (set-list &optional (test #'eql)) 45 | "Returns a new set that is the union of the sets in the given list." 46 | (cond 47 | ((null set-list) (new-set :test test)) 48 | ((singleton? set-list) (copy-set-contents (car set-list))) 49 | ;; TODO DESIGN - it could be better to copy the test of the 1st set, rather than having to remember to specify it. 50 | (t (let ((union (make-hash-table :test test))) 51 | (dolist (set set-list union) 52 | (dohash (key val set) 53 | (setf (gethash key union) val))))))) 54 | 55 | (defun set-intersection (set-list &optional (test #'eql)) 56 | (cond 57 | ((null set-list) (new-set :test test)) 58 | ((singleton? set-list) (copy-set-contents (car set-list))) 59 | (t (let* ((smallest (extremal set-list #'< #'set-contents-size)) 60 | (other-sets (remove smallest set-list)) 61 | (intersection (make-hash-table :test test))) 62 | (dohash (key val smallest) 63 | (declare (ignore val)) 64 | (when (every (lambda (set) (gethash key set)) other-sets) 65 | (setf (gethash key intersection) t))) 66 | intersection)))) 67 | 68 | (defun construct-set-from-list (list &optional (test #'eql) (size (length list))) 69 | "[Cyc] Returns a set-contents object constructed from the objects in LIST." 70 | (let ((set (make-hash-table :test test :size size))) 71 | (dolist (item list set) 72 | (setf (gethash item set) t)))) 73 | 74 | (defun set-add-all (elements set) 75 | (dolist (element elements set) 76 | (setf (gethash element set) t))) 77 | 78 | -------------------------------------------------------------------------------- /larkc-cycl/set.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | ;; Replaced the implemenation with key->T hashtables 45 | 46 | ;; TODO - could defer the inlines to set-contents instead of hash-table 47 | 48 | (deflexical *new-set-default-test-function* #'eql) 49 | 50 | (defun* new-set (&optional (test *new-set-default-test-function*) (size 0)) 51 | (:inline t) 52 | "[Cyc] Allocate a new set with TEST as the equality test. 53 | Assume that SIZE elements will likely be immediately added." 54 | (make-hash-table :test test :size size)) 55 | 56 | (defun* set-size (set) (:inline t) 57 | "[Cyc] Return the number of items currently entered in SET" 58 | (hash-table-count set)) 59 | 60 | (defun* set-empty? (set) (:inline t) 61 | "[CYc] Return non-NIL iff SET is empty, NIL otherwise." 62 | (hash-table-empty-p set)) 63 | 64 | (defun* set-member? (element set) (:inline t) 65 | "[Cyc] Return T iff ELEMENT is in SET." 66 | (gethash element set)) 67 | 68 | ;; TODO DESIGN - this is a lot slower than if it didn't have to have the return value test. SBCL internals might allow us to do this more directly, but we should first check if the return value is ever actually used. 69 | (defun* set-add (element set) (:inline t) 70 | "[Cyc] Add this ELEMENT into the SET. 71 | Return T iff ELEMENT was not already there." 72 | (unless (set-member? element set) 73 | (setf (gethash element set) t))) 74 | 75 | (defun* set-remove (element set) (:inline t) 76 | "[Cyc] If ELEMENT is present in SET, then take it out of SET. 77 | Returns T iff ELEMENT was in SET to begin with." 78 | ;; remhash matches this return behavior 79 | (remhash element set)) 80 | 81 | (defun* clear-set (set) (:inline t) 82 | "[Cyc] Reset SET to the status of being just allocated. 83 | Returns SET." 84 | ;; TODO - we're not remembering its initial size. Oh well. 85 | (clrhash set)) 86 | 87 | (defun* new-set-iterator (set) (:inline t) 88 | (new-hash-table-iterator set)) 89 | 90 | (defconstant *cfasl-opcode-set* 60) 91 | 92 | (defun cfasl-input-set (stream) 93 | (let* ((test (cfasl-input stream)) 94 | (size (cfasl-input stream)) 95 | (set (new-set test size))) 96 | (cfasl-input-set-contents stream set size))) 97 | 98 | (defconstant *cfasl-opcode-legacy-set* 67) 99 | 100 | (defun* set-element-list (set) (:inline t) 101 | "[Cyc] Returns a list of the elements of SET." 102 | (hash-table-keys set)) 103 | 104 | ;; TODO - deprecate this 105 | (defun* set-rebuild (set) (:inline t) 106 | set) 107 | 108 | 109 | (defun* set-p (obj) (:inline t) 110 | "Since Clyc sets are hashtables, this overfits." 111 | ;; TODO - See if there are any places where set-p is used as a peer of dictionary-p or hash-table-p etc 112 | (hash-table-p obj)) 113 | 114 | (defmacro do-set ((item set &optional done-form) &body body) 115 | (alexandria:with-gensyms (val) 116 | `(block nil 117 | (maphash (lambda (,item ,val) 118 | (declare (ignore ,val)) 119 | ,(when done-form 120 | `(when ,done-form 121 | (return nil))) 122 | ,@body) 123 | ,set)))) 124 | 125 | 126 | 127 | -------------------------------------------------------------------------------- /larkc-cycl/special-variable-state.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | ;; This snapshots the values of special variables 45 | 46 | (defstruct (special-variable-state (:conc-name "SVS-")) 47 | variables 48 | values) 49 | 50 | (defun new-special-variable-state (special-variables) 51 | "[Cyc] Return a new SPECIAL-VARIABLE-STATE-P based on the current values for SPECIAL-VARIABLES." 52 | (let ((svs (make-special-variable-state :variables (copy-list special-variables) 53 | :values (make-list (length special-variables))))) 54 | (update-special-variable-state svs))) 55 | 56 | ;; TODO - weird naming convention, is this a macroexpansion? 57 | (defun* with-special-variable-state-variables (svs) (:inline t) 58 | (svs-variables svs)) 59 | 60 | (defun* with-special-variable-state-values (svs) (:inline t) 61 | (svs-values svs)) 62 | 63 | (defun update-special-variable-state (svs) 64 | "[Cyc] Update SPECIAL-VARIABLE-STATE SVS with the current binding values for all its special-variables." 65 | (update-special-variable-value-list (svs-values svs) (svs-variables-svs)) 66 | svs) 67 | 68 | (defun update-special-variable-value-list (values variables) 69 | "Performs a destructive update on the VALUES list, based on VARIABLES' values." 70 | (loop 71 | for variable in variables 72 | for rest-values on values 73 | do (rplaca rest-values (symbol-value variable))) 74 | values) 75 | 76 | -------------------------------------------------------------------------------- /larkc-cycl/stacks.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | (defstruct stack 45 | (num 0 :type fixnum) 46 | (elements nil :type list)) 47 | 48 | (defun create-stack () 49 | "[Cyc] Return a new, empty stack." 50 | (make-stack)) 51 | 52 | (defun clear-stack (stack) 53 | "[Cyc] Clear STACK and return it." 54 | (setf (stack-num stack) 0) 55 | (setf (stack-elements stack) nil) 56 | stack) 57 | 58 | (defun stack-empty-p (stack) 59 | "[Cyc] Return T iff STACK is empty." 60 | (null (stack-elements stack))) 61 | 62 | (defun stack-push (item stack) 63 | "[Cyc] Add ITEM to the top of STACK. Returns STACK." 64 | (incf (stack-num stack)) 65 | (push item (stack-elements stack)) 66 | stack) 67 | 68 | (defun stack-pop (stack) 69 | "[Cyc] Remove and return the top item in STACK." 70 | (when (stack-elements stack) 71 | (decf (stack-num stack)) 72 | (pop (stack-elements stack)))) 73 | 74 | (defun stack-peek (stack) 75 | "[Cyc] Return the top item in STACK, without removing it." 76 | (when (stack-elements stack) 77 | (car (stack-elements stack)))) 78 | 79 | ;; rest of it seems missing-larkc 80 | (defstruct locked-stack 81 | lock 82 | stack) 83 | 84 | 85 | (defmacro do-stack-elements ((item-var stack &key done) &body body) 86 | ;; TODO - assuming that DONE is a early-exit predicate. Could also be a return value form. 87 | (when done (warn "do-stack-elements DONE keyword used: ~s" done)) 88 | `(do ((,item-var ,stack (cdr ,item-var))) 89 | ((or ,done (null ,item-var))) 90 | ,@body)) 91 | -------------------------------------------------------------------------------- /larkc-cycl/subl-macros.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | 42 | (in-package :clyc) 43 | 44 | 45 | 46 | (deflexical *ignore-assert-types?* t 47 | "[Cyc] When non-NIL, ASSERT-TYPE and ASSERT-MUST statements are ignored. Otherwise, they expand into CHECK-TYPE and MUST statements, respectively.") 48 | 49 | (defun rplacd-last (non-empty-list new-last-cdr) 50 | (rplacd (last non-empty-list) new-last-cdr)) 51 | 52 | -------------------------------------------------------------------------------- /larkc-cycl/subl-promotions.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | (defun function-symbol-p (obj) 45 | "[Cyc] Return T iff OBJECT is a symbol with a function definition." 46 | (and (symbolp obj) 47 | (fboundp obj))) 48 | 49 | (defun function-symbol-arglist (function-symbol) 50 | "[Cyc] Return the arglist of FUNCTION-SYMBOL" 51 | #+sbcl (sb-impl::%fun-lambda-list (symbol-function function-symbol)) 52 | #-sbcl (error "FUNCTION-SYMBOL-ARGLIST unimplemented in this CL implementation")) 53 | 54 | ;; PERFORMANCE - instead of suboptimal RSUBLIS custom implementations, just reverse the alist. However, this means macros instead of functions to take advantage of compiler optimizations 55 | (defun reverse-alist-pairs (alist) 56 | "Reverses each entry from (KEY . VALUE) to (VALUE . KEY)" 57 | (mapcar (lambda (cons) 58 | (cons (cdr cons) (car cons))) 59 | alist)) 60 | 61 | (defmacro rsublis (alist &rest rest) 62 | "[Cyc] Like SUBLIS except ALIST is interpreted as (VALUE . KEY) pairs" 63 | `(sublis (reverse-alist-pairs ,alist) ,@rest)) 64 | 65 | (defmacro nrsublis (alist &rest rest) 66 | "[Cyc] Like NSUBLIS except ALIST is interpreted as (VALUE . KEY) pairs" 67 | `(nsublis (reverse-alist-pairs ,alist) ,@rest)) 68 | 69 | (defun elapsed-universal-time (past-time &optional (current-time (get-universal-time))) 70 | (- current-time past-time)) 71 | 72 | (defun ensure-physical-pathname (pathname) 73 | "[Cyc] Convert PATHNAME to a physical pathname (performing any logical pathname translations)" 74 | (truename pathname)) 75 | 76 | (defmacro member? (item list &optional (test '#'eql) (key '#'identity)) 77 | `(member ,item ,list 78 | ,@(and test `(:test ,test)) 79 | ,@(and key `(:key ,key)))) 80 | 81 | ;; PERFORMANCE - do we assume fixnum for subl-level code? 82 | (defun* positive-integer-p (obj) 83 | (:inline t) 84 | (typep obj '(integer 1))) 85 | 86 | (defun* non-negative-integer-p (obj) 87 | (:inline t) 88 | (typep obj '(integer 0))) 89 | -------------------------------------------------------------------------------- /larkc-cycl/system-info.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | (deflexical *cyc-home-directory* #P"./" 45 | "[Cyc] The pathname for the cyc home directory (suitable for use with MERGE-PATHNAMES)") 46 | 47 | (defglobal *available-cyc-features* nil) 48 | 49 | ;; Check for feature, that will always be nil? 50 | (defun cyc-opencyc-feature () 51 | nil) 52 | 53 | (defun cyc-revision-string () 54 | "[Cyc] Returns the current Cyc revision numbers expressed as a period-delimited string" 55 | *cyc-revision-string*) 56 | 57 | (defun cyc-revision-numbers () 58 | "[Cyc] Returns a list of the current Cyc revision numbers" 59 | *cyc-revision-numbers*) 60 | 61 | (defglobal *cycl-start-time* nil) 62 | 63 | (defun reset-cycl-start-time (&optional (universal-time (get-universal-time))) 64 | (setf *cycl-start-time* universal-time)) 65 | 66 | (defglobal *subl-initial-continuation* nil 67 | "[Cyc] Backpointer for the original SubL initial continuation.") 68 | 69 | 70 | -------------------------------------------------------------------------------- /larkc-cycl/tcp-server-utilities.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | ;; TODO - all the missing-larkc in this file should be easily implementable. 45 | ;; TODO - this originally SubL file has functionality overlap with port mappings that the originally Java tcp.lisp file has. Combine the two. 46 | 47 | (deflexical *tcp-server-lock* (bt:make-lock "TCP Server Lock")) 48 | 49 | (defparameter *remote-address* nil 50 | "[Cyc] Within a TCP server handler, this is bound to an integer representing the socket's remote machine IP address.") 51 | 52 | (defparameter *remote-hostname* nil 53 | "[Cyc] WIthin a TCP server handler, this is bound to a string representing the socket's remote machine hostname") 54 | 55 | (defun tcp-port-p (object) 56 | "[Cyc] Return T iff OBJECT is a valid integer for a TCP port." 57 | (and (fixnump object) 58 | (eq object (logand 65535 object)))) 59 | 60 | (defun enable-tcp-server (type port) 61 | "[Cyc] Enable a new TCP server of TYPE bound to PORT. 62 | TYPE must have already been declared via DEFINE-TCP-SERVER. 63 | Any TCP server currently bound to PORT is first disabled." 64 | (when (> (disable-tcp-server port) 0) 65 | (sleep 1)) 66 | (let ((tcp-server (new-tcp-server type port))) 67 | (register-tcp-server tcp-server) 68 | tcp-server)) 69 | 70 | (defun disable-tcp-server (designator) 71 | "[Cyc] Disable all TCP servers specified by DESIGNATOR. 72 | Returns the total number of servers disabled. 73 | If DESIGNATOR is a TCP-SERVER-P, disable that server. 74 | If DESIGNATOR is a TCP-PORT-P, disable the server at that port. 75 | Otherwise, disable all servers with DESIGNATOR as their type." 76 | (cond 77 | ((tcp-server-p designator) (missing-larkc 31593)) 78 | ((tcp-port-p designator) (alexandria:if-let ((tcp-server (find-tcp-server-by-port designator))) 79 | (disable-tcp-server tcp-server) 80 | 0)) 81 | (t (missing-larkc 31597)))) 82 | 83 | (defun validate-all-tcp-servers () 84 | (missing-larkc 31596)) 85 | 86 | (defstruct (tcp-server (:conc-name "TCPS-")) 87 | type 88 | ;; NIL if disabled 89 | (port nil :type (or null fixnum)) 90 | process) 91 | 92 | (defun* tcp-server-port (tcp-server) (:inline t) 93 | "[Cyc] Return the port of TCP-SERVER, or NIL if disabled." 94 | (tcps-port tcp-server)) 95 | 96 | (defun new-tcp-server (type port) 97 | (let ((handler (tcp-server-type-handler type))) 98 | (make-tcp-server :type type 99 | :port port 100 | :process (start-tcp-server-process type port handler)))) 101 | 102 | (defglobal *all-tcp-servers* nil) 103 | 104 | (defun find-tcp-server-by-port (port) 105 | (find port *all-tcp-servers* :key #'tcp-server-port)) 106 | 107 | (defun all-tcp-servers () 108 | "[Cyc] Return a list of all TCP servers that are currently enabled." 109 | (copy-list *all-tcp-servers*)) 110 | 111 | (defun register-tcp-server (tcp-server) 112 | (bt:with-lock-held (*tcp-server-lock*) 113 | (push tcp-server *all-tcp-servers*))) 114 | 115 | (defglobal *tcp-server-type-table* nil) 116 | 117 | (defun register-tcp-server-type (type handler &optional (mode :text)) 118 | "[Cyc] Register that TCP servers of TYPE use HANDLER with MODE." 119 | (deregister-tcp-server-type type) 120 | (bt:with-lock-held (*tcp-server-lock*) 121 | (push (list type handler mode) *tcp-server-type-table*))) 122 | 123 | (defun deregister-tcp-server-type (type) 124 | (bt:with-lock-held (*tcp-server-lock*) 125 | (deletef type *tcp-server-type-table* :key #'first))) 126 | 127 | (defun tcp-server-type-handler (type) 128 | (second (find type *tcp-server-type-table* :key #'first))) 129 | 130 | (defun start-tcp-server-process (type port handler) 131 | "[Cyc] Method for starting a new TCP server of TYPE at PORT which has HANDLER." 132 | (declare (ignore type)) 133 | (start-tcp-server port handler)) 134 | -------------------------------------------------------------------------------- /larkc-cycl/tcp.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | ;; Originally larkc-3.0/src/main/java/com/cyc/tool/subl/jrtl/nativeCode/subLisp/Tcp.java 43 | 44 | (defvar *retain-client-socket?* nil) 45 | (defvar *tcp-localhost-only? nil) 46 | (defvar *remote-hostname* nil) 47 | (defvar *remote-address* nil) 48 | 49 | (defvar *port-to-server-socket-process-map* (make-hash-table :synchronized t) 50 | "Maps numeric port to usocket listener socket") 51 | 52 | (defun open-tcp-stream (host port) 53 | ;; java.net.ServerSocket deals with bytes 54 | (usocket:socket-connect host port :element-type '(unsigned-byte 8))) 55 | 56 | (defun start-tcp-server (port handler) 57 | ;; TODO - test what the handler protocol is. usocket passes a stream object to it. The java interface seems to pass the stream into it twice, maybe a reader & writer stream separately? 58 | ;; TODO - Error capture & reporting? The Java SafeRunnable seems to just enable Lisp conditions to catch exceptions, and print errors to stdout if not caught. 59 | ;; socket-server returns the thread & the socket, when multithreading is enabled 60 | (let ((socket (nth-value 1 (usocket:socket-server 61 | nil port handler nil 62 | :multi-threading t 63 | :name (format nil "Socket Server (port: ~a handler: ~a" 64 | port handler))))) 65 | (setf (gethash port *port-to-server-socket-process-map*) socket))) 66 | 67 | (defun stop-tcp-server (port) 68 | (or (sb-ext:with-locked-hash-table (*port-to-server-socket-process-map*) 69 | (gethash-and-remove port *port-to-server-socket-process-map*)) 70 | (error "~s is not a TCP server port designator." port))) 71 | 72 | -------------------------------------------------------------------------------- /larkc-cycl/unrepresented-term-index-manager.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | (defglobal *unrepresented-term-index-manager* :uninitialized 40 | "[Cyc] The KB object manager for unrepresented-term indices.") 41 | 42 | (deflexical *unrepresented-term-index-lru-size-percentage* 10 43 | "[Cyc] Wild guess.") 44 | 45 | (defun setup-unrepresented-term-index-table (size exact?) 46 | (setf *unrepresented-term-index-manager* (new-kb-object-manager "unrepresented-term-index" size 47 | *unrepresented-term-index-lru-size-percentage* 48 | #'load-unrepresented-term-index-from-cache exact?))) 49 | 50 | (defun* clear-unrepresented-term-index-table () (:inline t) 51 | (clear-kb-object-content-table *unrepresented-term-index-manager*)) 52 | 53 | (defun* cached-unrepresented-term-index-count () (:inline t) 54 | "[Cyc] Return the number of unrepresented-term-indices whose content is cached in memory." 55 | (cached-kb-object-count *unrepresented-term-index-manager*)) 56 | 57 | (defun* lookup-unrepresented-term-index (id) (:inline t) 58 | (lookup-kb-object-content *unrepresented-term-index-manager* id)) 59 | 60 | (defun* register-unrepresented-term-index (id unrepresented-term-index) (:inline t) 61 | "[Cyc] Note that ID will be used as the id for UNREPRESENTED-TERM-INDEX." 62 | (register-kb-object-content *unrepresented-term-index-manager* id unrepresented-term-index)) 63 | 64 | (defun* deregister-unrepresented-term-index (id) (:inline t) 65 | "[Cyc] Note that ID is not in use as an UNREPRESENTED-TERM-INDEX id." 66 | (deregister-kb-object-content *unrepresented-term-index-manager* id)) 67 | 68 | (defun* mark-unrepresented-term-index-as-muted (id) (:inline t) 69 | (mark-kb-object-content-as-muted *unrepresented-term-index-manager* id)) 70 | 71 | (defun* swap-out-all-pristine-unrepresented-term-indices () (:inline t) 72 | (swap-out-all-pristine-kb-objects-int *unrepresented-term-index-manager*)) 73 | 74 | (defun initialize-unrepresented-term-index-hl-store-cache () 75 | (initialize-kb-object-hl-store-cache *unrepresented-term-index-manager* 76 | "unrepresented-term-indices" 77 | "unrepresented-term-indices-index")) 78 | -------------------------------------------------------------------------------- /larkc-cycl/variables.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | 40 | (defconstant *hl-variable-prefix-char* #\? 41 | "[Cyc] The character used as the first character of an HL variable's name.") 42 | 43 | (defconstant *default-el-variable-prefix* "?VAR" 44 | "[Cyc] The prefix for all default EL vars. By no coincidence, it is the upcase version of the prefix in PRINT-VARIABLE.") 45 | 46 | (defstruct (variable (:conc-name "VAR-")) 47 | id) 48 | 49 | (defmethod sxhash ((object variable)) 50 | (or (var-id object) 51 | 99)) 52 | 53 | (deflexical *variable-max* 200 54 | "[Cyc] The total number of interned HL variables.") 55 | 56 | (defglobal *variable-array* nil) 57 | 58 | (defun* get-variable (num) (:inline t) 59 | "[Cyc] Return HL variable number NUM." 60 | (aref *variable-array* num)) 61 | 62 | (defun setup-variable-table () 63 | "[Cyc] Setup the array of interned HL variables." 64 | ;; TODO - Lazy initialization might be after *variable-max* is updated. Else, allocate it up front. 65 | (unless *variable-array* 66 | (setf *variable-array* (prog1-let ((array (make-vector *variable-max*))) 67 | (dotimes (i *variable-max*) 68 | (setf (aref array i) 69 | (make-variable :id i))))))) 70 | 71 | (defun* variable-id (variable) (:inline t) 72 | "[Cyc] Return ID of HL variable VARIABLE." 73 | (var-id variable)) 74 | 75 | ;; TODO - obsolete 76 | (defun* find-variable-by-id (id) (:inline t) 77 | "[Cyc] Return the HL variable wiht ID, or NIL if not present." 78 | (get-variable id)) 79 | 80 | (defun* variable-< (var1 var2) (:inline t) 81 | (< (variable-id var1) 82 | (variable-id var2))) 83 | 84 | (defun-memoized default-el-var-for-hl-var (variable) 85 | (:test eq 86 | :doc "[Cyc] Return a readable EL var from HL var VARIABLE.") 87 | (make-el-var (prin1-to-string variable))) 88 | 89 | (defun* sort-hl-variable-list (hl-variable-list) (:inline t) 90 | (sort hl-variable-list #'variable-<)) 91 | 92 | (defun* fully-bound-p (object) (:inline t) 93 | "[Cyc] Return T iff OBJECT contains no HL variables, and therefore is fully bound." 94 | (not (not-fully-bound-p object))) 95 | 96 | (defun not-fully-bound-p (object) 97 | "[Cyc] Return T iff OBJECT contains some HL variable, and therefore is not fully bound." 98 | (if (atom object) 99 | (variable-p object) 100 | ;; TODO - this is a form of SOME that also tests the dotted value? 101 | (do* ((rest object (cdr rest)) 102 | (next (car rest) (car rest))) 103 | ((atom (cdr rest)) 104 | (or (not-fully-bound-p next) 105 | (variable-p (cdr rest))))))) 106 | 107 | (defun* cycl-ground-expression-p (expression) (:inline t) 108 | (not (expression-find-if #'cyc-var? expression))) 109 | 110 | -------------------------------------------------------------------------------- /larkc-cycl/vector-utilities.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | 38 | 39 | 40 | 41 | (in-package :clyc) 42 | 43 | 44 | (defun vector-elements (vector &optional (start-index 0)) 45 | "[Cyc] Convert VECTOR to a list of its elements." 46 | (loop for index from start-index below (length vector) 47 | collect (aref vector index))) 48 | 49 | (defun extend-vector-to (vector new-length &optional initial-value) 50 | (let ((new-vector (make-vector new-length initial-value))) 51 | (replace new-vector vector) 52 | new-vector)) 53 | 54 | -------------------------------------------------------------------------------- /larkc-cycl/virtual-indexing.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | ;; TODO - this file is all about the :overlap indexing style, which was quite missing-larkc in kb-indexing.lisp 40 | 41 | (defparameter *index-overlap-enabled?* t) 42 | 43 | (defun good-term-for-overlap-index-p (object) 44 | (or (indexed-term-p object) 45 | (and (not (consp object)) 46 | (subl-atomic-term-p object)))) 47 | 48 | (deflexical *lookup-overlap-watermark* 50 49 | "[Cyc] The minimum cost, below which it's not even worth it to try the overlap method.") 50 | 51 | (deflexical *overlap-index-expense-multiplier* 7 52 | "[Cyc] Overlap index is this many times more expensive than other methods, due to additional consing and multiple passes. This value was determined by experiments in August 2005 and should be periodically updated.") 53 | 54 | (defun lookup-should-use-index-overlap? (formula &optional best-count) 55 | "[Cyc] Return T iff overlap will probably yield a better-focused search than any other kind of indexing. 56 | BEST-COUNT: The smallest count of assertions indexed via the best other index." 57 | (cond 58 | ((not *index-overlap-enabled?*) nil) 59 | ((and best-count 60 | (< best-count *lookup-overlap-watermark*)) 61 | nil) 62 | ((too-few-terms-for-index-overlap? formula) nil) 63 | ((and best-count 64 | (all-mts-are-relevant?)) 65 | (missing-larkc 6920)) 66 | (t t))) 67 | 68 | (defun too-few-terms-for-index-overlap? (formula) 69 | (cond 70 | ((contains-subformula-p formula) nil) 71 | ((not (indexed-term-p (formula-operator formula))) t) 72 | (t (let ((num-indexed-args 0) 73 | (args (formula-args formula :ignore))) 74 | (dolist (arg args) 75 | (when (good-term-for-overlap-index-p arg) 76 | (incf num-indexed-args))) 77 | (<= num-indexed-args 1))))) 78 | -------------------------------------------------------------------------------- /larkc-cycl/wff-macros.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Copyright (c) 2019-2020 White Flame 3 | 4 | This file is part of Clyc 5 | 6 | Clyc is free software: you can redistribute it and/or modify 7 | it under the terms of the GNU Affero General Public License as published by 8 | the Free Software Foundation, either version 3 of the License, or 9 | (at your option) any later version. 10 | 11 | Clyc is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU Affero General Public License for more details. 15 | 16 | You should have received a copy of the GNU Affero General Public License 17 | along with Clyc. If not, see . 18 | 19 | This file derives from work covered by the following copyright 20 | and permission notice: 21 | 22 | Copyright (c) 1995-2009 Cycorp Inc. 23 | 24 | Licensed under the Apache License, Version 2.0 (the "License"); 25 | you may not use this file except in compliance with the License. 26 | You may obtain a copy of the License at 27 | 28 | http://www.apache.org/licenses/LICENSE-2.0 29 | 30 | Unless required by applicable law or agreed to in writing, software 31 | distributed under the License is distributed on an "AS IS" BASIS, 32 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 33 | See the License for the specific language governing permissions and 34 | limitations under the License. 35 | |# 36 | 37 | (in-package :clyc) 38 | 39 | (defun* within-wff? () (:inline t) 40 | "[Cyc] Return T iff currently within wff checking." 41 | *within-wff?*) 42 | 43 | ;; TODO - where's the defun-memoized that matches this? 44 | (defun* possibly-new-wff-memoization-state () (:inline t) 45 | (or *wff-memoization-state* 46 | (new-memoization-state))) 47 | 48 | (defun new-wff-special-variable-state (properties) 49 | (check-wff-properties properties) 50 | (let ((svs (new-special-variable-state nil))) 51 | (dohash (indicator data (wff-properties-table)) 52 | (destructuring-bind (var default) data 53 | (when var 54 | (let ((desired-value (getf properties indicator default))) 55 | (unless (equal desired-value default) 56 | (missing-larkc 31672)))))) 57 | svs)) 58 | --------------------------------------------------------------------------------