New COMPOSE behavior: splice only if ((...))

This is a behavior change (on par with evaluative SWITCH) which
makes COMPOSE not splice generated blocks until they are doubled up.

    >> block: [a b c]
    >> compose [normal: (block) spliced: ((block))]
    == [normal: [a b c] spliced: a b c]

It was a desirable option when the idea of doubled groups came up, as
the fatter appearance suggests some sort of multiplicity.  But the
first run of the idea was to let it be fatter to suggest "protection"
against splicing.

Yet pushing the desirability over the edge is the new semantics of
quoting in compose, where a quoted group means quoting that thing:

    >> var: first [foo]
    >> compose [word: '(var)]
    == [word: 'foo]

This concept of merging the quote onto the material is powerful, and
does not go along with the idea of single-parentheses associating with
a splice.

    >> block: [a b c]
    >> compose ['(block) (block): :(block)]
    == ['[a b c] [a b c]: :[a b c]]

In practice, the change of making it clear where the splices are is
extremely clarifying when reading code.  It might look a little bit
"cluttered" if you have to double up both your blocks and your groups
wen writing things out literally:

    compose [
       "item one"
       ((if condition [[
           "item two"
           "item three"
       ]]))
       "item four"
    ]

On the other hand, there are now quoted blocks plus soft quoted branch
handling to make it look a bit more clear:

    compose [
       "item one"
       ((if condition '[
           "item two"
           "item three"
       ]))
       "item four"
    ]

The mechanism for how this works is very interesting, because there is
an option to run a post-processing function on each slot.  And what
(( )) is actually doing is asking not to run that function.  But the
default function behavior is ENBLOCK.  Hence all slots actually are
splicing...they're just splicing things in blocks, and (( )) asks not
to put it in the block.

That means if you want all slots to splice you just ask to use the
function IDENTITY.

    compose /identity [
       "item one"
       (if condition [[
           "item two"
           "item three"
       ]])
       "item four"
    ]

The meaning of /ONLY is changed to mean "do not interpret ((...))
specially".  This could technically come in handy if you have
groups that wind up being generated from expressions and you are
doing some kind of compose-of-a-compose, and you don't want that
pattern appearing indavertently to splice.  But the more important
reason in the near term is so that old compose has the parameter to
be used in a fast emulation:

    compose-redbol: specialize (adapt 'compose [
        if only [predicate: null]
    ])[
        predicate: :identity
    ]

This makes an adaptation of compose which disables splicing when the
only switch is used.  Then it specializes the predicate out
of the interface by defaulting it to true, leaving /only on the
interface to control both properties.

So that will be used to implement COMPOSE in the Redbol emulation.

make/configs/emscripten.r

@@ -101,23 +101,23 @@ cflags: compose [
     ;
     {-DDEBUG_STDIO_OK}
 
-    (if debug-javascript-extension [[
+    ((if debug-javascript-extension [[
         {-DDEBUG_JAVASCRIPT_EXTENSION}
 
         ; {-DDEBUG_STDIO_OK}  ; !!! see above
         {-DDEBUG_HAS_PROBE}
         {-DDEBUG_COUNT_TICKS}
-    ]])
+    ]]))
 
-    (if use-emterpreter [[
+    ((if use-emterpreter [[
         {-DUSE_EMTERPRETER}  ; affects rebPromise() methodology
     ]] else [[
         ; Instruction to emcc (via -s) to include pthread functionalitys
         {-s USE_PTHREADS=1}  ; must be in both cflags and ldflags if used
 
         ; Instruction to compiler front end (via -D) to do a #define
         {-DUSE_PTHREADS=1}  ; clearer than `#if !defined(USE_EMSCRIPTEN)`
-    ]])
+    ]]))
 ]
 
 ldflags: compose [
@@ -167,7 +167,7 @@ ldflags: compose [
         {-s ASSERTIONS=0}
     ])
 
-    (if false [[
+    ((if false [[
         ; In theory, using the closure compiler will reduce the amount of
         ; unused support code in %libr3.js, at the cost of slower compilation. 
         ; Level 2 is also available, but is not recommended as it impedes
@@ -189,7 +189,7 @@ ldflags: compose [
         {--closure 1}
     ]] else [[
         {--closure 0}
-    ]])
+    ]]))
 
     ; Minification usually tied to optimization, but can be set separately.
     ;
@@ -237,7 +237,7 @@ ldflags: compose [
     ;
     ;{-s ALLOW_MEMORY_GROWTH=0}
 
-    (if use-emterpreter [[
+    ((if use-emterpreter [[
         {-s EMTERPRETIFY=1}
         {-s EMTERPRETIFY_ASYNC=1}
         {-s EMTERPRETIFY_FILE="libr3.bytecode"}
@@ -271,7 +271,7 @@ ldflags: compose [
         ; https://emscripten.org/docs/porting/pthreads.html
         ;
         {-s PTHREAD_POOL_SIZE=1}
-    ]])
+    ]]))
 
     ; When debugging in the emterpreter, stack frames all appear to have the
     ; function name `emterpret`.  Asking to turn on profiling will inject an

make/make.r

@@ -685,7 +685,7 @@ append app-config/cflags opt switch user-config/standard [
             ; when building as pre-C++11 where it was introduced, unless you
             ; disable that warning.
             ;
-            (if user-config/standard = 'c++98 [<gnu:-Wno-c++0x-compat>])
+            ((if user-config/standard = 'c++98 [<gnu:-Wno-c++0x-compat>]))
 
             ; Note: The C and C++ user-config/standards do not dictate if
             ; `char` is signed or unsigned.  Lest anyone think environments
@@ -1488,8 +1488,8 @@ app: make rebmake/application-class [
     depends: compose [
         (libr3-core)
         (libr3-os)
-        (ext-objs)
-        (app-config/libraries)
+        ((ext-objs))
+        ((app-config/libraries))
         (main)
     ]
     post-build-commands: either cfg-symbols [
@@ -1516,9 +1516,9 @@ library: make rebmake/dynamic-library-class [
     output: %libr3 ;no suffix
     depends: compose [
         (libr3-core)
-        (libr3-os)
-        (ext-objs)
-        (app-config/libraries)
+        ((libr3-os))
+        ((ext-objs))
+        ((app-config/libraries))
     ]
     searches: app-config/searches
     ldflags: app-config/ldflags
@@ -1567,11 +1567,12 @@ for-each ext dynamic-extensions [
         name: join either system-config/os-base = 'windows ["r3-"]["libr3-"]
             lowercase to text! ext/name
         output: to file! name
-        depends: append compose [
-            (mod-objs)
+        depends: compose [
+            ((mod-objs))
             (app) ;all dynamic extensions depend on r3
-            (app-config/libraries)
-        ] ext-libs
+            ((app-config/libraries))
+            ((ext-libs))
+        ]
 
         post-build-commands: either cfg-symbols [
             _
@@ -1583,7 +1584,7 @@ for-each ext dynamic-extensions [
             ]
         ]
 
-        ldflags: compose [(ext-ldflags) <gnu:-Wl,--as-needed>]
+        ldflags: compose [((ext-ldflags)) <gnu:-Wl,--as-needed>]
     ]
 
     add-project-flags/I/D/c/O/g ext-proj

make/tools/bootstrap-shim.r

@@ -89,7 +89,7 @@ modernize-action: function [
         ]
     ]
     body: compose [
-        (blankers)
+        ((blankers))
         (as group! body)
     ]
     return reduce [spec body]

make/tools/common-emitter.r

@@ -109,7 +109,7 @@ cscape: function [
             if with [
                 if lit-word? context [context: to word! context]
 
-                context: compose [(context)]  ; convert to block
+                context: compose [((context))]  ; convert to block
                 for-each item context [
                     bind code item
                 ]

make/tools/make-zlib.r

@@ -63,9 +63,9 @@ disable-user-includes: function [
     close-include (charset {">})
 ] [
     include-rule: compose [
-        (if stdio [
+        ((if stdio [
             [open-include copy name "stdio.h" close-include |]
-        ])
+        ]))
         {"} copy name to {"}
     ]
 

make/tools/parsing-tools.reb

@@ -29,9 +29,11 @@ parsing-at: func [
     use [result position][
         block: compose/only [try (as group! block)]
         if not end [
-            block: compose/deep [try if not tail? (word) [(block)]]
+            block: compose/deep [try if not tail? (word) [((block))]]
+        ]
+        block: compose/deep [
+            result: either position: ((block)) [[:position]] [[end skip]]
         ]
-        block: compose/deep [result: either position: (block) [[:position]] [[end skip]]]
         use compose [(word)] compose/deep [
             [(as set-word! :word) (as group! block) result]
         ]

make/tools/r2r3-future.r

@@ -393,7 +393,7 @@ actionmaker: lib/function [
         body: compose [
             real-return: :return
             return: does [real-return void]
-            (body)
+            ((body))
         ]
         chain [
             either gather-locals [:lib/function] [:lib/func]
@@ -438,7 +438,7 @@ method: enfix func [
         fail [member "must be bound to an ANY-CONTEXT! to use METHOD"]
     ]
     ;-- Older Ren-C don't take OBJECT! literally with <in>
-    set member (function compose [(spec) <in> context] body)
+    set member (function compose [((spec)) <in> context] body)
 ]
 
 meth: :func ;-- suitable enough synonym in the older Ren-C

make/tools/read-deep.reb

@@ -51,7 +51,7 @@ read-deep: function [
 
     result: copy []
 
-    queue: compose [(root)]
+    queue: compose [((root))]
 
     while [not tail? queue] [
         append result taker queue ;-- Possible null

make/tools/rebmake.r

@@ -994,9 +994,9 @@ object-file-class: make object! [
     ][
         cc: any [compiler default-compiler]
         cc/command/I/D/F/O/g/(PIC)/(E) output source
-            compose [(opt includes) (if I [ex-includes])]
-            compose [(opt definitions) (if D [ex-definitions])]
-            compose [(if F [ex-cflags]) (opt cflags)] ;; ex-cflags override
+            compose [((opt includes)) ((if I [ex-includes]))]
+            compose [((opt definitions)) ((if D [ex-definitions]))]
+            compose [((if F [ex-cflags])) ((opt cflags))] ; ex-cflags override
 
             ; current setting overwrites /refinement
             ; because the refinements are inherited from the parent
@@ -2075,7 +2075,7 @@ visual-studio: make generator-class [
                                 {        <AdditionalOptions>}
                                 spaced compose [
                                     {%(AdditionalOptions)}
-                                    (collected)
+                                    ((collected))
                                 ]
                                 {</AdditionalOptions>^/}
                             ]

make/tools/systems.r

@@ -533,10 +533,10 @@ use [
     ]
 
     unused-flags: exclude compose [
-        (words-of compiler-flags)
-        (words-of linker-flags)
-        (words-of system-definitions)
-        (words-of system-libraries)
+        ((words-of compiler-flags))
+        ((words-of linker-flags))
+        ((words-of system-definitions))
+        ((words-of system-libraries))
     ] used-flags
 
     if not empty? unused-flags [

scripts/redbol.reb

@@ -173,11 +173,11 @@ func: emulate [
         body [block!]
     ][
         func compose [
-           (optify spec) <local> exit
+           ((optify spec)) <local> exit
         ] compose [
             blankify-refinement-args binding of 'return
             exit: make action! [[] [unwind binding of 'return]]
-            (body)
+            ((body))
         ]
     ]
 ]
@@ -196,14 +196,14 @@ function: emulate [
         ; put everything into the spec...marked with <tags>
         ;
         function compose [
-            (optify spec)
-            (if with [<in>]) (:object) ;-- <in> replaces /WITH
-            (if extern [<with>]) (:words) ;-- <with> replaces /EXTERN
-            ;-- <local> exit, picked up since using FUNCTION as generator
+            ((optify spec))
+            (if with [<in>]) (:object)  ; <in> replaces /WITH
+            (if extern [<with>]) ((:words))  ; <with> replaces /EXTERN
+            ; <local> exit, picked up since using FUNCTION as generator
         ] compose [
             blankify-refinement-args binding of 'return
             exit: make action! [[] [unwind binding of 'return]]
-            (body)
+            ((body))
         ]
     ]
 ]
@@ -529,16 +529,18 @@ compose: emulate [
             not block? value [:value]
             into [
                 insert out apply 'compose [
-                    set* (lit value:) :value
+                    value: :value
                     deep: deep
-                    only: only
+                    only: true  ; controls turning off ((...)) splicing
+                    splice: not only  ; splice by default
                 ]
             ]
         ] else [
             apply 'compose [
-                set* (lit value:) :value
+                value: :value
                 deep: deep
-                only: only
+                only: true  ; controls turning off ((...)) splicing
+                splice: not only
             ]
         ]
     ]
@@ -849,7 +851,7 @@ foreach: emulate [
         use :vars [
             position: data
             while [not tail? position] compose [
-                (collect [
+                ((collect [
                     for-each item vars [
                         case [
                             set-word? item [
@@ -864,8 +866,8 @@ foreach: emulate [
                             fail "non SET-WORD?/WORD? in FOREACH vars"
                         ]
                     ]
-                ])
-                (body)
+                ]))
+                ((body))
             ]
         ]
     ]

src/core/d-test.c

@@ -46,7 +46,7 @@ REBNATIVE(test_librebol)
 {
     INCLUDE_PARAMS_OF_TEST_LIBREBOL;
     UNUSED(ARG(value));
-    
+
   #if !defined(INCLUDE_TEST_LIBREBOL_NATIVE)
     return Init_Text(  // text! vs. failing to distinguish from test failure
         D_OUT,

src/core/f-stubs.c

@@ -556,17 +556,20 @@ REBVAL *Setify(REBVAL *out) {
     REBCNT quotes = Dequotify(out);
 
     enum Reb_Kind kind = VAL_TYPE(out);
-    if (ANY_BLOCK_KIND(kind)) {
+    if (ANY_PLAIN_GET_SET_WORD_KIND(kind)) {
+        mutable_KIND_BYTE(out) = REB_SET_WORD;
+    }
+    else if (ANY_PATH_KIND(kind)) {
+        mutable_KIND_BYTE(out) = REB_SET_PATH;
+    }
+    else if (ANY_BLOCK_KIND(kind)) {
         mutable_KIND_BYTE(out) = REB_SET_BLOCK;
     }
     else if (ANY_GROUP_KIND(kind)) {
         mutable_KIND_BYTE(out) = REB_SET_GROUP;
     }
-    else if (ANY_PATH_KIND(kind)) {
-        mutable_KIND_BYTE(out) = REB_SET_PATH;
-    }
-    else if (ANY_PLAIN_GET_SET_WORD_KIND(kind)) {
-        mutable_KIND_BYTE(out) = REB_SET_WORD;
+    else if (kind == REB_NULLED) {
+        fail ("Cannot SETIFY a NULL");
     }
     else {
         // !!! For everything else, as en experiment see if there's some
@@ -582,6 +585,23 @@ REBVAL *Setify(REBVAL *out) {
 }
 
 
+//
+//  setify: native [
+//
+//  {If possible, convert a value to a SET-XXX! representation}
+//
+//      return: [set-word! set-path! set-group! set-block!]
+//      value [any-value!]
+//  ]
+//
+REBNATIVE(setify)
+{
+    INCLUDE_PARAMS_OF_SETIFY;
+
+    RETURN (Setify(ARG(value)));
+}
+
+
 //
 //  Getify: C
 //
@@ -603,6 +623,9 @@ REBVAL *Getify(REBVAL *out) {
     else if (ANY_PLAIN_GET_SET_WORD_KIND(kind)) {
         mutable_KIND_BYTE(out) = REB_GET_WORD;
     }
+    else if (kind == REB_NULLED) {
+        fail ("Cannot GETIFY a NULL");
+    }
     else {
         // !!! Experiment...see what happens if we fall back on GET-WORD!
         //
@@ -613,3 +636,20 @@ REBVAL *Getify(REBVAL *out) {
 
     return Quotify(out, quotes);
 }
+
+
+//
+//  getify: native [
+//
+//  {If possible, convert a value to a GET-XXX! representation}
+//
+//      return: [get-word! get-path! get-group! get-block!]
+//      value [any-value!]
+//  ]
+//
+REBNATIVE(getify)
+{
+    INCLUDE_PARAMS_OF_GETIFY;
+
+    RETURN (Getify(ARG(value)));
+}