From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 6 Sep 2008 00:48:44 +0000 (-0500)
Subject: Move match to basis since compiler.tree.debugger uses it, fix conflict
X-Git-Tag: 0.94~2439^2~123
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=bcc8483b5b337289b819977275f79b5a0b84bfed

Move match to basis since compiler.tree.debugger uses it, fix conflict
---

bcc8483b5b337289b819977275f79b5a0b84bfed
diff --cc basis/checksums/sha1/sha1.factor
index e75ebfb9e4,ab813d529b..0ddb429b28
--- a/basis/checksums/sha1/sha1.factor
+++ b/basis/checksums/sha1/sha1.factor
@@@ -118,16 -113,8 +118,16 @@@ INSTANCE: sha1 checksu
  M: sha1 checksum-stream ( stream -- sha1 )
      drop [ initialize-sha1 stream>sha1 get-sha1 ] with-input-stream ;
  
 +: seq>2seq ( seq -- seq1 seq2 )
 +    #! { abcdefgh } -> { aceg } { bdfh }
 +    2 group flip dup empty? [ drop { } { } ] [ first2 ] if ;
 +
 +: 2seq>seq ( seq1 seq2 -- seq )
 +    #! { aceg } { bdfh } -> { abcdefgh }
 +    [ zip concat ] keep like ;
 +
  : sha1-interleave ( string -- seq )
-     [ zero? ] left-trim
+     [ zero? ] trim-left
      dup length odd? [ rest ] when
      seq>2seq [ sha1 checksum-bytes ] bi@
      2seq>seq ;
