Extended version of FUNC

〈Overview〉 ≡

func: make function! [
 {Defines a user function with given spec and body (extended version)} [catch]
 spec [block!] {Help string (opt) followed by arg words (and opt type and string)}
 body [block!] "The body block of the function"

 /local actual-spec actual-body value arglist-name arg-name arg-type arg-help arg-default
  actual-locals
] [
 actual-spec: make block! length? spec
 actual-body: make block! length? body
 actual-locals: clear [ ]
 parse spec [
  any [set value [string! | block!] (append/only actual-spec value)]
  any [
   set arglist-name word! into [
    some [
     set arg-name set-word!
     do-next (arg-default: pop-result)
     set arg-type opt block! ; no type checking yet...
     set arg-help opt string! (
      append actual-locals arg-name
      if found? :arg-default [repend actual-body [arg-name :arg-default]] ; FIX ME
     )
    ]
   ] (
    repend actual-spec [arglist-name [block!] "List of named arguments"]
    append actual-body compose/deep/only [
     parse (arglist-name) [
      any [
       set local set-word! (
        to paren! compose/only [
         unless find (copy actual-locals) local [
          make error! reduce ['script 'invalid-arg local]
         ]
        ]
       )
       do-next (
        to paren! [set bind local 'local pop-result]
       )
       |
       local: skip (to paren! [make error! reduce ['script 'invalid-arg local]])
      ]
     ]
    ]
   )
   |
   set arg-name word!
   set arg-type opt block!
   set arg-help opt string! (
    append actual-spec arg-name
    if arg-type [append/only actual-spec arg-type]
    if arg-help [append actual-spec arg-help]
   )
   |
   /local (
    append actual-spec /local
    foreach word actual-locals [append actual-spec to word! word]
    clear actual-locals
   )
   |
   set arg-name refinement!
   set arg-help opt string! (
    append actual-spec arg-name
    if arg-help [append actual-spec arg-help]
   )
   |
   skip
  ]
 ]
 unless empty? actual-locals [
  append actual-spec /local
  foreach word actual-locals [append actual-spec to word! word]
 ]
 append actual-body body
 throw-on-error [make function! actual-spec actual-body]
]