diff --git a/basis/ascii/ascii-docs.factor b/core/ascii/ascii-docs.factor similarity index 100% rename from basis/ascii/ascii-docs.factor rename to core/ascii/ascii-docs.factor diff --git a/basis/ascii/ascii-tests.factor b/core/ascii/ascii-tests.factor similarity index 100% rename from basis/ascii/ascii-tests.factor rename to core/ascii/ascii-tests.factor diff --git a/basis/ascii/ascii.factor b/core/ascii/ascii.factor similarity index 100% rename from basis/ascii/ascii.factor rename to core/ascii/ascii.factor diff --git a/basis/ascii/authors.txt b/core/ascii/authors.txt similarity index 100% rename from basis/ascii/authors.txt rename to core/ascii/authors.txt diff --git a/basis/ascii/summary.txt b/core/ascii/summary.txt similarity index 100% rename from basis/ascii/summary.txt rename to core/ascii/summary.txt diff --git a/basis/ascii/tags.txt b/core/ascii/tags.txt similarity index 100% rename from basis/ascii/tags.txt rename to core/ascii/tags.txt diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index 40fb12ac81..55f3020751 100644 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -244,6 +244,12 @@ M: assoc value-at* swap [ = nip ] curry assoc-find nip ; [ push-at ] curry compose each ] keep ; inline +: assoc-invert-as ( assoc exemplar -- newassoc ) + [ swap ] swap assoc-map-as ; + +: assoc-invert ( assoc -- newassoc ) + dup assoc-invert-as ; + M: sequence at* search-alist [ second t ] [ f ] if ; diff --git a/core/bootstrap/syntax.factor b/core/bootstrap/syntax.factor index 4039f11d15..9f922e0d99 100644 --- a/core/bootstrap/syntax.factor +++ b/core/bootstrap/syntax.factor @@ -137,6 +137,8 @@ IN: bootstrap.syntax "|[" "let[" "'let[" + "FUNCTOR:" + "VARIABLES-FUNCTOR:" } [ "syntax" create-word drop ] each "t" "syntax" lookup-word define-symbol diff --git a/extra/namespaces/extras/authors.txt b/core/functors2/authors.txt similarity index 100% rename from extra/namespaces/extras/authors.txt rename to core/functors2/authors.txt diff --git a/extra/namespaces/extras/extras.factor b/core/functors2/functors2.factor similarity index 85% rename from extra/namespaces/extras/extras.factor rename to core/functors2/functors2.factor index 3032c8c2ab..a86489bdea 100644 --- a/extra/namespaces/extras/extras.factor +++ b/core/functors2/functors2.factor @@ -1,13 +1,12 @@ ! Copyright (C) 2017 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs assocs.extras combinators -combinators.extras continuations effects.parser formatting fry -generalizations interpolate io.streams.string kernel make -math.parser namespaces parser quotations sequences -sequences.generalizations unicode vocabs.generated vocabs.parser +USING: accessors ascii assocs combinators +generalizations interpolate io.streams.string kernel +make math.parser namespaces parser quotations sequences +sequences.generalizations vocabs.generated vocabs.parser words ; QUALIFIED: sets -IN: namespaces.extras +IN: functors2 << ERROR: not-all-unique seq ; @@ -55,7 +54,7 @@ ERROR: not-all-unique seq ; [ [ [ vocabulary>> ] [ name>> ] bi - "FROM: %s => %s ;" sprintf + " => " glue "FROM: " " ;\n" surround ] ] replicate ] [ ] tri dup @@ -116,8 +115,8 @@ ERROR: not-all-unique seq ; { } swap make-variable-functor ; ! FUNCTOR: foo, define-foo, and FOO: go into the vocabulary where the FUNCTOR: appears -SYNTAX: \FUNCTOR: - scan-new-word scan-effect scan-object make-functor ; +! SYNTAX: \FUNCTOR: + ! scan-new-word scan-effect scan-object make-functor ; -SYNTAX: \VARIABLE-FUNCTOR: - scan-new-word scan-effect scan-object scan-object make-variable-functor ; +! SYNTAX: \VARIABLE-FUNCTOR: + ! scan-new-word scan-effect scan-object scan-object make-variable-functor ; diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index c9d7d0f446..9b111e2913 100644 --- a/core/kernel/kernel.factor +++ b/core/kernel/kernel.factor @@ -177,6 +177,27 @@ DEFER: if : 2tri@ ( u v w x y z quot -- ) dup dup 2tri* ; inline +: 3bi* ( u v w x y z p q -- ) + [ 3dip ] dip call ; inline + +: 3bi@ ( u v w x y z quot -- ) + dup 3bi* ; inline + +: 4bi ( w x y z p q -- ) + [ 4keep ] dip call ; inline + +: 4bi* ( s t u v w x y z p q -- ) + [ 4dip ] dip call ; inline + +: 4bi@ ( s t u v w x y z quot -- ) + dup 4bi* ; inline + +: 4tri ( w x y z p q r -- ) + [ [ 4keep ] dip 4keep ] dip call ; inline + +: keepd ( ..a x y quot: ( ..a x y -- ..b ) -- ..b x ) + 2keep drop ; inline + ! Quotation building : 2curry ( obj1 obj2 quot -- curried ) curry curry ; inline diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 7d42c8890a..ca566db9ea 100644 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -6,7 +6,7 @@ classes.intersection classes.maybe classes.mixin classes.parser classes.predicate classes.singleton classes.tuple classes.tuple.parser classes.union combinators compiler.units definitions delegate delegate.private effects effects.parser fry -generic generic.hook generic.math generic.parser +functors2 generic generic.hook generic.math generic.parser generic.standard hash-sets hashtables hashtables.identity hints interpolate io.pathnames kernel lexer locals.errors locals.parser locals.types macros math memoize multiline @@ -384,4 +384,12 @@ IN: bootstrap.syntax "'let[" [ H{ } clone (parse-lambda) [ fry call ?rewrite-closures call ] curry append! ] define-core-syntax + + "FUNCTOR:" [ + scan-new-word scan-effect scan-object make-functor + ] define-core-syntax + + "VARIABLES-FUNCTOR:" [ + scan-new-word scan-effect scan-object scan-object make-variable-functor + ] define-core-syntax ] with-compilation-unit diff --git a/basis/vocabs/generated/authors.txt b/core/vocabs/generated/authors.txt similarity index 100% rename from basis/vocabs/generated/authors.txt rename to core/vocabs/generated/authors.txt diff --git a/basis/vocabs/generated/generated.factor b/core/vocabs/generated/generated.factor similarity index 100% rename from basis/vocabs/generated/generated.factor rename to core/vocabs/generated/generated.factor diff --git a/extra/assocs/extras/extras.factor b/extra/assocs/extras/extras.factor index 20fffa25bc..c61ccef59c 100644 --- a/extra/assocs/extras/extras.factor +++ b/extra/assocs/extras/extras.factor @@ -26,12 +26,6 @@ IN: assocs.extras : if-assoc-empty ( ..a assoc quot1: ( ..a -- ..b ) quot2: ( ..a assoc -- ..b ) -- ..b ) [ dup assoc-empty? ] [ [ drop ] prepose ] [ ] tri* if ; inline -: assoc-invert-as ( assoc exemplar -- newassoc ) - [ swap ] swap assoc-map-as ; - -: assoc-invert ( assoc -- newassoc ) - dup assoc-invert-as ; - : assoc-merge! ( assoc1 assoc2 -- assoc1 ) over [ push-at ] with-assoc assoc-each ; diff --git a/extra/combinators/extras/extras.factor b/extra/combinators/extras/extras.factor index 274c0e860b..5a1c234021 100644 --- a/extra/combinators/extras/extras.factor +++ b/extra/combinators/extras/extras.factor @@ -22,27 +22,6 @@ MACRO: cond-case ( assoc -- quot ) MACRO: cleave-array ( quots -- quot ) [ '[ _ cleave ] ] [ length '[ _ narray ] ] bi compose ; -: 3bi* ( u v w x y z p q -- ) - [ 3dip ] dip call ; inline - -: 3bi@ ( u v w x y z quot -- ) - dup 3bi* ; inline - -: 4bi ( w x y z p q -- ) - [ 4keep ] dip call ; inline - -: 4bi* ( s t u v w x y z p q -- ) - [ 4dip ] dip call ; inline - -: 4bi@ ( s t u v w x y z quot -- ) - dup 4bi* ; inline - -: 4tri ( w x y z p q r -- ) - [ [ 4keep ] dip 4keep ] dip call ; inline - -: keepd ( ..a x y quot: ( ..a x y -- ..b ) -- ..b x ) - 2keep drop ; inline - : plox ( ... x/f quot: ( ... x -- ... ) -- ... ) dupd when ; inline