;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: FSet -*- ;;; File: reader.lisp ;;; Contents: Reader macros and supporting code for FSet ;;; ;;; This file is part of FSet. Copyright (c) 2007 Sympoiesis, Inc. ;;; FSet is licensed under the Lisp Lesser GNU Public License, or LLGPL. ;;; See: http://opensource.franz.com/preamble.html ;;; This license provides NO WARRANTY. (in-package :fset) ;;; This file defines two different kinds of convenience syntax for constructing ;;; the FSet datatypes: constructor macros, and reader macros that expand to ;;; invocations of the constructor macros. ;;; ;;; Each constructor macro has the same name as the type it constructs (making ;;; them somewhat like `cl:list', but with some additional features). Some ;;; examples: ;;; ;;; (set 1 2) => set containing 1 and 2 ;;; (let ((x 3)) (set 1 2 x)) => set containing 1, 2, and 3 ;;; (let ((s (set 1 2))) (set 3 ($ s) 4)) => set containing 1, 2, 3, and 4 ;;; (bag (% 11 3)) => bag with 3 occurrences of 11 ;;; (let ((b (bag 17))) (bag ($ b) 13 (% 17 2))) ;;; => bag w/ 1 occ. of 13, 3 occs. of 17 ;;; (map (2 47) (3 23)) => map from 2 to 47 and 3 to 23 ;;; (let ((m (map (2 47) (3 23)))) (map ($ m) (2 61))) ;;; => map from 2 to 61 and 3 to 23 ;;; ;;; For complete documentation, see the documentation strings below. ;;; ;;; The reader macros expand directly into invocations of the constructor macros, ;;; so the syntax is similar. Loading this file does _not_ cause these macros ;;; to be defined in the current readtable; see `fset-setup-readtable' below. ;;; ;;; Set syntax: ;;; ;;; #{
* } ;;; ;;; Any form can be prefixed with `#$' to indicate that it is to be a subset ;;; rather than an element. Note that, unlike in quoted lists and `#(...)', the ;;; forms are evaluated. Examples: ;;; ;;; #{ 1 2 3 } ;;; #{ 1 2 x } ; X is evaluated! ;;; #{ 1 2 #$x } ; equivalent to `(union x #{1 2})' ;;; ;;; Bag syntax: ;;; ;;; #{% * %} ;;; ;;; The subexpressions are either forms, as in the set case, or expressions of the ;;; form `#%( )', indicating occurrences of . ;;; The forms are all evaluated. Any form may be prefixed with `#$' to indicate ;;; that it is a subbag rather than an element; the subbags are combined with ;;; `bag-sum'. ;;; ;;; Map syntax: ;;; ;;; #{| * |} ;;; ;;; where each subexpression is either a pair is written as a list of two forms, or a ;;; use of the `#$' notation. Again, the forms are all evaluated. Examples: ;;; ;;; #{| (1 2) (3 'x) |} ; maps 1 to 2, and 3 to the value of X ;;; #{| #$x (1 2) |} ; equivalent to `(map-merge x #{| (1 2) |})' ;;; ;;; In any case where multiple values are provided for the same key, the rightmost ;;; subexpression takes precedence. ;;; ;;; Sequence syntax: ;;; ;;; #[ * ] ;;; ;;; Any form can be prefixed with `#$' to indicate that it is to be a subsequence ;;; rather than a member. Note that, unlike in quoted lists and `#(...)', the ;;; forms are evaluated. Examples: ;;; ;;; #[ 1 2 3 ] ;;; #[ 1 2 x ] ; X is evaluated! ;;; #[ 1 2 #$x ] ; equivalent to `(concat #[1 2] x)' ;;; ;;; These examples are all written with spaces immediately inside the delimiters, ;;; but they are not required. ;;; ;;; Tuple syntax: ;;; ;;; #< * > ;;; ;;; where each subexpression is either a pair is written as a list of two forms, ;;; or a use of the `#$' notation. Again, the forms are all evaluated; the keys ;;; must all be instances of `tuple-key'. Examples: ;;; ;;; #< (k1 2) (k3 'x) > ; maps k1 to 2, and k3 to the value of X ;;; #{| #$x (k1 2) |} ; equivalent to `(tuple-merge x #< (1 2) >)' ;;; ;;; In any case where multiple values are provided for the same key, the rightmost ;;; subexpression takes precedence. ;;; (defmacro set (&rest args) "As a type: the FSet set type. As a macro: constructs a set according to the supplied argument subforms. Each argument subform can be an expression, whose value will be a member of the result set; or a list of the form ($ ), in which case the expression must evaluate to a set, all of whose members become members of the result set." (let ((normal-args (remove-if #'(lambda (arg) (and (listp arg) (eq (car arg) '$))) args)) (splice-args (remove-if-not #'(lambda (arg) (and (listp arg) (eq (car arg) '$))) args)) ((start (if normal-args `(convert 'set (list . ,normal-args)) `(empty-set))))) (labels ((recur (splice-args result) (if (null splice-args) result `(union ,(cadar splice-args) ,result)))) (recur splice-args start)))) (defmacro bag (&rest args) "As a type: the FSet bag type. As a macro: constructs a bag according to the supplied argument subforms. Each argument subform can be an expression, whose value will be added to the bag with multiplicity 1; or a list of the form ($ ), in which case the expression must evaluate to a bag (or a set), which is bag-summed into the result; or a list of the form (% ) (called a \"multi-arg\"), which indicates that the value of is bag-summed into the result with multiplicity given by the value of . That is, the multiplicity of each member of the result bag is the sum of its multiplicities as supplied by each of the argument subforms." (let ((normal-args (remove-if #'(lambda (arg) (and (listp arg) (member (car arg) '($ %)))) args)) (splice-args (remove-if-not #'(lambda (arg) (and (listp arg) (eq (car arg) '$))) args)) (multi-args (remove-if-not #'(lambda (arg) (and (listp arg) (eq (car arg) '%))) args)) ((start (if normal-args `(convert 'bag (list . ,normal-args)) `(empty-bag))))) (labels ((add-splice-args (splice-args result) (if (null splice-args) result `(bag-sum ,(cadar splice-args) ,(add-splice-args (cdr splice-args) result)))) (add-multi-args (multi-args result) (if (null multi-args) result (let ((m-arg (car multi-args))) (unless (and (listp m-arg) (= (length m-arg) 3)) (error "A multi-arg to the `~S' macro must be of the form ~ (% ) -- not ~S." 'bag m-arg)) `(with ,(add-multi-args (cdr multi-args) result) ,(second m-arg) ,(third m-arg)))))) (add-multi-args multi-args (add-splice-args splice-args start))))) (defmacro map (&rest args) "As a type: the FSet map type. As a macro: constructs a map according to the supplied argument subforms. Each argument subform can be a list of the form ( ), denoting a mapping from the value of to the value of ; or a list of the form ($ ), in which case the expression must evaluate to a map, denoting all its mappings. The result is constructed from the denoted mappings in left-to-right order; so if a given key is supplied by more than one argument subform, its associated value will be given by the rightmost such subform." (labels ((recur (args result) (cond ((null args) result) ((not (and (listp (car args)) (= (length (car args)) 2))) (error "Arguments to ~S must all be pairs expressed as 2-element ~@ lists, or ($ x) subforms -- not ~S." 'map (car args))) ((eq (caar args) '$) (if (equal result `(empty-map)) (recur (cdr args) (cadar args)) (recur (cdr args) `(map-merge ,result ,(cadar args))))) (t (recur (cdr args) `(with ,result ,(caar args) ,(cadar args))))))) (recur args `(empty-map)))) (defmacro seq (&rest args) "As a type: the FSet sequence type. As a macro: constructs a sequence according to the supplied argument subforms. Each argument subform can be an expression whose value is to appear in the sequence; or a list of the form ($ ), in which case the expression must evaluate to a sequence, all of whose values appear in the result sequence. The order of the result sequence reflects the order of the argument subforms." (labels ((recur (args nonsplice-args) (cond ((null args) (if nonsplice-args `(convert 'seq (list . ,(cl:reverse nonsplice-args))) `(empty-seq))) ((and (listp (car args)) (eq (caar args) '$)) (let ((rest (if (cdr args) `(concat ,(cadar args) ,(recur (cdr args) nil)) (cadar args)))) (if nonsplice-args `(concat (convert 'seq (list . ,(cl:reverse nonsplice-args))) ,rest) rest))) (t (recur (cdr args) (cons (car args) nonsplice-args)))))) (recur args nil))) (defmacro tuple (&rest args) "As a type: the FSet tuple type. As a macro: constructs a tuple according to the supplied argument subforms. Each argument subform can be a list of the form ( ), denoting a mapping from the value of to the value of ; or a list of the form ($ ), in which case the expression must evaluate to a tuple, denoting all its mappings. The result is constructed from the denoted mappings in left-to-right order; so if a given key is supplied by more than one argument subform, its associated value will be given by the rightmost such subform." (labels ((recur (args result) (cond ((null args) result) ((not (and (listp (car args)) (= (length (car args)) 2))) (error "Arguments to ~S must all be pairs expressed as 2-element ~@ lists, or ($ x) subforms -- not ~S." 'tuple (car args))) ((eq (caar args) '$) (if (equal result `(empty-tuple)) (recur (cdr args) (cadar args)) (recur (cdr args) `(tuple-merge ,result ,(cadar args))))) (t (recur (cdr args) `(with ,result ,(caar args) ,(cadar args))))))) (recur args `(empty-tuple)))) (defun |#{-reader| (stream subchar arg) (declare (ignore subchar arg)) (case (peek-char nil stream t nil t) (#\| (read-char stream t nil t) `(map . ,(prog1 (read-delimited-list #\| stream t) (unless (eql (read-char stream) #\}) (error "Incorrect #{| ... |} syntax"))))) (#\% (read-char stream t nil t) `(bag . ,(prog1 (read-delimited-list #\% stream t) (unless (eql (read-char stream) #\}) (error "Incorrect #{% ... %} syntax"))))) (otherwise `(set . ,(read-delimited-list #\} stream t))))) (defun |#[-reader| (stream subchar arg) (declare (ignore subchar arg)) `(seq . ,(read-delimited-list #\] stream t))) (defun |#$-reader| (stream subchar arg) (declare (ignore subchar arg)) `($ ,(read stream t nil t))) (defun |#%-reader| (stream subchar arg) (declare (ignore subchar arg)) `(% . ,(read stream t nil t))) (defun fset-setup-readtable (readtable) "Adds FSet reader macros to `readtable'. Returns `readtable'." (set-dispatch-macro-character #\# #\{ #'|#{-reader| readtable) (set-macro-character #\} (get-macro-character #\)) nil readtable) (set-dispatch-macro-character #\# #\[ #'|#[-reader| readtable) (set-macro-character #\] (get-macro-character #\)) nil readtable) (set-dispatch-macro-character #\# #\$ #'|#$-reader| readtable) (set-dispatch-macro-character #\# #\% #'|#%-reader| readtable) readtable) (defvar *fset-readtable* (fset-setup-readtable (copy-readtable nil)) "A copy of the standard readtable with FSet reader macros installed.")