facts-db/cl-facts/fact.lisp

• Show log

  Commit

• Hash : d2a039f8
  Author : Thomas de Grivel
  Date : 2023-06-23T08:06:46
  

  fix usl-compare

Download

• fact.lisp

• ;; cl-facts
  ;; Copyright 2011, 2023 Thomas de Grivel <thodg@kmx.io>
  ;;
  ;; Permission is hereby granted to use this software granted
  ;; the above copyright notice and this permission paragraph
  ;; are included in all copies and substantial portions of this
  ;; software.
  ;;
  ;; THIS SOFTWARE IS PROVIDED "AS-IS" WITHOUT ANY GUARANTEE OF
  ;; PURPOSE AND PERFORMANCE. IN NO EVENT WHATSOEVER SHALL THE
  ;; AUTHOR BE CONSIDERED LIABLE FOR THE USE AND PERFORMANCE OF
  ;; THIS SOFTWARE.
  
  (in-package :facts)
  
  ;;  Fact
  
  (deftype fact/l () '(cons t (cons t (cons t null))))
  
  (deftype fact/v () '(simple-vector 3))
  
  (defun make-fact/v (spec-or-subject &optional predicate (object nil object-p))
    (the fact/v
      (if object-p
          (make-array 3 :initial-contents (list spec-or-subject predicate object))
          (make-array 3 :initial-contents (the fact/l spec-or-subject)))))
  
  (defun fact/v-subject (f)
    (svref f 0))
  
  (defun fact/v-predicate (f)
    (svref f 1))
  
  (defun fact/v-object (f)
    (svref f 2))
  
  (deftype fact () '(or fact/v fact/l))
  
  (defun fact-subject (f)
    (when f
      (if (consp f)
          (first f)
          (svref f 0))))
  
  (defun fact-predicate (f)
    (when f
      (if (consp f)
          (second f)
          (svref f 1))))
  
  (defun fact-object (f)
    (when f
      (if (consp f)
          (third f)
          (svref f 2))))
  
  (defun fact-equal (a b)
    (and (equal (fact-subject   a) (fact-subject b))
         (equal (fact-predicate a) (fact-predicate b))
         (equal (fact-object    a) (fact-object b))))
  

Download