namespaces.extras: Add a new functors prototype.

IN: foo
FUNCTOR: foo goes into the vocab where it's declared

Instantiated ``FOO: bar`` go into ``foo:functors:foo:bar:92801082101``

core/vocabs/vocabs.factor

@@ -25,7 +25,7 @@ ERROR: bad-vocab-name name ;
 
 : check-vocab-name ( name -- name )
     dup string? [ bad-vocab-name ] unless
-    dup [ ":/\\ " member? ] any? [ bad-vocab-name ] when ;
+    dup [ "/\\ " member? ] any? [ bad-vocab-name ] when ;
 
 TUPLE: vocab-link name ;
 

extra/namespaces/extras/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

extra/namespaces/extras/extras.factor

@@ -0,0 +1,121 @@
+! 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.parser words ;
+QUALIFIED: sets
+IN: namespaces.extras
+
+<<
+ERROR: not-all-unique seq ;
+
+: ensure-unique ( seq -- seq )
+    dup sets:all-unique? [ not-all-unique ] unless ; inline
+
+: effect-in>drop-variables ( effect -- quot )
+    in>> ensure-unique
+    [ '[ name>> _ set ] ] map
+    '[ _ spread ] ; inline
+
+: make-in-drop-variables ( def effect -- def effect )
+    [
+        effect-in>drop-variables swap
+        '[ [ @ @ ] with-scope ]
+    ] keep ;
+>>
+
+: functor-definer-word-name ( word -- string )
+    name>> >lower "define-" prepend ;
+
+: functor-syntax-word-name ( word -- string )
+    name>> >upper ":" append ;
+
+: functor-instantiated-vocab-name ( functor-word parameters -- string )
+    dupd
+    '[
+        ! box-functor:functors:box:float:1827917291
+        _ vocabulary>> %
+        ":functors:" %
+        _ name>> % ! functor name, e.g. box
+        ":" %
+        _ hashcode number>string % ! narray for all the template parameters
+    ] "" make ;
+
+: prepend-input-vocabs ( word def effect -- word def effect )
+    [ 2drop ]
+    [
+        ! make FROM: vocab => word ; for each input argument
+        nip in>> length
+        [
+            dup '[ [ _ _ narray functor-instantiated-vocab-name "IN: " prepend ] _ nkeep ]
+        ] [
+            [
+                [
+                    [ vocabulary>> ] [ name>> ] bi
+                    "FROM: %s => %s ;" sprintf
+                ]
+            ] replicate
+        ] [ ] tri dup
+        ! Make the FROM: list and keep the input arguments
+        '[ [ @ _ spread _ narray "\n" join "\n" glue ] _ nkeep ]
+    ] [
+        [ drop ] 2dip
+        ! append the IN: and the FROM: quot generator and the functor code
+        [
+            append
+            '[ @ <string-reader> "functor" parse-stream drop ]
+        ] dip
+    ] 3tri ;
+
+: interpolate-assoc ( assoc -- quot )
+    assoc-invert
+    [ '[ _ interpolate>string _ set ] ] { } assoc>map [ ] concat-as ; inline
+
+: create-new-word-in ( string -- word )
+    create-word-in dup reset-generic ; 
+
+: lookup-word-in ( string -- word )
+    current-vocab lookup-word ;
+
+: (make-functor) ( word effect quot -- )
+    swap
+    make-in-drop-variables
+    prepend-input-vocabs
+    [
+        [ functor-definer-word-name create-new-word-in ] 2dip
+        define-declared
+    ] [
+        nip
+        [
+            [ functor-syntax-word-name create-new-word-in ]
+            [ functor-definer-word-name lookup-word-in ] bi
+        ] dip
+        in>> length [ [ scan-object ] ] replicate [ ] concat-as
+        swap
+        1quotation
+        '[ @ @ ] define-syntax
+    ] 3bi ; inline
+
+: make-functor-word ( word effect string -- )
+    nip 1quotation ( -- string ) define-declared ;
+
+: make-variable-functor ( word effect bindings string -- )
+    [
+        nip make-functor-word
+    ] [
+        [ interpolate-assoc ] dip ! do bindings in series
+        '[ @ _ interpolate>string append ] ! append the interpolated string to the FROM:
+        (make-functor)
+    ] 4bi ; inline
+
+: make-functor ( word effect string -- )
+    { } 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: \VARIABLE-FUNCTOR:
+    scan-new-word scan-effect scan-object scan-object make-variable-functor ;