Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

CLISP support

  • Loading branch information...
commit 717317017a8dbbbbe0e4c38dc8c48cf88118da23 1 parent a73d55c
Tomohiro Matsuyama authored
View
2  .gitignore
@@ -1,3 +1,5 @@
+*.lib
+*.fas
*.fasl
*.dx64fsl
*.dx32fsl
View
2  lib/ppcre.lisp
@@ -20,7 +20,7 @@ Examples:
(in-package :optima.ppcre)
(defstruct (ppcre-pattern (:include optima::constructor-pattern)
- (:constructor make-ppcre-pattern (regex &rest subpatterns)))
+ (:constructor make-ppcre-pattern (regex &rest optima::subpatterns)))
regex)
(defmethod optima::destructor-equal ((x ppcre-pattern) (y ppcre-pattern))
View
18 src/compiler.lisp
@@ -117,7 +117,8 @@
collect (if (member var vars) var))
collect `((,subpattern) (values ,@vals)))
(fail))
- (declare (ignorable ,@new-vars))
+ ,@(when new-vars
+ `((declare (ignorable ,@new-vars))))
(%match ,(cdr vars)
((,rest ,.then))
(fail)))
@@ -208,12 +209,12 @@
;; (AND) => _
;; (AND x) => x
;;
- (loop while (and-pattern-p pattern)
- for sub-patterns = (and-pattern-subpatterns pattern)
- do (case (length sub-patterns)
- (0 (setq pattern (parse-pattern '_)))
- (1 (setq pattern (first sub-patterns)))
- (t (return))))
+ (loop while (and-pattern-p pattern) do
+ (let ((sub-patterns (and-pattern-subpatterns pattern)))
+ (case (length sub-patterns)
+ (0 (setq pattern (parse-pattern '_)))
+ (1 (setq pattern (first sub-patterns)))
+ (t (return)))))
;; Lift GUARD patterns here.
(setq pattern (lift-guard-patterns pattern))
;; Recursively expand GUARD pattern here.
@@ -291,7 +292,8 @@
maximize (length patterns)))
(vars (make-gensym-list arity "VAR")))
`(multiple-value-bind ,vars ,values-form
- (declare (ignorable ,@vars))
+ ,@(when vars
+ `((declare (ignorable ,@vars))))
,(compile-match vars clauses else))))
(defmacro %match (vars clauses else)
View
2  test/suite.lisp
@@ -301,7 +301,7 @@
'(match 1
((and x x) t))))
(is-match 1 (and _ _))
- (is-match 1 (or * *))
+ (is-match 1 (or _ _))
;; declarations
(is-true (match 1
(1 (declare (ignore)) t)))
Please sign in to comment.
Something went wrong with that request. Please try again.