diff --cc basis/match/authors.txt
index 0000000000,0000000000..44b06f94bc
new file mode 100644
--- /dev/null
+++ b/basis/match/authors.txt
@@@ -1,0 -1,0 +1,1 @@@
++Chris Double
diff --cc basis/match/match-docs.factor
index 0000000000,0000000000..2e23721e93
new file mode 100644
--- /dev/null
+++ b/basis/match/match-docs.factor
@@@ -1,0 -1,0 +1,65 @@@
++! Copyright (C) 2006 Chris Double.
++! See http://factorcode.org/license.txt for BSD license.
++USING: help.markup help.syntax namespaces assocs sequences
++kernel combinators ;
++IN: match
++
++HELP: match 
++{ $values { "value1" object } { "value2" object } { "bindings" assoc }
++}
++{ $description "Pattern match value1 against value2. These values can be any Factor value, including sequences and tuples. The values can contain pattern variables, which are symbols that begin with '?'. The result is a hashtable of the bindings, mapping the pattern variables from one sequence to the equivalent value in the other sequence. The '_' symbol can be used to ignore the value at that point in the pattern for the match. " } 
++{ $examples 
++    { $unchecked-example "USE: match" "MATCH-VARS: ?a ?b ;\n{ ?a { 2 ?b } 5 } { 1 { 2 3 } _ } match ." "H{ { ?a 1 } { ?b 3 } }" }
++}
++{ $see-also match-cond POSTPONE: MATCH-VARS: replace-patterns match-replace } ;
++
++HELP: match-cond
++{ $values { "assoc" "a sequence of pairs" } }
++{ $description "Calls the second quotation in the first pair whose first sequence yields a successful " { $link match } " against the top of the stack. The second quotation, when called, has the hashtable returned from the " { $link match } " call bound as the top namespace so " { $link get } " can be used to retrieve the values. To have a fallthrough match clause use the '_' match variable." } 
++{ $examples 
++    { $code "USE: match" "MATCH-VARS: ?value ;\n{ increment ?value } {\n  { { increment ?value } [ ?value do-something ] }\n  { { decrement ?value } [ ?value do-something-else ] }\n  { _ [ no-match-found ] }\n} match-cond" }
++}
++{ $see-also match POSTPONE: MATCH-VARS: replace-patterns match-replace } ;
++
++
++HELP: MATCH-VARS:
++{ $syntax "MATCH-VARS: var ... ;" }
++{ $values { "var" "a match variable name beginning with '?'" } }
++{ $description "Creates a symbol that can be used in " { $link match } " and " { $link match-cond } " for binding values in the matched sequence. The symbol name is created as a word that is defined to get the value of the symbol out of the current namespace. This can be used in " { $link match-cond } " to retrive the values in the quotation body." }
++{ $examples 
++    { $code "USE: match" "MATCH-VARS: ?value ;\n{ increment ?value } {\n  { { increment ?value } [ ?value do-something ] }\n  { { decrement ?value } [ ?value do-something-else ] }\n  { _ [ no-match-found ] }\n} match-cond" }
++}
++{ $see-also match match-cond replace-patterns match-replace } ;
++
++HELP: replace-patterns
++{ $values { "object" object } { "result" object } }
++{ $description "Copy the object, replacing each occurrence of a pattern matching variable with the actual value of that variable." } 
++{ $see-also match-cond POSTPONE: MATCH-VARS: match-replace } ;
++
++HELP: match-replace
++{ $values { "object" object } { "pattern1" object } { "pattern2" object } { "result" object } }
++{ $description "Matches the " { $snippet "object" } " against " { $snippet "pattern1" } ". The pattern match variables in " { $snippet "pattern1" } " are assigned the values from the matching " { $snippet "object" } ". These are then replaced into the " { $snippet "pattern2" } " pattern match variables." } 
++{ $examples
++  { $example
++      "USING: match prettyprint ;"
++      "IN: scratchpad"
++      "MATCH-VARS: ?a ?b ;"
++      "{ 1 2 } { ?a ?b } { ?b ?a } match-replace ." 
++      "{ 2 1 }"
++  }
++}
++{ $see-also match-cond POSTPONE: MATCH-VARS: } ;
++
++ARTICLE: "match" "Pattern matching"
++"The " { $vocab-link "match" } " vocabulary implements ML-style pattern matching."
++$nl
++"Variables used for pattern matching must be explicitly defined first:"
++{ $subsection POSTPONE: MATCH-VARS: }
++"A basic pattern match:"
++{ $subsection match }
++"A conditional form analogous to " { $link cond } ":"
++{ $subsection match-cond }
++"Pattern replacement:"
++{ $subsection match-replace } ;
++
++ABOUT: "match"
diff --cc basis/match/match-tests.factor
index 0000000000,0000000000..044b80fe9d
new file mode 100755
--- /dev/null
+++ b/basis/match/match-tests.factor
@@@ -1,0 -1,0 +1,87 @@@
++! Copyright (C) 2006 Chris Double.
++! See http://factorcode.org/license.txt for BSD license.
++USING: tools.test match namespaces arrays ;
++IN: match.tests
++
++MATCH-VARS: ?a ?b ;
++
++[ f ] [ { ?a ?a } { 1 2 } match ] unit-test
++
++[ H{ { ?a 1 } { ?b 2 } } ] [
++ { ?a ?b } { 1 2 } match
++] unit-test
++
++[ { 1 2 } ] [ 
++  { 1 2 } 
++  {
++    { { ?a ?b } [ ?a ?b 2array ] }
++  } match-cond
++] unit-test
++
++[ t ] [ 
++  { 1 2 } 
++  {
++    { { 1 2 } [ t ] }
++    { f [ f ] }
++  } match-cond
++] unit-test
++
++[ t ] [ 
++  { 1 3 } 
++  {
++    { { 1 2 } [ t ] }
++    { { 1 3 } [ t ] }
++  } match-cond
++] unit-test
++
++[ f ] [ 
++  { 1 5 } 
++  {
++    { { 1 2 } [ t ] }
++    { { 1 3 } [ t ] }
++    { _       [ f ] }
++  } match-cond
++] unit-test
++
++TUPLE: foo a b ;
++
++C: <foo> foo
++
++{ 1 2 } [
++  1 2 <foo> T{ foo f ?a ?b } match [
++    ?a ?b
++  ] bind
++] unit-test
++
++{ 1 2 } [
++  1 2 <foo> \ ?a \ ?b <foo> match [
++    ?a ?b
++  ] bind
++] unit-test
++
++{ H{ { ?a ?a } } } [ 
++  \ ?a \ ?a match 
++] unit-test
++
++[ "match" ] [ 
++  "abcd" {
++    { ?a [ "match" ] }
++  } match-cond
++] unit-test
++
++[
++  { 2 1 }
++] [
++  { "a" 1 2 "b" } { _ ?a ?b _ } { ?b ?a } match-replace
++] unit-test
++
++TUPLE: match-replace-test a b ;
++
++[
++    T{ match-replace-test f 2 1 }
++] [
++  T{ match-replace-test f 1 2 }
++  T{ match-replace-test f ?a ?b }
++  T{ match-replace-test f ?b ?a }
++  match-replace
++] unit-test
diff --cc basis/match/match.factor
index 0000000000,0000000000..0ae285d20d
new file mode 100755
--- /dev/null
+++ b/basis/match/match.factor
@@@ -1,0 -1,0 +1,90 @@@
++! Copyright (C) 2006 Chris Double.
++! See http://factorcode.org/license.txt for BSD license.
++!
++! Based on pattern matching code from Paul Graham's book 'On Lisp'.
++USING: parser lexer kernel words namespaces sequences classes.tuple
++combinators macros assocs math effects ;
++IN: match
++
++SYMBOL: _
++
++: define-match-var ( name -- )
++    create-in
++    dup t "match-var" set-word-prop
++    dup [ get ] curry (( -- value )) define-declared ;
++
++: define-match-vars ( seq -- )
++    [ define-match-var ] each ;
++
++: MATCH-VARS: ! vars ...
++    ";" parse-tokens define-match-vars ; parsing
++
++: match-var? ( symbol -- bool )
++    dup word? [ "match-var" word-prop ] [ drop f ] if ;
++
++: set-match-var ( value var -- ? )
++    dup namespace key? [ get = ] [ set t ] if ;
++
++: (match) ( value1 value2 -- matched? )
++    {
++        { [ dup match-var? ] [ set-match-var ] }
++        { [ over match-var? ] [ swap set-match-var ] }
++        { [ 2dup = ] [ 2drop t ] }
++        { [ 2dup [ _ eq? ] either? ] [ 2drop t ] }
++        { [ 2dup [ sequence? ] both? ] [
++            2dup [ length ] bi@ =
++            [ [ (match) ] 2all? ] [ 2drop f ] if ] }
++        { [ 2dup [ tuple? ] both? ]
++          [ [ tuple>array ] bi@ [ (match) ] 2all? ] }
++        { [ t ] [ 2drop f ] }
++    } cond ;
++
++: match ( value1 value2 -- bindings )
++    [ (match) ] H{ } make-assoc swap [ drop f ] unless ;
++
++MACRO: match-cond ( assoc -- )
++    <reversed>
++    [ "Fall-through in match-cond" throw ]
++    [
++        first2
++        >r [ dupd match ] curry r>
++        [ bind ] curry rot
++        [ ?if ] 2curry append
++    ] reduce ;
++
++: replace-patterns ( object -- result )
++    {
++        { [ dup number? ] [ ] }
++        { [ dup match-var? ] [ get ] }
++        { [ dup sequence? ] [ [ replace-patterns ] map ] }
++        { [ dup tuple? ] [ tuple>array replace-patterns >tuple ] }
++        [ ]
++    } cond ;
++
++: match-replace ( object pattern1 pattern2 -- result )
++    -rot
++    match [ "Pattern does not match" throw ] unless*
++    [ replace-patterns ] bind ;
++
++: ?1-tail ( seq -- tail/f )
++    dup length zero? not [ rest ] [ drop f ] if ;
++
++: (match-first) ( seq pattern-seq -- bindings leftover/f )
++    2dup [ length ] bi@ < [ 2drop f f ]
++    [
++        2dup length head over match
++        [ nip swap ?1-tail ] [ >r rest r> (match-first) ] if*
++    ] if ;
++    
++: match-first ( seq pattern-seq -- bindings )
++    (match-first) drop ;
++
++: (match-all) ( seq pattern-seq -- )
++    tuck (match-first) swap 
++    [ 
++        , [ swap (match-all) ] [ drop ] if* 
++    ] [ 2drop ] if* ;
++
++: match-all ( seq pattern-seq -- bindings-seq )
++    [ (match-all) ] { } make ;
++    
diff --cc basis/match/summary.txt
index 0000000000,0000000000..1666a2cbaa
new file mode 100644
--- /dev/null
+++ b/basis/match/summary.txt
@@@ -1,0 -1,0 +1,1 @@@
++ML-style pattern matching
diff --cc basis/match/tags.txt
index 0000000000,0000000000..f4274299b1
new file mode 100644
--- /dev/null
+++ b/basis/match/tags.txt
@@@ -1,0 -1,0 +1,1 @@@
++extensions
diff --cc basis/tools/scaffold/scaffold.factor
index 1312681f85,f12b8fda0e..74c92605aa
--- a/basis/tools/scaffold/scaffold.factor
+++ b/basis/tools/scaffold/scaffold.factor
@@@ -3,8 -3,8 +3,8 @@@
  USING: assocs io.files hashtables kernel namespaces sequences
  vocabs.loader io combinators io.encodings.utf8 calendar accessors
  math.parser io.streams.string ui.tools.operations quotations
 -strings arrays prettyprint words vocabs sorting sets cords
 -classes sequences.lib combinators.lib alien math ;
 +strings arrays prettyprint words vocabs sorting sets
