Permalink
Cannot retrieve contributors at this time
Name already in use
A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
alef/match.lisp
Go to fileThis commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
27 lines (20 sloc)
913 Bytes
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(define-condition no-match () | |
()) | |
(define-condition need-reduce () | |
((gref :initarg :gref :reader need-reduce-gref)) | |
(:report (lambda (condition stream) | |
(format stream "Need to reduce ~A" (need-reduce-gref condition))))) | |
(defgeneric match-pattern* (pat gnode gref)) | |
(defun match-pattern (pat gref) | |
(match-pattern* pat (gderef gref) gref)) | |
(defmethod match-pattern* ((pat wildcard-pattern) gnode gref) | |
(list)) | |
(defmethod match-pattern* ((pat var-pattern) gnode gref) | |
(list (cons (pattern-symbol pat) gref))) | |
(defmethod match-pattern* ((pat cons-pattern) (gnode cons-gnode) gref) | |
(unless (eq (pattern-cons pat) (gnode-cons gnode)) | |
(error 'no-match)) | |
;; Because of well-typedness, there is no need to check arity here | |
(mapcan #'match-pattern (pattern-args pat) (gnode-args gnode))) | |
(defmethod match-pattern* ((pat cons-pattern) gnode gref) | |
(error 'need-reduce :gref gref)) |