guile-rdf

Julien LepillerFri Apr 03 00:25:18+0200 2020

1e96e06

All turtle tests now pass

iri/iri.scm

                 (loop
                   (if add-slash?
                       (string-join (cons "" (cdr (cdr segments))) "/")
                       (string-join (cdr segments)))
                       (string-join (cons "" (cdr segments)) "/"))
                   (if add-slash?
                       (string-append output "/" segment)
                       (string-append output segment)))))))))

rdf/rdf.scm

          #f))))
 (define (merge-joins l1 l2)
   (match l1
     ('() l2)
     ((e1 l1 ...)
      (merge-joins l1 (map (lambda (e2) (append e1 e2)) l2)))))
   (cond
     ((null? l1) l2)
     ((null? l2) l1)
     (else
       (fold
         (lambda (e1 res)
           (append
             (map (lambda (e2)
                    (append e1 e2))
                  l2)
             res))
         '()
         l1))))
 (define (to-disjunctions constraints)
   (match constraints
     (('equiv b1 b2) (list (list (cons b1 b2))))
     ('none (list (list)))
     (('or e1 e2) (append (to-disjunctions e1) (to-disjunctions e2)))
     (('or e1 e2)
      (cond
        ((equal? e2 'bot)
         (to-disjunctions e1))
        ((equal? e1 'bot)
         (to-disjunctions e2))
        (else
          (let ((e1 (to-disjunctions e1))
                (e2 (to-disjunctions e2)))
            (append e1 e2)))))
     (('and e1 e2)
      (merge-joins (to-disjunctions e1) (to-disjunctions e2)))))
      (cond
        ((equal? e1 'bot)
         'bot)
        ((equal? e2 'bot)
         'bot)
        (else
          (let ((e1 (to-disjunctions e1))
                (e2 (to-disjunctions e2)))
            (merge-joins e1 e2)))))))
 (define (generate-triple-constraints t1 t2)
   (match t1
 (define (generate-constraints t1 g2)
   (match g2
     ('() 'none)
     ('() 'bot)
     ((t2 g2 ...)
      (let ((c (generate-triple-constraints t1 t2)))
        (if c
           (validate-mapping mapping g1 g2)))))
 (define (rdf-isomorphic? g1 g2)
   "Compare two graphs and return whether they are isomorphic."
   "Compare two graphs and return whether they are isomorph."
   (let* ((constraints (fold (lambda (t constraints)
                               (list 'and (generate-constraints t g2) constraints))
                             'none g1))
          (disjunctions (to-disjunctions constraints)))
     (pk 'dis disjunctions)
     (let loop ((disjunctions disjunctions))
       (match disjunctions
       (match (filter sat? disjunctions)
         ('() (and (null? g1) (null? g2)))
         ((mapping disjunctions ...)
          (if (and (validate-mapping mapping g1 g2)

turtle/tordf.scm

   (update-parser-state state
     #:namespaces (cons (cons ns iri) (parser-state-namespaces state))))
 (define (parse-string str)
 (define* (parse-string str #:optional for-iri?)
   (match str
     ((? string? str) str)
     ((component str ...)
           (parse-string str)))))
     (() "")))
 (define (valid-iri? iri)
   (and (not (string-any (ucs-range->char-set 0 33) iri))
        (not (string-any #\< iri))
        (not (string-any #\> iri))))
 (define (parse-iri iri state)
   (pk 'iri iri)
   (match iri
     (('iri ('prefixed-name ('pname-ln ('pname-ns ns) ('pn-local suffix))))
      `(("iri" . ,(string-append (assoc-ref (parser-state-namespaces state) ns)
      `(("iri" . ,(resolve-iri (parser-state-base-uri state) ""))
        ("state" . ,state)))
     (('iri ('iriref iri ...))
      `(("iri" . ,(resolve-iri (parser-state-base-uri state) (parse-string iri)))
        ("state" . ,state)))))
      (let ((iri (resolve-iri (parser-state-base-uri state) (parse-string iri))))
        (if (valid-iri? iri)
            `(("iri" . ,iri)
              ("state" . ,state))
            (throw 'invalid-iri iri))))))
 (define (parse-verb verb state)
   (match verb