summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorpukkamustard <pukkamustard@posteo.net>2020-09-21 17:16:22 +0200
committerpukkamustard <pukkamustard@posteo.net>2020-09-21 17:16:22 +0200
commitdfcea3ff22ecfb2bdf3b32b9de7a04fa6183aedc (patch)
tree924c2df74ab136e4a0cfe3994944f2f22954e29f
parenta336ca8e5564a09133e4d0a548f8b1cdcad70eee (diff)
(schemantic lvar): move logical variables to own module and allow named variables
-rw-r--r--Makefile.am2
-rw-r--r--hall.scm2
-rw-r--r--schemantic/lvar.scm37
-rw-r--r--schemantic/rdf.scm23
-rw-r--r--tests/schemantic/lvar.scm26
5 files changed, 72 insertions, 18 deletions
diff --git a/Makefile.am b/Makefile.am
index 31ee4c1..20f8177 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -42,6 +42,7 @@ SOURCES = schemantic.scm \
schemantic/rdf/lang-string.scm \
schemantic/iri.scm \
schemantic/literal.scm \
+ schemantic/lvar.scm \
schemantic/blank-node.scm \
schemantic/xsd.scm \
schemantic/rdf.scm \
@@ -55,6 +56,7 @@ TESTS = tests/schemantic/graph/vhash.scm \
tests/schemantic/serializaton/turtle.scm \
tests/schemantic/iri.scm \
tests/schemantic/literal.scm \
+ tests/schemantic/lvar.scm \
tests/schemantic/fragment-graph.scm
TEST_EXTENSIONS = .scm
diff --git a/hall.scm b/hall.scm
index 4b2b999..9ff9cb9 100644
--- a/hall.scm
+++ b/hall.scm
@@ -26,6 +26,7 @@
(directory "rdf" ((scheme-file "lang-string")))
(scheme-file "iri")
(scheme-file "literal")
+ (scheme-file "lvar")
(scheme-file "blank-node")
(scheme-file "xsd")
(scheme-file "rdf")
@@ -45,6 +46,7 @@
((scheme-file "turtle")))
(scheme-file "iri")
(scheme-file "literal")
+ (scheme-file "lvar")
(scheme-file "fragment-graph")))))))
(programs ((directory "scripts" ())))
(documentation
diff --git a/schemantic/lvar.scm b/schemantic/lvar.scm
new file mode 100644
index 0000000..5e587ce
--- /dev/null
+++ b/schemantic/lvar.scm
@@ -0,0 +1,37 @@
+; SPDX-FileCopyrightText: 2020 pukkamustard <pukkamustard@posteo.net>
+;
+; SPDX-License-Identifier: GPL-3.0-or-later
+
+(define-module (schemantic lvar)
+ #:use-module (oop goops)
+
+ #:use-module (schemantic iri)
+
+ #:use-module (ice-9 format)
+
+ #:export (<lvar>
+ lvar
+ lvar?))
+
+;; Logical Variable
+
+(define-class <lvar> (<term>)
+ (name #:init-keyword #:name #:init-value #f #:getter lvar-name))
+
+(define-method (write (self <lvar>) port)
+ (if (lvar-name self)
+ (format port "?~a" (lvar-name self))
+ (format port "<lvar ~x>" (object-address self))))
+
+(define-method (equal? (x <lvar>) (y <lvar>))
+ (if (and (lvar-name x) (lvar-name y))
+ (equal? (lvar-name x) (lvar-name y))
+ (next-method)))
+
+(define lvar
+ (case-lambda
+ (() (make <lvar>))
+ ((name) (make <lvar> #:name name))))
+
+(define (lvar? x)
+ (is-a? x <lvar>))
diff --git a/schemantic/rdf.scm b/schemantic/rdf.scm
index 6fe3c9c..38727e6 100644
--- a/schemantic/rdf.scm
+++ b/schemantic/rdf.scm
@@ -7,6 +7,7 @@
#:use-module (schemantic iri)
#:use-module (schemantic literal)
+ #:use-module (schemantic lvar)
#:use-module (schemantic xsd)
#:use-module (schemantic rdf lang-string)
@@ -19,10 +20,6 @@
triple-predicate
triple-object
- <lvar>
- lvar
- lvar?
-
<graph>
graph?
graph-add
@@ -50,6 +47,10 @@
literal-datatype
literal-language
+ <lvar>
+ lvar
+ lvar?
+
<generic-literal>
make-generic-literal
@@ -83,20 +84,6 @@
(define (triple? x)
(is-a? x <triple>))
-
-;; Variable
-
-(define-class <lvar> (<term>))
-
-(define-method (write (self <lvar>) port)
- (format port "<lvar ~x>" (object-address self)))
-
-(define (lvar)
- (make <lvar>))
-
-(define (lvar? x)
- (is-a? x <lvar>))
-
;; Graph
;; A graph is an arbirtary container of triples. It can be an in-memory structure or a connection to a database.
diff --git a/tests/schemantic/lvar.scm b/tests/schemantic/lvar.scm
new file mode 100644
index 0000000..77cd3df
--- /dev/null
+++ b/tests/schemantic/lvar.scm
@@ -0,0 +1,26 @@
+; SPDX-FileCopyrightText: 2020 pukkamustard <pukkamustard@posteo.net>
+;
+; SPDX-License-Identifier: GPL-3.0-or-later
+
+(define-module (tests schemantic lvar)
+ #:use-module (oop goops)
+
+ #:use-module (schemantic rdf)
+
+ #:use-module (srfi srfi-64))
+
+(test-begin "lvar")
+
+(test-assert "can create a lvar"
+ (lvar? (lvar)))
+
+(test-assert "unnamed lvars are not equal"
+ (not (equal? (lvar) (lvar))))
+
+(test-assert "named lvars are equal if they have equal names"
+ (equal? (lvar 'a) (lvar 'a)))
+
+(test-assert "named lvars are not equal if they have different names"
+ (not (equal? (lvar 'a) (lvar 'b))))
+
+(test-end "lvar")