match: rename ?1-tail to ?rest.
parent
c0d6fdedd1
commit
76da2a6e78
|
@ -2,8 +2,8 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
!
|
!
|
||||||
! Based on pattern matching code from Paul Graham's book 'On Lisp'.
|
! Based on pattern matching code from Paul Graham's book 'On Lisp'.
|
||||||
USING: parser lexer kernel words namespaces make sequences
|
USING: assocs classes.tuple combinators kernel lexer macros make
|
||||||
classes.tuple combinators macros assocs math effects ;
|
math namespaces parser sequences words ;
|
||||||
IN: match
|
IN: match
|
||||||
|
|
||||||
SYMBOL: _
|
SYMBOL: _
|
||||||
|
@ -65,13 +65,13 @@ MACRO: match-cond ( assoc -- )
|
||||||
[ match [ "Pattern does not match" throw ] unless* ] dip swap
|
[ match [ "Pattern does not match" throw ] unless* ] dip swap
|
||||||
[ replace-patterns ] with-variables ;
|
[ replace-patterns ] with-variables ;
|
||||||
|
|
||||||
: ?1-tail ( seq -- tail/f )
|
: ?rest ( seq -- tailseq/f )
|
||||||
dup length zero? not [ rest ] [ drop f ] if ;
|
[ f ] [ rest ] if-empty ;
|
||||||
|
|
||||||
: (match-first) ( seq pattern-seq -- bindings leftover/f )
|
: (match-first) ( seq pattern-seq -- bindings leftover/f )
|
||||||
2dup shorter? [ 2drop f f ] [
|
2dup shorter? [ 2drop f f ] [
|
||||||
2dup length head over match
|
2dup length head over match
|
||||||
[ swap ?1-tail ] [ [ rest ] dip (match-first) ] ?if
|
[ swap ?rest ] [ [ rest ] dip (match-first) ] ?if
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: match-first ( seq pattern-seq -- bindings )
|
: match-first ( seq pattern-seq -- bindings )
|
||||||
|
|
Loading…
Reference in New Issue