;ELC ;;; Compiled by mwolson@grepfind.mwolson.org on Thu Jan 24 00:15:33 2008 ;;; from file /stuff/proj/emacs/dvc/mwolson/lisp/xmtn-match.el ;;; in Emacs version 23.0.50.2 ;;; with all optimizations. ;;; This file uses dynamic docstrings, first added in Emacs 19.29. (if (and (boundp 'emacs-version) (< (aref emacs-version (1- (length emacs-version))) ?A) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`xmtn-match.el' was compiled for Emacs 19.29 or later")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (byte-code "\300\301!\210\302\303\304\305#\210\302\306\304\307#\207" [require cl put xmtn-match--bool-vector cl-deftype-handler #[nil "\300\301!\205\302\207" [fboundp bool-vector-p bool-vector] 2] xmtn-match--atom #[nil "\300\207" [(not cons)] 1]] 4) (defalias 'xmtn-match--match-variable-p #[(thing var-name-prefix-char) "9\205\302!\303H\247\203\302!\303H \232\207\302!\303H =\207" [thing var-name-prefix-char symbol-name 0] 2]) (defalias 'xmtn-match--contains-match-variable-p #[(thing var-name-prefix-char) "\302\303!\211\304L\210\305\306\307\310\311D\312FEL\210J !)\207" [#1=#:--cl---cl-var--70970-- thing make-symbol "----cl-var--70970--" nil lambda (&rest --cl-rest--) apply #[(#2=#:G70971 thing) "\303 \"\206A:\203\nJ@!\206A\nJA!\207\304!\2031;\2041\305!\2041\306\nJ\"\207:\2048\307\207\310\311\312#\205A\307\207" [thing var-name-prefix-char #2# xmtn-match--match-variable-p arrayp bool-vector-p some nil error "etypecase failed: %s, %s" (cons (and array (not string) (not xmtn-match--bool-vector)) xmtn-match--atom)] 4] quote --cl-rest--] 8]) (defalias 'xmtn-match--generate-branch #[(var-name-prefix-char match-block object pattern body) "\306\307\310!\311\312\313!\312\314!\211\306L\210\n\306L\210 \315\316\317\320\321\nD\321 D\322\257EL\210\n\315\316\317\323\321\nD\321 D\322\257EL\210 J\f \"*B \237\324 \325\326\327BEEE+\207" [pattern-block var-accu #1=#:--cl---cl-var--70972-- #2=#:--cl---cl-var--70973-- object pattern nil gensym "pattern-test-" and make-symbol "----cl-var--70973--" "----cl-var--70972--" lambda (&rest --cl-rest--) apply #[(#3=#:G70974 #4=#:G70975 subobject subpattern) "\306 \"\203-\307\310\311!\312\"!\211 \235\203\313\f\nEC\202+\n B\314\315\n\fE\316BBC)\207\317 \"\204I9\203A\320\f\321DEC\207\313\f\321DEC\207:\203\202\322\fD\323\324\211!\" :\203| @!\325#J!!!\fD\"!\"\244\" A\211\202Z\"\237+B\207\326!\203\330;\204\330\327!\204\330\330\f\321\331!DE\332\333\fDGE\334$G%\324&$%W\203\321\325#J$H\335\f$E\"!&\244&$T\211$\202\256&\237+BB\207\336\337\340#\205\341\324\207" [subpattern var-name-prefix-char var var-accu subobject #5=#:--cl-var-- xmtn-match--match-variable-p intern subseq symbol-name 1 equal progn setq (t) xmtn-match--contains-match-variable-p eq quote consp (car cdr) nil reverse arrayp bool-vector-p typep type-of eql length 0 aref error "etypecase failed: %s, %s" (cons (and array (not string) (not xmtn-match--bool-vector))) part-reader #6=#:--cl-var-- #3# index #7=#:--cl-var-- #8=#:--cl-var--] 10] quote --cl-rest-- #[(#9=#:G70976 #10=#:G70977 subsubpattern subsubobject-form) "\305 \"\203:\204\306!\204\nJ \"\207\307 \310\f DC\311\nJ\f\"BE)C\207" [subsubpattern var-name-prefix-char #10# subsubobject-form subsubobject xmtn-match--contains-match-variable-p arrayp gensym let and] 6] let when return-from progn test match-block body] 10]) (byte-code "\300\301!\210\300\302!\207" [byte-compile xmtn-match--generate-branch xmtn-match--contains-match-variable-p] 2) (defalias 'xmtn-match--test #[(xmtn--thunk) " \207" [xmtn--thunk] 1]) #@763 Similar to `ecase', but with pattern matching. Eval EXPR, find the first PATTERN that matches its value, execute the corresponding BODY and return its result. If no PATTERN matches, an error is signalled. The matching is done as with `equal', except that subexpressions of PATTERN that are symbols whose name starts with $ are treated specially. Such symbols are free variables that match any subexpression. If the same variable occurs more than once, each occurrence must match a similar (as in `equal') subexpression. During the execution of BODY, each variable, with the leading $ removed, will be bound to the subexpression that it matched. Variables may only occur in conses and arrays except strings and bool-vectors. (fn EXPR (PATTERN BODY...)...) (defalias 'xmtn-match '(macro . #[(object-form &rest cases) "\306\307\310\311!\310\312!\313 \fDC\314\315 \316\211\316:\203J@\211\211A@\317\n %BA\211\202\"\237,\320\321\322 D FC\"BBE,\207" [match-block object var-name-prefix-char macro-name object-form cases xmtn-match 36 gensym "object-" "match-form-" let block append nil xmtn-match--generate-branch error "Fell through %S: %S" quote #1=#:--cl-var-- body pattern #2=#:--cl-var--] 12 (#$ . 3702)])) (provide 'xmtn-match)