core: Move new functors to core.

Also move enough to implement them in an ok style. I would prefer to use formatting in core, but it depends on calendar, etc.

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 ;
 

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

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 ;

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

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 <let> ?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

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 ;
 

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