Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Should be enough functionality for a 1.0. Now to write a minimal READ…

…ME...
  • Loading branch information...
commit 2b55c8d6d7119f8a4cf6d6d24457f545e8217adb 1 parent 6019255
@Hexstream authored
View
48 info.lisp
@@ -0,0 +1,48 @@
+(in-package #:parse-number-range)
+
+;; Stupid repetition, but I've had enough.
+(defun kind (keyword &key (errorp t))
+ '(values kind new-direction new-limit-kind)
+ (case keyword
+ ((:from :downfrom :upfrom)
+ (multiple-value-call #'values
+ :from
+ (ecase keyword
+ (:from (values nil nil))
+ (:downfrom (values '- nil))
+ (:upfrom (values '+ nil)))))
+ ((:to :upto :downto :below :above)
+ (multiple-value-call #'values
+ :to
+ (ecase keyword
+ (:to (values nil :inclusive))
+ (:downto (values '- :inclusive))
+ (:upto (values '+ :inclusive))
+ (:below (values '+ :exclusive))
+ (:above (values '- :exclusive)))))
+ (:by (values :by nil nil))
+ (t (when errorp
+ (error "~S is not a for-as-arithmetic keyword." keyword)))))
+
+(defun flags (keyword &key (errorp t))
+ (multiple-value-call (lambda (kind &rest flags)
+ (declare (ignore kind))
+ (values-list flags))
+ (kind keyword :errorp errorp)))
+
+
+(defun flags-to-keywords (direction limit-kind)
+ '(values from-keyword to-keyword)
+ (cartesian-product-switch:cartesian-product-switch
+ ((ecase direction
+ + -)
+ (ecase limit-kind
+ (nil) :inclusive :exclusive))
+ ;; +
+ (values :from nil)
+ (values :from :to)
+ (values :from :below)
+ ;; -
+ (values :downfrom nil)
+ (values :from :downto)
+ (values :from :above)))
View
78 main.lisp → internals.lisp
@@ -127,81 +127,3 @@
(destructuring-bind (key value &rest rest) tail
(declare (ignore rest))
(funcall function key value))))
-
-(defun parse (range &key
- (extrasp nil)
- (clause-kinds-p extrasp)
- (clause-keywords-p extrasp)
- (clauses-alist-p extrasp))
- '(values from to limit-kind by direction
- &key clause-kinds clause-keywords clauses-alist)
- (multiple-value-bind (process-key-value
- finish-key-value
- process-extras
- finish-extras)
- (multiple-value-call #'values
- (%make-key-value-processor
- (lambda (kind)
- (error "Duplicate specification of kind ~S in range ~S."
- kind range)))
- (%make-extras-processor clause-kinds-p
- clause-keywords-p
- clauses-alist-p))
- (%map-plist (lambda (key value)
- (let ((kind (funcall process-key-value key value)))
- (funcall process-extras kind key)))
- range)
- (multiple-value-call #'values
- (funcall finish-key-value)
- (funcall finish-extras))))
-
-
-(defun %direction/limit-to-keywords (direction limit-kind)
- '(values from-keyword to-keyword)
- (cartesian-product-switch:cartesian-product-switch
- ((ecase direction
- + -)
- (ecase limit-kind
- (nil) :inclusive :exclusive))
- ;; +
- (values :from nil)
- (values :from :to)
- (values :from :below)
- ;; -
- (values :downfrom nil)
- (values :from :downto)
- (values :from :above)))
-
-(defun unparse (from to limit-kind by direction)
- (multiple-value-bind (from-keyword to-keyword)
- (%direction/limit-to-keywords direction limit-kind)
- ;; Backquote indented badly...
- (nconc (list from-keyword from)
- (when to-keyword
- (list to-keyword to))
- (when (and by (/= by 1))
- (list :by by)))))
-
-;; Stupid repetition, but I've had enough.
-(defun kind (keyword &key (errorp t))
- '(values kind new-direction new-limit-kind)
- (case keyword
- ((:from :downfrom :upfrom)
- (multiple-value-call #'values
- :from
- (ecase keyword
- (:from (values nil nil))
- (:downfrom (values '- nil))
- (:upfrom (values '+ nil)))))
- ((:to :upto :downto :below :above)
- (multiple-value-call #'values
- :to
- (ecase keyword
- (:to (values nil :inclusive))
- (:downto (values '- :inclusive))
- (:upto (values '+ :inclusive))
- (:below (values '+ :exclusive))
- (:above (values '- :exclusive)))))
- (:by (values :by nil nil))
- (t (when errorp
- (error "~S is not a for-as-arithmetic keyword." keyword)))))
View
10 package.lisp
@@ -1,5 +1,13 @@
(cl:defpackage #:parse-number-range
+ (:nicknames #:parse-numrange #:pnumrange)
(:use #:cl)
+ (:import-from #:map-bind #:map-bind)
+ (:import-from #:enhanced-multiple-value-bind #:multiple-value-&bind)
+ ;; Parse
(:export #:parse
#:unparse
- #:kind))
+ #:canonicalize)
+ ;; Info
+ (:export #:kind
+ #:flags
+ #:flags-to-keywords))
View
8 parse-number-range.asd
@@ -7,9 +7,13 @@
:description "Parses LOOP's convenient \"for-as-arithmetic\" syntax into 5 simple values: from, to, limit-kind (:inclusive, :exclusive or nil if unbounded), by (step) and direction (+ or -)). Intended for easy implementation of analogous functionality in other constructs."
- :depends-on (#:cartesian-product-switch)
+ :depends-on (#:map-bind
+ #:cartesian-product-switch
+ #:enhanced-multiple-value-bind)
:version "1.0"
:serial cl:t
:components ((:file "package")
- (:file "main")))
+ (:file "info")
+ (:file "internals")
+ (:file "parse")))
View
67 parse.lisp
@@ -0,0 +1,67 @@
+(in-package #:parse-number-range)
+
+(defun parse (range &key
+ (keyword-policy :strict)
+ (extrasp nil)
+ (clause-kinds-p extrasp)
+ (clause-keywords-p extrasp)
+ (clauses-alist-p extrasp))
+ '(values from to limit-kind by direction
+ &key clause-kinds clause-keywords clauses-alist)
+ (multiple-value-bind (process-key-value
+ finish-key-value
+ process-extras
+ finish-extras)
+ (multiple-value-call #'values
+ (%make-key-value-processor
+ (lambda (kind)
+ (error "Duplicate specification of kind ~S in range ~S."
+ kind range)))
+ (%make-extras-processor clause-kinds-p
+ clause-keywords-p
+ clauses-alist-p))
+ (let ((key-transform
+ (ecase keyword-policy
+ (:strict #'identity)
+ (:loose (let ((keyword-package (find-package '#:keyword)))
+ (lambda (key)
+ (intern (symbol-name key) keyword-package)))))))
+ (map-bind (%map-plist) (((key value) range))
+ (setf key (funcall key-transform key))
+ (let ((kind (funcall process-key-value key value)))
+ (funcall process-extras kind key))))
+ (multiple-value-call #'values
+ (funcall finish-key-value)
+ (funcall finish-extras))))
+
+(defun unparse (from to limit-kind by direction &key clause-kinds)
+ (multiple-value-bind (from-keyword to-keyword)
+ (flags-to-keywords direction limit-kind)
+ ;; Backquote indented badly...
+ (let ((from (list from-keyword from))
+ (to (when to-keyword
+ (list to-keyword to)))
+ (by (when (and by (/= by 1))
+ (list :by by))))
+ (flet ((maybe (kind list)
+ (unless (member kind clause-kinds :test #'eq)
+ list)))
+ (nconc (maybe :from from) (maybe :to to) (maybe :by by)
+ (map-bind (mapcan) ((kind clause-kinds))
+ (ecase kind
+ (:from from)
+ (:to to)
+ (:by by))))))))
+
+(defun canonicalize (range &key
+ (clause-kinds :preserve)
+ (keyword-policy :strict))
+ (multiple-value-&bind (from to limit-kind by direction
+ &key ((:clause-kinds parsed-clause-kinds)))
+ (parse range
+ :clause-kinds-p (eq clause-kinds :preserve)
+ :keyword-policy keyword-policy)
+ (unparse from to limit-kind by direction
+ :clause-kinds (if (eq clause-kinds :preserve)
+ parsed-clause-kinds
+ clause-kinds))))
Please sign in to comment.
Something went wrong with that request. Please try again.