;; @module matching ;; @author Jeff Ober , Kanen Flowers ;; @version 1.0 ;; @location http://static.artfulcode.net/newlisp/matching.lsp ;; @package http://static.artfulcode.net/newlisp/matching.qwerty ;; @description Complex conditionals using match and unify (updated for newlisp 10) ;;

Matching conditionals make possible a very terse style of programming common to the ;; ML family of languages.

;;

Version history

;; 1.0 ;; • updated for newlisp 10 ;; • renamed module to matching ;; • removed dependency on util.lsp ;; • made match-bind a global symbol ;; • fixed error in documentation for match-cond ;; • fixed error in match-cond that bound arguments incorrectly ;; • removed match-with and if-match because they were generally confusing and unnecessary ;; • match-bind no longer binds exact matches (e.g. 'foo and 'foo), only wildcards ;; • fixed bug in match-case where target was bound incorrectly in some cases ;; ;; 0.5 ;; • fixed bug in 'with-match' causing $0 to be misinterpreted in certain circumstances ;; ;; 0.4 ;; • added 'with-match', a simpler operator that is more idiomatic of newLISP ;; ;; 0.3 ;; • added 'if-match', 'match-with' ;; ;; 0.2 ;; • altered argument order in 'match-cond' ;; • added 'match-case' ;; ;; 0.1 ;; • initial release ;; • added 'match-bind', 'match-let' ;; @syntax (match-bind ) ;; @param symbols to bind ;; @param match pattern ;; @param match target ;;

If '(match )' is valid, binds to ;; the result of its evaluation.

;; @example ;; (match-bind '(a b) '(? ?) '(1 2)) ;; a => 1 ;; b => 2 (define (match-bind var-list pattern target) (let ((m (match pattern target))) (map set var-list m))) (global 'match-bind) ;; @syntax (match-let ( ) ...) ;; @param symbols to bind ;; @param match pattern ;; @param match target ;; @param series of forms to be evaluated ;;

'match-let' will evaluate body in an environment where ;; variables are bound to the destructured values from ;; according to match pattern . Thus, if ;; the result of '(match )' is '(1 2 (3 4))', ;; '(a b c)' will be bound as '((a 1) (b 2) (c '(3 4)))'.

;;

Should not match , an error is signaled. ;; Note that is evaluated before is executed. ;; is evaluated even if the match fails, as it is the ;; evaluated form against which is matched.

;; @example ;; (let ((lst '(1 2 3 4))) ;; (match-let ((a b c) (? ? *) lst) ;; (+ a b (apply * c)))) ;; ;; => 15 (define-macro (match-let) (letex ((var-list (args 0 0)) (pattern (args 0 1)) (target (args 0 2)) (body (cons 'begin (rest (args))))) (if (match 'pattern target) (local var-list (match-bind 'var-list 'pattern target) body) (throw-error "no match possible")))) (global 'match-let) ;; @syntax (match-case (

) ...) ;; @param the expression to match against ;; @param the pattern to match with ;; @param the symbols to bind to the result of the match ;; @param the form to be evaluated should match successfully ;;

'match-case' tries a series of match cases in sequence and returns the result of ;; evaluating the first successful match's in a local scope in which symbols ;; are bound to the result of matching against .

;; @example ;; (let ((x '(1 2 3 4 5))) ;; (match-case x ;; ((? ? ?) (a b c) (println "this form is not evaluated since '(? ? ?) does not match x")) ;; ((? ? *) (a b c) (println "c is bound to " c " in this form")) ;; ((*) (a) (println "catch-all")))) ; (*) matches all lists, so it is catch-all for x ;; ;; => "c is bound to (3 4 5) in this form" (define-macro (match-case) (let ((target (args 0))) (catch (dolist (form (rest (args))) (letex ((tgt (eval target)) (pattern (form 0)) (vars (form 1)) (expr (form 2))) (if (match 'pattern 'tgt) (match-let (vars pattern 'tgt) (throw expr)))))))) (global 'match-case) ;; @syntax (match-cond (( ) ) ...) ;; @param match pattern ;; @param symbols to bind ;; @param match target ;; @param series of forms to be evaluated ;;

'match-cond' evaluates a series of match/bind combinations until one ;; of them evaluates non-nil. The result of the successful match will be bound ;; to the symbols in , and the associated will be evaluated ;; with those symbols locally bound. The result of the evaluation is nil if ;; no forms match or the result of the final evaluated.

;;

'match-cond' is more versatile than 'match-case' in that 'match-cond' may ;; test against multiple targets and evaluates its in an implicit ;; 'begin' block.

;; @example ;; (let ((x '(1 2 3 4 5))) ;; (match-cond ;; (((? ? ?) (a b c) x) (println "evaluation never gets here")) ;; (((? ? *) (a b c) x) (println "c gets bound to " c)) ;; (((*) (a) x) (println "catch-all")))) ; (*) matches all lists, so is catch-all for x ;; ;; => "c gets bound to (3 4 5)" (define-macro (match-cond) (catch (doargs (form) (letex ((pattern (form 0 0)) (vars (form 0 1)) (target (form 0 2)) (body (cons 'begin (rest form)))) (if (match 'pattern target) (match-let (vars pattern target) (throw body))))))) (global 'match-cond) ;; @syntax (with-match (

) ...) ;; @param target of the match ;; @param match pattern to be tested against ;; @param block to be evaluated if matches successfully ;;

Tests each in turn against . On the first successful match, ;; the system variable '$0' is bound to the result of the match and the paired is ;; evaluated. No further match forms are tested after a successful match and the result of ;; the evaluation of is returned. If no match is successful, 'nil' is returned.

;; @example ;; (with-match '(1 2 3 (4 5)) ;; ((? ? ? (? ?)) (apply + $0)) ;; ((? *) (println "Never gets here"))) ;; => 15 (define-macro (with-match) (letex ((target (args 0)) (forms (rest (args)))) (catch (dolist (form 'forms) (letex ((match-form (first form)) (body (cons 'begin (rest form)))) (let (($0 (match 'match-form target))) (if $0 (throw body)))))))) (global 'with-match)