- classes ;
++classes alien ;
  IN: tools.scaffold
  
  SYMBOL: developer-name
diff --cc extra/match/authors.txt
index 44b06f94bc,44b06f94bc..0000000000
deleted file mode 100644,100644
--- a/extra/match/authors.txt
+++ /dev/null
@@@ -1,1 -1,1 +1,0 @@@
--Chris Double
diff --cc extra/match/match-docs.factor
index 2e23721e93,2e23721e93..0000000000
deleted file mode 100644,100644
--- a/extra/match/match-docs.factor
+++ /dev/null
@@@ -1,65 -1,65 +1,0 @@@
--! Copyright (C) 2006 Chris Double.
--! See http://factorcode.org/license.txt for BSD license.
--USING: help.markup help.syntax namespaces assocs sequences
--kernel combinators ;
--IN: match
--
--HELP: match 
--{ $values { "value1" object } { "value2" object } { "bindings" assoc }
--}
--{ $description "Pattern match value1 against value2. These values can be any Factor value, including sequences and tuples. The values can contain pattern variables, which are symbols that begin with '?'. The result is a hashtable of the bindings, mapping the pattern variables from one sequence to the equivalent value in the other sequence. The '_' symbol can be used to ignore the value at that point in the pattern for the match. " } 
--{ $examples 
--    { $unchecked-example "USE: match" "MATCH-VARS: ?a ?b ;\n{ ?a { 2 ?b } 5 } { 1 { 2 3 } _ } match ." "H{ { ?a 1 } { ?b 3 } }" }
--}
--{ $see-also match-cond POSTPONE: MATCH-VARS: replace-patterns match-replace } ;
--
--HELP: match-cond
--{ $values { "assoc" "a sequence of pairs" } }
--{ $description "Calls the second quotation in the first pair whose first sequence yields a successful " { $link match } " against the top of the stack. The second quotation, when called, has the hashtable returned from the " { $link match } " call bound as the top namespace so " { $link get } " can be used to retrieve the values. To have a fallthrough match clause use the '_' match variable." } 
--{ $examples 
--    { $code "USE: match" "MATCH-VARS: ?value ;\n{ increment ?value } {\n  { { increment ?value } [ ?value do-something ] }\n  { { decrement ?value } [ ?value do-something-else ] }\n  { _ [ no-match-found ] }\n} match-cond" }
--}
--{ $see-also match POSTPONE: MATCH-VARS: replace-patterns match-replace } ;
--
--
--HELP: MATCH-VARS:
--{ $syntax "MATCH-VARS: var ... ;" }
--{ $values { "var" "a match variable name beginning with '?'" } }
--{ $description "Creates a symbol that can be used in " { $link match } " and " { $link match-cond } " for binding values in the matched sequence. The symbol name is created as a word that is defined to get the value of the symbol out of the current namespace. This can be used in " { $link match-cond } " to retrive the values in the quotation body." }
--{ $examples 
--    { $code "USE: match" "MATCH-VARS: ?value ;\n{ increment ?value } {\n  { { increment ?value } [ ?value do-something ] }\n  { { decrement ?value } [ ?value do-something-else ] }\n  { _ [ no-match-found ] }\n} match-cond" }
--}
--{ $see-also match match-cond replace-patterns match-replace } ;
--
--HELP: replace-patterns
--{ $values { "object" object } { "result" object } }
--{ $description "Copy the object, replacing each occurrence of a pattern matching variable with the actual value of that variable." } 
--{ $see-also match-cond POSTPONE: MATCH-VARS: match-replace } ;
--
--HELP: match-replace
--{ $values { "object" object } { "pattern1" object } { "pattern2" object } { "result" object } }
--{ $description "Matches the " { $snippet "object" } " against " { $snippet "pattern1" } ". The pattern match variables in " { $snippet "pattern1" } " are assigned the values from the matching " { $snippet "object" } ". These are then replaced into the " { $snippet "pattern2" } " pattern match variables." } 
--{ $examples
--  { $example
--      "USING: match prettyprint ;"
--      "IN: scratchpad"
--      "MATCH-VARS: ?a ?b ;"
--      "{ 1 2 } { ?a ?b } { ?b ?a } match-replace ." 
--      "{ 2 1 }"
--  }
--}
--{ $see-also match-cond POSTPONE: MATCH-VARS: } ;
--
--ARTICLE: "match" "Pattern matching"
--"The " { $vocab-link "match" } " vocabulary implements ML-style pattern matching."
--$nl
--"Variables used for pattern matching must be explicitly defined first:"
--{ $subsection POSTPONE: MATCH-VARS: }
--"A basic pattern match:"
--{ $subsection match }
--"A conditional form analogous to " { $link cond } ":"
--{ $subsection match-cond }
--"Pattern replacement:"
--{ $subsection match-replace } ;
--
--ABOUT: "match"
diff --cc extra/match/match-tests.factor
index 044b80fe9d,044b80fe9d..0000000000
deleted file mode 100755,100755
--- a/extra/match/match-tests.factor
+++ /dev/null
@@@ -1,87 -1,87 +1,0 @@@
--! Copyright (C) 2006 Chris Double.
--! See http://factorcode.org/license.txt for BSD license.
--USING: tools.test match namespaces arrays ;
--IN: match.tests
--
--MATCH-VARS: ?a ?b ;
--
--[ f ] [ { ?a ?a } { 1 2 } match ] unit-test
--
--[ H{ { ?a 1 } { ?b 2 } } ] [
-- { ?a ?b } { 1 2 } match
--] unit-test
--
--[ { 1 2 } ] [ 
--  { 1 2 } 
--  {
--    { { ?a ?b } [ ?a ?b 2array ] }
--  } match-cond
--] unit-test
--
--[ t ] [ 
--  { 1 2 } 
--  {
--    { { 1 2 } [ t ] }
--    { f [ f ] }
--  } match-cond
--] unit-test
--
--[ t ] [ 
--  { 1 3 } 
--  {
--    { { 1 2 } [ t ] }
--    { { 1 3 } [ t ] }
--  } match-cond
--] unit-test
--
--[ f ] [ 
--  { 1 5 } 
--  {
--    { { 1 2 } [ t ] }
--    { { 1 3 } [ t ] }
--    { _       [ f ] }
--  } match-cond
--] unit-test
--
--TUPLE: foo a b ;
--
--C: <foo> foo
--
--{ 1 2 } [
--  1 2 <foo> T{ foo f ?a ?b } match [
--    ?a ?b
--  ] bind
--] unit-test
--
--{ 1 2 } [
--  1 2 <foo> \ ?a \ ?b <foo> match [
--    ?a ?b
--  ] bind
--] unit-test
--
--{ H{ { ?a ?a } } } [ 
--  \ ?a \ ?a match 
--] unit-test
--
--[ "match" ] [ 
--  "abcd" {
--    { ?a [ "match" ] }
--  } match-cond
--] unit-test
--
--[
--  { 2 1 }
--] [
--  { "a" 1 2 "b" } { _ ?a ?b _ } { ?b ?a } match-replace
--] unit-test
--
--TUPLE: match-replace-test a b ;
--
--[
--    T{ match-replace-test f 2 1 }
--] [
--  T{ match-replace-test f 1 2 }
--  T{ match-replace-test f ?a ?b }
--  T{ match-replace-test f ?b ?a }
--  match-replace
--] unit-test
diff --cc extra/match/match.factor
index 0ae285d20d,0ae285d20d..0000000000
deleted file mode 100755,100755
--- a/extra/match/match.factor
+++ /dev/null
@@@ -1,90 -1,90 +1,0 @@@
--! Copyright (C) 2006 Chris Double.
--! See http://factorcode.org/license.txt for BSD license.
--!
--! Based on pattern matching code from Paul Graham's book 'On Lisp'.
--USING: parser lexer kernel words namespaces sequences classes.tuple
--combinators macros assocs math effects ;
--IN: match
--
--SYMBOL: _
--
--: define-match-var ( name -- )
--    create-in
--    dup t "match-var" set-word-prop
--    dup [ get ] curry (( -- value )) define-declared ;
--
--: define-match-vars ( seq -- )
--    [ define-match-var ] each ;
--
--: MATCH-VARS: ! vars ...
--    ";" parse-tokens define-match-vars ; parsing
--
--: match-var? ( symbol -- bool )
--    dup word? [ "match-var" word-prop ] [ drop f ] if ;
--
--: set-match-var ( value var -- ? )
--    dup namespace key? [ get = ] [ set t ] if ;
--
--: (match) ( value1 value2 -- matched? )
--    {
--        { [ dup match-var? ] [ set-match-var ] }
--        { [ over match-var? ] [ swap set-match-var ] }
--        { [ 2dup = ] [ 2drop t ] }
--        { [ 2dup [ _ eq? ] either? ] [ 2drop t ] }
--        { [ 2dup [ sequence? ] both? ] [
--            2dup [ length ] bi@ =
--            [ [ (match) ] 2all? ] [ 2drop f ] if ] }
--        { [ 2dup [ tuple? ] both? ]
--          [ [ tuple>array ] bi@ [ (match) ] 2all? ] }
--        { [ t ] [ 2drop f ] }
--    } cond ;
--
--: match ( value1 value2 -- bindings )
--    [ (match) ] H{ } make-assoc swap [ drop f ] unless ;
--
--MACRO: match-cond ( assoc -- )
--    <reversed>
--    [ "Fall-through in match-cond" throw ]
--    [
--        first2
--        >r [ dupd match ] curry r>
--        [ bind ] curry rot
--        [ ?if ] 2curry append
--    ] reduce ;
--
--: replace-patterns ( object -- result )
--    {
--        { [ dup number? ] [ ] }
--        { [ dup match-var? ] [ get ] }
--        { [ dup sequence? ] [ [ replace-patterns ] map ] }
--        { [ dup tuple? ] [ tuple>array replace-patterns >tuple ] }
--        [ ]
--    } cond ;
--
--: match-replace ( object pattern1 pattern2 -- result )
--    -rot
--    match [ "Pattern does not match" throw ] unless*
--    [ replace-patterns ] bind ;
--
--: ?1-tail ( seq -- tail/f )
--    dup length zero? not [ rest ] [ drop f ] if ;
--
--: (match-first) ( seq pattern-seq -- bindings leftover/f )
--    2dup [ length ] bi@ < [ 2drop f f ]
--    [
--        2dup length head over match
--        [ nip swap ?1-tail ] [ >r rest r> (match-first) ] if*
--    ] if ;
--    
--: match-first ( seq pattern-seq -- bindings )
--    (match-first) drop ;
--
--: (match-all) ( seq pattern-seq -- )
--    tuck (match-first) swap 
--    [ 
--        , [ swap (match-all) ] [ drop ] if* 
--    ] [ 2drop ] if* ;
--
--: match-all ( seq pattern-seq -- bindings-seq )
--    [ (match-all) ] { } make ;
--    
diff --cc extra/match/summary.txt
index 1666a2cbaa,1666a2cbaa..0000000000
deleted file mode 100644,100644
--- a/extra/match/summary.txt
+++ /dev/null
@@@ -1,1 -1,1 +1,0 @@@
--ML-style pattern matching
diff --cc extra/match/tags.txt
index f4274299b1,f4274299b1..0000000000
deleted file mode 100644,100644
--- a/extra/match/tags.txt
+++ /dev/null
@@@ -1,1 -1,1 +1,0 @@@
--extensions