Merge pull request #20 from telekons/cset

Character sets

Code/Compiler/code-generation.lisp

@@ -162,7 +162,7 @@
                                  for n from 0
                                  collect (alexandria:format-symbol nil "TRANSITION-~d" n))))
             `(tagbody
-                (isum-case value
+                (csum-case value
                     ,(layout-less *layout*)
                     ,(layout-equal *layout*)
                   ,@(loop for transition in (state-transitions state)

Code/DFA-construction/derivative-classes.lisp

@@ -5,7 +5,7 @@
   (let ((sets (make-hash-table :test 'equal)))
     (loop for set1 in sets1
           do (loop for set2 in sets2
-                   for intersection = (set-intersection set1 set2)
+                   for intersection = (csum-intersection set1 set2)
                    do (setf (gethash intersection sets) t)))
     (alexandria:hash-table-keys sets)))
 
@@ -16,7 +16,7 @@
   "Produce a list of the 'classes' (sets) of characters that compiling the regular expression would have to dispatch on."
   (with-hash-consing (*derivative-classes* re)
     (trivia:ematch re
-      ((literal set)  (list set (set-inverse set)))
+      ((literal set) (list set (csum-complement set)))
       ((or (empty-string)
            (tag-set _))
        (list +universal-set+))

Code/DFA-construction/derivative.lisp

@@ -8,7 +8,7 @@
     (trivia:ematch re
       ((or (empty-string) (empty-set) (tag-set _)) (empty-set))
       ((literal matching-set)
-       (if (set-null (set-intersection matching-set set))
+       (if (csum-null-p (csum-intersection matching-set set))
            (empty-set)
            (empty-string)))
       ((join r s)
@@ -69,7 +69,7 @@
                      do (setf (gethash target variables) value))))
         (map 'nil
              (lambda (element)
-               (let* ((new-re (derivative re (symbol-set (char-code element))))
+               (let* ((new-re (derivative re (singleton-set (char-code element))))
                       (effects (remove-if (lambda (x) (equal (car x) (cdr x)))
                                           (effects re))))
                  (format t "~&~a~&  ~:c ~a"

Code/DFA-construction/make-dfa.lisp

@@ -50,8 +50,8 @@
              (state-transitions last-state)))
       (t
        (setf (transition-class same-transition)
-             (set-union (transition-class same-transition)
-                        class))))))
+             (csum-union (transition-class same-transition)
+                         class))))))
 
 (trivia:defun-match re-stopped-p (re)
   ((alpha (empty-set) _) t)
@@ -104,7 +104,7 @@
             (t
              (let ((classes (derivative-classes expression)))
                (dolist (class classes)
-                 (unless (set-null class)
+                 (unless (csum-null-p class)
                    (let* ((next-expression (derivative expression class))
                           (tags-to-set (keep-used-assignments
                                         next-expression

Code/DFA-construction/re-types.lisp

@@ -14,19 +14,18 @@
 
 (define-rewrites (literal set)
   :printer ((literal set)
-            (print-isum set stream)))
+            (print-csum set stream)))
 
 (defun kleene (r)
   (repeat r 0 nil nil))
 (trivia:defpattern kleene (r)
   `(repeat ,r 0 nil nil))
 
-(defun empty-set ()
-  (literal (symbol-set)))
+(defun empty-set () (literal +empty-set+))
 (trivia:defpattern empty-set ()
   (alexandria:with-gensyms (set)
     `(trivia:guard (literal ,set)
-                   (set-null ,set))))
+                   (csum-null-p ,set))))
 
 (defun universal-set ()
   (repeat (literal +universal-set+) 0 nil nil))
@@ -94,7 +93,7 @@
              ((either (empty-set) r) r)
              ((either r (empty-set)) r)
              ((either (literal s1) (literal s2))
-              (literal (set-union s1 s2)))
+              (literal (csum-union s1 s2)))
              ((either r (universal-set))
               (if (has-tags-p r)
                   (trivia.next:next)    ; Preserve tags then
@@ -144,7 +143,7 @@
              ((both (empty-string) (tag-set s))
               (tag-set s))
              ((both (literal s1) (literal s2))
-              (literal (set-intersection s1 s2))))
+              (literal (csum-intersection s1 s2))))
   :printer ((both r s)
             (format stream "(~a) ∩ (~a)" r s)))
 (define-rewrites (invert r)
@@ -186,7 +185,7 @@
 (defun text (vector)
   (reduce #'join (map 'vector
                       (lambda (e)
-                        (literal (symbol-set (char-code e))))
+                        (literal (singleton-set (char-code e))))
                       vector)
           :initial-value (empty-string) 
           :from-end t))