Fixing a link to the demo

Fixing a link to the demo

git-svn-id: 50a8ad97cae5d6ab203d2d535a9b32cd3858a8ac@340 c04ce798-636b-4ca8-9149-0f9336831111

h1. What is CruiseControl.rb?

CruiseControl.rb is a continuous integration tool. Its basic purpose in life is to alert members of a software project
when one of them checks something into source control that breaks the build.

CC.rb is easy to install, pleasant to use and simple to hack. It's written in "Ruby":http://www.ruby-lang.org/en/.

p(hint). Hint: "Martin Fowler":http://martinfowler.com/ explains the how and why of Continuous Integration in this
         "article":http://martinfowler.com/articles/continuousIntegration.html.

h1. Feature list

* Can be installed in 10 minutes.

* Works out of the box with a regular "Ruby":http://www.ruby-lang.org/en/ or "Ruby on Rails":http://rubyonrails.org
  project. No configuration necessary.

* Web-based dashboard, convenient, useful and pretty.

* When a build is broken or fixed, notifies users via email, instant messaging or
  "CCTray":http://ccnet.sourceforge.net/CCNET/CCTray.html.

* RSS feed to track the build status of your favourite projects.

* Jump to the code causing a build error in one click.

* Displays custom build artifacts. No configuration necessary.

* Can interoperate with any build tool that can be invoked through command line and returns a non-zero exit code if
  the build fails. Like:
** nant
** ant
** etc...

* Extendable through builder plugins, custom build schedulers and other configuration options.

* Infinitely hackable thanks to publicly available source code and Ruby open classes.

* Free as in "free beer".

h1. Demo site

"Here":http://cruisecontrolrb.thoughtworks.com/projects is a public CruiseControl.rb instance
building itself and some other open-source projects.

Next step: "download":download.html CruiseControl.rb

h1. What is CruiseControl.rb?

CruiseControl.rb is a continuous integration tool. Its basic purpose in life is to alert members of a software project
when one of them checks something into source control that breaks the build.

CC.rb is easy to install, pleasant to use and simple to hack. It's written in "Ruby":http://www.ruby-lang.org/en/.

p(hint). Hint: "Martin Fowler":http://martinfowler.com/ explains the how and why of Continuous Integration in this
         "article":http://martinfowler.com/articles/continuousIntegration.html.

h1. Feature list

* Can be installed in 10 minutes.

* Works out of the box with a regular "Ruby":http://www.ruby-lang.org/en/ or "Ruby on Rails":http://rubyonrails.org
  project. No configuration necessary.

* Web-based dashboard, convenient, useful and pretty.

* When a build is broken or fixed, notifies users via email, instant messaging or
  "CCTray":http://ccnet.sourceforge.net/CCNET/CCTray.html.

* RSS feed to track the build status of your favourite projects.

* Jump to the code causing a build error in one click.

* Displays custom build artifacts. No configuration necessary.

* Can interoperate with any build tool that can be invoked through command line and returns a non-zero exit code if
  the build fails. Like:
** nant
** ant
** etc...

* Extendable through builder plugins, custom build schedulers and other configuration options.

* Infinitely hackable thanks to publicly available source code and Ruby open classes.

* Free as in "free beer".

h1. Demo site

"Here":http://cruisecontrolrb.thoughtworks.com/ is a public CruiseControl.rb instance building itself
and some other open-source projects.

Next step: "download":download.html CruiseControl.rb


TESTS: Additional tests for namespaces

TESTS: Additional tests for namespaces

Red/System [
	Title:   "Red/System null test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %namespace-test.reds
	Rights:  "Copyright (C) 2011 Nenad Rakocevic & Peter W A Wood. All rights reserved."
	License: "BSD-3 - https://github.com/dockimbel/Red/blob/origin/BSD-3-License.txt"
]

#include %../../../../quick-test/quick-test.reds

~~~start-file~~~ "namespace"

    nmsp1: context [
      i: 123
      f: 1.23
      f32: as float32! 2.46
      l: true
      s: "my string"
      fn: func [pi [pointer! [integer!]] return: [integer!]] [pi/value: 789 789]
      fn2: func [
        i [integer!]
        return: [integer!]
      ][ 2 * i]
      st: declare struct! [
        a [integer!]
        b [integer!]
      ]
    ]

    i: 987
	ctx: context [
		i: 123
		j: "test"
		foo: func [return: [integer!]][
			i: i + 1
			i
		]
		--test-- "in-ns1"
		--assert 124 = foo
	]

===start-group=== "basic"

  --test-- "ns1"
  --assert 123 = nmsp1/i
  --test-- "ns2"
  --assert 1.23 = nmsp1/f
  --test-- "ns3"
  --assert (as float32! 2.46) = nmsp1/f32
  --test-- "ns4"
  --assert nmsp1/l
  --test-- "ns5"
  --assert nmsp1/s/1 = #"m"
  --assert nmsp1/s/2 = #"y"
  --assert nmsp1/s/3 = #" "
  --assert nmsp1/s/4 = #"s"
  --assert nmsp1/s/5 = #"t"
  --assert nmsp1/s/6 = #"r"
  --assert nmsp1/s/7 = #"i"
  --assert nmsp1/s/8 = #"n"
  --assert nmsp1/s/9 = #"g"
  --test-- "ns6"
    nmsp1/s: "hello"
  --assert 5 = length? nmsp1/s
  --test-- "ns7"
    ns1-b-i: 0
  --assert 789 = nmsp1/fn :ns1-b-i
  --test-- "ns8"
    ns1-b-i: 4
  --assert 8 = nmsp1/fn2 ns1-b-i
  --test-- "ns9"
    nmsp1/st/a: 1
  --assert nmsp1/st/a = 1
  --test-- "ns10"
  --assert ctx/j/1 = #"t"
  --test-- "ns11"
  --assert ctx/foo = 125
  --test-- "ns12"
    ctx/i: ctx/i + 1
  --assert ctx/i = 126
  --assert i = 987
  --test-- "ns13"
    ns13i: 1
    ns13i-nsp: context [
      ns13i: 2
      get-ns13i: func [return: [integer!]] [ns13i]
    ]
  --assert 2 = ns13i-nsp/get-ns13i

===end-group===

===start-group=== "hiding"
    i: 321
    f: 3.21
    f32: as float32! 6.42
    l: false
    s: "not my string"
    fn: func [pi [pointer! [integer!]]] [pi/value: 987]
    fn2: func[
        i [integer!]
        return: [integer!]
      ][ 3 * i]
    st: declare struct! [
        a [integer!]
        b [integer!]
    ]

  --test-- "nmh1"
    nmsp1/i: 789
  --assert i = 321
  --test-- "nmh2"
    nmsp1/f: 7.89
  --assert f = 3.21
  --test-- "nmh3"
    nmsp1/f32: as float32! 7.89
  --assert nmsp1/f32 = as float32! 7.89
  --test-- "nmh4"
    nmsp1/s: "str"
  --assert 13 = length? s
  --test-- "nmh5"
    nmh5-i: 1
    nmsp1/fn :nmh5-i
  --assert 789 = nmh5-i
  --test-- "nmh6"
    nmh6-i: 1
    fn :nmh6-i
  --assert 987 = nmh6-i
  --test-- "nmh7"
    nmh7-i: 2
  --assert 4 = nmsp1/fn2 nmh7-i
  --assert 6 = fn2 nmh7-i
  --test-- "nmh8"
    st/a: 1
    st/b: 2
    nmsp1/st/a: 100
    nmsp1/st/b: 200
  --assert 1 = st/a
  --assert 2 = st/b

===end-group===

===start-group=== "initialisation"
    nmsp2: context [
      i: 2
      j: 3
      k: 0
      s: "12345"
      st: declare struct! [
        a [integer!]
        b [c-string!]
        c [float!]
        d [integer!]
      ]

      k: i * j
      s/1: #"h"
      s/2: #"e"
      s/3: #"l"
      s/4: #"l"
      s/5: #"o"
      st/a: 1
      st/b: "hello"
      st/c: 12345.678
      st/d: 1
      until [
        i: i * j
        j: j - 1
        j < 1
      ]
    ]
  --test-- "nmi1"
  --assert nmsp2/i = 12
  --test-- "nmi2"
  --assert nmsp2/j = 0
  --test-- "nmi3"
  --assert nmsp2/k = 6
  --test-- "nmi4"
  --assert nmsp2/s/1 = #"h"
  --assert nmsp2/s/2 = #"e"
  --assert nmsp2/s/3 = #"l"
  --assert nmsp2/s/4 = #"l"
  --assert nmsp2/s/5 = #"o"
  --test-- "nmi5"
  --assert nmsp2/st/a = 1
  --test-- "nmi6"
  --assert nmsp2/st/b/1 = #"h"
  --assert nmsp2/st/b/2 = #"e"
  --assert nmsp2/st/b/3 = #"l"
  --assert nmsp2/st/b/4 = #"l"
  --assert nmsp2/st/b/5 = #"o"
  --test-- "nmi7"
  --assert nmsp2/st/c = 12345.678
  --test-- "nmi8"
  --assert nmsp2/st/d = 1

===end-group===

===start-group=== "multiple"
    nmspa: context [
      i: 1
    ]
    nmspb: context [
      i: 2
    ]
    nmspc: context [
      i: 3
    ]
    nmspd: context [
      i: 4
    ]
    nmspe: context [
      i: 5
    ]
    nmspf: context [
      i: 6
    ]
    nmspg: context [
      i: 7
    ]
    nmsph: context [
      i: 8
    ]
    nmspi: context [
      i: 9
    ]
    nmspj: context [
      i: 10
    ]
    nmspk: context [
      i: 11
    ]
  --test-- "nmm1"
  --assert nmspa/i = 1
  --assert nmspb/i = 2
  --assert nmspc/i = 3
  --assert nmspd/i = 4
  --assert nmspe/i = 5
  --assert nmspf/i = 6
  --assert nmspg/i = 7
  --assert nmsph/i = 8
  --assert nmspi/i = 9
  --assert nmspj/i = 10
  --assert nmspk/i = 11

===end-group===

===start-group=== "global access"
  --test-- "nmga1"
    i2: 0
    j: 3
    nmsp3: context [
      i: 2
      k: i * j
      i2: 4
    ]
  --assert nmsp3/k = 6
  --assert nmsp3/i2 = 4
  --assert i2 = 0
  --test-- "nmga2"
      j3: 1
    nmsp4: context [
      i3: 2
      k3: i3 * j3
      i4: 4
    ]
    i4: 0
    j3: 3
  --assert nmsp4/k3 = 2
  --assert i4 = 0
===end-group===

===start-group=== "pointers"
  --test-- "nmp1"
    i: 12345
    nmsp5: context [
      pi: declare pointer! [integer!]
    ]
    nmsp5/pi: :i
  --assert nmsp5/pi/value = 12345
  ; --test-- "nmp2"						;-- getting a pointer on a variable in a context is not
  ;   pi: declare pointer! [integer!]	;-- a supported feature. Use a local function to get such
  ;   nmsp6: context [					;-- pointer.
  ;     i: 12345
  ;   ]
  ;   pi: :nmsp6/i
  ; --assert pi/value = 12345
  --test-- "nmp3"
    nmsp6a: context [
      i: 67890
      get-addr-i: func [
        return: [pointer! [integer!]]
      ][
        :i
      ]
    ]
    pinmp3: declare pointer! [integer!]
    pinmp3: nmsp6a/get-addr-i
  --assert 67890 = pinmp3/value

===end-group===

===start-group=== "nesting"
  --test-- "nmm1"
    nmsp7: context [
      i: 0
      nmsp7-1: context [
        i: 1
        j: i * nmsp7/i
        nmsp7-2: context [
          i: 2
          j: i * nmsp7/i
          k: i * nmsp7/nmsp7-1/i
          nmsp7-3: context [
            i: 3
            j: i * nmsp7/i
            k: i * nmsp7/nmsp7-1/i
            l: i * nmsp7/nmsp7-1/nmsp7-2/i
          ]
        ]
      ]
    ]
  --assert nmsp7/i = 0
  --assert nmsp7/nmsp7-1/i = 1
  --assert nmsp7/nmsp7-1/j = 0
  --assert nmsp7/nmsp7-1/nmsp7-2/i = 2
  --assert nmsp7/nmsp7-1/nmsp7-2/j = 0
  --assert nmsp7/nmsp7-1/nmsp7-2/k = 2
  --assert nmsp7/nmsp7-1/nmsp7-2/nmsp7-3/i = 3
  --assert nmsp7/nmsp7-1/nmsp7-2/nmsp7-3/j = 0
  --assert nmsp7/nmsp7-1/nmsp7-2/nmsp7-3/k = 3
  --assert nmsp7/nmsp7-1/nmsp7-2/nmsp7-3/l = 6
===end-group===

===start-group=== "include"
  --test-- "nminc1"
    nmsp8: context [
      #include %namespace-test-include.reds
    ]
  --assert 54321 = nmsp8/i

===end-group===

===start-group=== "libs"
    nmsp-lib: context [
      #import [
        LIBM-file cdecl [
          abs-int: "abs" [
            i       [integer!]
            return: [integer!]
          ]
        ]
      ]
      #import [
        LIBC-file cdecl [
          strnlen: "strnlen" [
            str     [c-string!]
            maxlen  [integer!]
            return: [integer!]
          ]
        ]
      ]
    ]
  --test-- "nmlibs1"
  --assert 1 = nmsp-lib/abs-int -1
  --test-- "nmlibs2"
  --assert 11 = nmsp-lib/strnlen "hello world" 20

===end-group===

===start-group=== "cross-reference"

	nmxr1: context [c: 789 fooo: func [][nmxr2/e: 123]]
	nmxr2: context [e: 456 f: nmxr1/c]

	--test-- "ns-cross-1"
	--assert nmxr2/e = 456
	nmxr1/fooo
	--assert nmxr2/e = 123

	--test-- "ns-cross-2"
	--assert nmxr2/f = 789

===end-group===

===start-group=== "with"
  --test-- "nsw1"
    nsw1-nsp: context [b: 123]
    with nsw1-nsp [
      --assert b = 123
    ]

  --test-- "nsw2"
    nsw2-nsp1: context [b: 123]
    nsw2-nsp2: context [b: 456]
    with [nsw2-nsp1 nsw-nsp2] [
      --assert b = 123
    ]

===end-group===

~~~end-file~~~

Red/System [
	Title:   "Red/System null test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %namespace-test.reds
	Rights:  "Copyright (C) 2011 Nenad Rakocevic & Peter W A Wood. All rights reserved."
	License: "BSD-3 - https://github.com/dockimbel/Red/blob/origin/BSD-3-License.txt"
]

#include %../../../../quick-test/quick-test.reds

~~~start-file~~~ "namespace"

    nmsp1: context [
      i: 123
      f: 1.23
      f32: as float32! 2.46
      l: true
      s: "my string"
      fn: func [pi [pointer! [integer!]] return: [integer!]] [pi/value: 789 789]
      fn2: func [
        i [integer!]
        return: [integer!]
      ][ 2 * i]
      st: declare struct! [
        a [integer!]
        b [integer!]
      ]
    ]

    i: 987
	ctx: context [
		i: 123
		j: "test"
		foo: func [return: [integer!]][
			i: i + 1
			i
		]
		--test-- "in-ns1"
		--assert 124 = foo
	]

===start-group=== "basic"

  --test-- "ns1"
  --assert 123 = nmsp1/i
  --test-- "ns2"
  --assert 1.23 = nmsp1/f
  --test-- "ns3"
  --assert (as float32! 2.46) = nmsp1/f32
  --test-- "ns4"
  --assert nmsp1/l
  --test-- "ns5"
  --assert nmsp1/s/1 = #"m"
  --assert nmsp1/s/2 = #"y"
  --assert nmsp1/s/3 = #" "
  --assert nmsp1/s/4 = #"s"
  --assert nmsp1/s/5 = #"t"
  --assert nmsp1/s/6 = #"r"
  --assert nmsp1/s/7 = #"i"
  --assert nmsp1/s/8 = #"n"
  --assert nmsp1/s/9 = #"g"
  --test-- "ns6"
    nmsp1/s: "hello"
  --assert 5 = length? nmsp1/s
  --test-- "ns7"
    ns1-b-i: 0
  --assert 789 = nmsp1/fn :ns1-b-i
  --test-- "ns8"
    ns1-b-i: 4
  --assert 8 = nmsp1/fn2 ns1-b-i
  --test-- "ns9"
    nmsp1/st/a: 1
  --assert nmsp1/st/a = 1
  --test-- "ns10"
  --assert ctx/j/1 = #"t"
  --test-- "ns11"
  --assert ctx/foo = 125
  --test-- "ns12"
    ctx/i: ctx/i + 1
  --assert ctx/i = 126
  --assert i = 987

===end-group===

===start-group=== "hiding"
    i: 321
    f: 3.21
    f32: as float32! 6.42
    l: false
    s: "not my string"
    fn: func [pi [pointer! [integer!]]] [pi/value: 987]
    fn2: func[
        i [integer!]
        return: [integer!]
      ][ 3 * i]
    st: declare struct! [
        a [integer!]
        b [integer!]
    ]

  --test-- "nmh1"
    nmsp1/i: 789
  --assert i = 321
  --test-- "nmh2"
    nmsp1/f: 7.89
  --assert f = 3.21
  --test-- "nmh3"
    nmsp1/f32: as float32! 7.89
  --assert nmsp1/f32 = as float32! 7.89
  --test-- "nmh4"
    nmsp1/s: "str"
  --assert 13 = length? s
  --test-- "nmh5"
    nmh5-i: 1
    nmsp1/fn :nmh5-i
  --assert 789 = nmh5-i
  --test-- "nmh6"
    nmh6-i: 1
    fn :nmh6-i
  --assert 987 = nmh6-i
  --test-- "nmh7"
    nmh7-i: 2
  --assert 4 = nmsp1/fn2 nmh7-i
  --assert 6 = fn2 nmh7-i
  --test-- "nmh8"
    st/a: 1
    st/b: 2
    nmsp1/st/a: 100
    nmsp1/st/b: 200
  --assert 1 = st/a
  --assert 2 = st/b

===end-group===

===start-group=== "initialisation"
    nmsp2: context [
      i: 2
      j: 3
      k: 0
      s: "12345"
      st: declare struct! [
        a [integer!]
        b [c-string!]
        c [float!]
        d [integer!]
      ]

      k: i * j
      s/1: #"h"
      s/2: #"e"
      s/3: #"l"
      s/4: #"l"
      s/5: #"o"
      st/a: 1
      st/b: "hello"
      st/c: 12345.678
      st/d: 1
      until [
        i: i * j
        j: j - 1
        j < 1
      ]
    ]
  --test-- "nmi1"
  --assert nmsp2/i = 12
  --test-- "nmi2"
  --assert nmsp2/j = 0
  --test-- "nmi3"
  --assert nmsp2/k = 6
  --test-- "nmi4"
  --assert nmsp2/s/1 = #"h"
  --assert nmsp2/s/2 = #"e"
  --assert nmsp2/s/3 = #"l"
  --assert nmsp2/s/4 = #"l"
  --assert nmsp2/s/5 = #"o"
  --test-- "nmi5"
  --assert nmsp2/st/a = 1
  --test-- "nmi6"
  --assert nmsp2/st/b/1 = #"h"
  --assert nmsp2/st/b/2 = #"e"
  --assert nmsp2/st/b/3 = #"l"
  --assert nmsp2/st/b/4 = #"l"
  --assert nmsp2/st/b/5 = #"o"
  --test-- "nmi7"
  --assert nmsp2/st/c = 12345.678
  --test-- "nmi8"
  --assert nmsp2/st/d = 1

===end-group===

===start-group=== "multiple"
    nmspa: context [
      i: 1
    ]
    nmspb: context [
      i: 2
    ]
    nmspc: context [
      i: 3
    ]
    nmspd: context [
      i: 4
    ]
    nmspe: context [
      i: 5
    ]
    nmspf: context [
      i: 6
    ]
    nmspg: context [
      i: 7
    ]
    nmsph: context [
      i: 8
    ]
    nmspi: context [
      i: 9
    ]
    nmspj: context [
      i: 10
    ]
    nmspk: context [
      i: 11
    ]
  --test-- "nmm1"
  --assert nmspa/i = 1
  --assert nmspb/i = 2
  --assert nmspc/i = 3
  --assert nmspd/i = 4
  --assert nmspe/i = 5
  --assert nmspf/i = 6
  --assert nmspg/i = 7
  --assert nmsph/i = 8
  --assert nmspi/i = 9
  --assert nmspj/i = 10
  --assert nmspk/i = 11

===end-group===

===start-group=== "global access"
  --test-- "nmga1"
    i2: 0
    j: 3
    nmsp3: context [
      i: 2
      k: i * j
      i2: 4
    ]
  --assert nmsp3/k = 6
  --assert nmsp3/i2 = 4
  --assert i2 = 0
  --test-- "nmga2"
      j3: 1
    nmsp4: context [
      i3: 2
      k3: i3 * j3
      i4: 4
    ]
    i4: 0
    j3: 3
  --assert nmsp4/k3 = 2
  --assert i4 = 0
===end-group===

===start-group=== "pointers"
  --test-- "nmp1"
    i: 12345
    nmsp5: context [
      pi: declare pointer! [integer!]
    ]
    nmsp5/pi: :i
  --assert nmsp5/pi/value = 12345
 ; --test-- "nmp2"						;-- getting a pointer on a variable in a context is not
 ;   pi: declare pointer! [integer!]	;-- a supported feature. Use a local function to get such
 ;   nmsp6: context [					;-- pointer.
 ;     i: 12345
 ;   ]
 ;   pi: :nmsp6/i
 ; --assert pi/value = 12345
===end-group===

===start-group=== "nesting"
  --test-- "nmm1"
    nmsp7: context [
      i: 0
      nmsp7-1: context [
        i: 1
        j: i * nmsp7/i
        nmsp7-2: context [
          i: 2
          j: i * nmsp7/i
          k: i * nmsp7/nmsp7-1/i
          nmsp7-3: context [
            i: 3
            j: i * nmsp7/i
            k: i * nmsp7/nmsp7-1/i
            l: i * nmsp7/nmsp7-1/nmsp7-2/i
          ]
        ]
      ]
    ]
  --assert nmsp7/i = 0
  --assert nmsp7/nmsp7-1/i = 1
  --assert nmsp7/nmsp7-1/j = 0
  --assert nmsp7/nmsp7-1/nmsp7-2/i = 2
  --assert nmsp7/nmsp7-1/nmsp7-2/j = 0
  --assert nmsp7/nmsp7-1/nmsp7-2/k = 2
  --assert nmsp7/nmsp7-1/nmsp7-2/nmsp7-3/i = 3
  --assert nmsp7/nmsp7-1/nmsp7-2/nmsp7-3/j = 0
  --assert nmsp7/nmsp7-1/nmsp7-2/nmsp7-3/k = 3
  --assert nmsp7/nmsp7-1/nmsp7-2/nmsp7-3/l = 6
===end-group===

===start-group=== "include"
  --test-- "nminc1"
    nmsp8: context [
      #include %namespace-test-include.reds
    ]
  --assert 54321 = nmsp8/i

===end-group===

===start-group=== "libs"
    nmsp-lib: context [
      #import [
        LIBM-file cdecl [
          abs-int: "abs" [
            i       [integer!]
            return: [integer!]
          ]
        ]
      ]
      #import [
        LIBC-file cdecl [
          strnlen: "strnlen" [
            str     [c-string!]
            maxlen  [integer!]
            return: [integer!]
          ]
        ]
      ]
    ]
  --test-- "nmlibs1"
  --assert 1 = nmsp-lib/abs-int -1
  --test-- "nmlibs2"
  --assert 11 = nmsp-lib/strnlen "hello world" 20

===end-group===

===start-group=== "cross-reference"

	nmxr1: context [c: 789 fooo: func [][nmxr2/e: 123]]
	nmxr2: context [e: 456 f: nmxr1/c]

	--test-- "ns-cross-1"
	--assert nmxr2/e = 456
	nmxr1/fooo
	--assert nmxr2/e = 123

	--test-- "ns-cross-2"
	--assert nmxr2/f = 789

===end-group===

~~~end-file~~~


TESTS: objects basic tests added.

TESTS: objects basic tests added.

Red [
	Title:   "Red/System object! datatype test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %object-test.red
	Version: "0.1.0"
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2014 Nenad Rakocevic & Peter W A Wood. All rights reserved."
	License: "BSD-3 - https://github.com/dockimbel/Red/blob/origin/BSD-3-License.txt"
]

#include  %../../../quick-test/quick-test.red

~~~start-file~~~ "object"

===start-group=== "basic tests"

	--test-- "basic-1"
		obj1: context []
		--assert "make object! []" = mold obj1

	--test-- "basic-2"
		obj2: object []
		--assert "make object! []" = mold obj2

	--test-- "basic-3"
		obj3: make object! []
		--assert "make object! []" = mold obj3

	--test-- "basic-4"
		blk: []
		obj4: object blk
		--assert "make object! []" = mold obj4

	--test-- "basic-5"
		obj5: object [
			a: 123
			show: does [a + 1]
			reset: does [a: none]
			--assert show = 124
			--assert a = 123
		]
		--assert obj5/show = 124
		obj5/reset
		--assert none? obj5/a

	--test-- "basic-6"
		obj5/a: 456
		--assert obj5/a = 456

	--test-- "basic-7"
		--assert find obj5 'a
		--assert not find obj5 'z
		--assert 456 = select obj5 'a
		--assert none? select obj5 'z

	--test-- "basic-8"
		obj8: context [
			b: 123
			a: object [
				b: 456
				double: does [b * 2]
				set-b: does [b: 'hello]
			]
		]
		--assert obj8/b = 123
		--assert obj8/a/b = 456
		--assert obj8/a/double = 912
		obj8/a/set-b
		--assert obj8/a/b = 'hello

	--test-- "basic-9"
		obj8/a/b: 'red
		--assert obj8/a/b = 'red

	--test-- "basic-10"
		obj10: object [
			a: 1
			b: 2
			inc: func [i /with a][b: i + either with [a][b]]
			sub: context [
				a: 3
				b: 4
				inc: func [i /with a][b: i + either with [a][b]]
			]
		]
		--assert 12 = obj10/inc 10
		--assert obj10/b = 12

		--assert 14 = obj10/sub/inc 10
		--assert obj10/sub/b = 14

	--test-- "basic-11"
		--assert 30 = obj10/inc/with 10 20
		--assert obj10/b = 30

		--assert 50 = obj10/sub/inc/with 10 40
		--assert obj10/sub/b = 50

	--test-- "basic-12"
		blk: [a: 99]
		obj12: object blk
		--assert obj12/a = 99

===end-group===

===start-group=== "SELF test"

===end-group===

===start-group=== "simple object tests"

	--test-- "simple object 1"
		so1-a: 0
		so1-o: make object! [so1-a: 1]
		--assert so1-a = 0
		--assert so1-o/so1-a = 1

	--test-- "simple object 2"
		so2-s: "0"
		so2-o: make object! [so2-s: "1"]
		--assert so2-s = "0"
		--assert so2-o/so2-s = "1"

	--test-- "simple object 3"
		so3-s: "0"
		so3-i: 0
		so3-l: true
		so3-c: #"a"
		so3-b: [a b c]
		so3-f: func [][0]
		so3-bs: charset #"^(00)"
		so3-o: make object! [
			so3-s: "1"
			so3-i: 1
			so3-l: false
			so3-c: #"b"
			so3-b: [a b d]
			so3-f: func [][1]
			so3-bs: charset #"^(01)"
		]
		--assert so3-s = "0"
		--assert so3-o/so3-s = "1"
		--assert so3-i = 0
		--assert so3-o/so3-i = 1
		--assert so3-l = true
		--assert so3-o/so3-l = false
		--assert so3-c = #"a"
		--assert so3-o/so3-c = #"b"
		--assert so3-b = [a b c]
		--assert so3-o/so3-b = [a b d]
		--assert so3-f = 0
		--assert so3-o/so3-f = 1
		--assert "make bitset! #{80}" = mold so3-bs
		--assert "make bitset! #{40}" = mold so3-o/so3-bs

===end-group===

===start-group=== "nested objects"

	--test-- "no1"
		no1-o: make object! [o: make object! [i: 1] ]
		--assert no1-o/o/i = 1

	--test-- "no2"
		no2-o1: make object! [
			o2: make object! [
				i: 1
			]
		]
		--assert no2-o1/o2/i = 1

	--test-- "no3"
		no3-o1: make object! [
			o2: make object! [
			o3: make object! [
			o4: make object! [
				i: 1
			]]]
		]
		--assert no3-o1/o2/o3/o4/i = 1

	--test-- "no4"
		no4-o1: make object! [
			o2: make object! [
			o3: make object! [
			o4: make object! [
			o5: make object! [
			o6: make object! [
			o7: make object! [
				i: 1
			]]]]]]
		]
		--assert no4-o1/o2/o3/o4/o5/o6/o7/i = 1

	--test-- "no5"
		no5-o1: make object! [
			o2: make object! [
			o3: make object! [
			o4: make object! [
			o5: make object! [
			o6: make object! [
			o7: make object! [
			o8: make object! [
			o9: make object! [
			o10: make object! [
			o11: make object! [
			o12: make object! [
			o13: make object! [
			o14: make object! [
			o15: make object! [
				i: 1
			]]]]]]]]]]]]]]
		]
		--assert no5-o1/o2/o3/o4/o5/o6/o7/o8/o9/o10/o11/o12/o13/o14/o15/i = 1

===end-group===

===start-group=== "object prototype tests"

	--test-- "op1"
		op1-o1: make object! [i: 1]
		op1-o2: make op1-o1 []
		--assert op1-o2/i = 1

	--test-- "op2"
		op2-o1: make object! [i: 1]
		op2-o2: make op2-o1 [i: 2]
		--assert op2-o2/i = 2
		--assert op2-o1/i = 1

	--test-- "op3"
		op3-o1: make object! [i: 1]
		op3-o2: make op3-o1 [i: 2 j: 3]
		--assert op3-o2/i = 2
		--assert op3-o2/j = 3

===end-group===

===start-group=== "object initialisation processing"

	--test-- "oip1"
		oip1-i: 1
		oip1-o: make object! [
			i: oip1-i
		]
		--assert 1 = oip1-o/i

	--test-- "oip2"
		oip2-i: 1
		oip2-o: make object! [
			i: either oip2-i = 1 [2] [3]
		]
		--assert 2 = oip2-o/i

	--test-- "oip3"
		oip3-i: 1
		oip3-o: make object! [
			i: 0
			set 'oip3-i 2
		]
		--assert 2 = oip3-i

	--test-- "oip4"
		oip4-o: make object! [
			i: 0
			set 'oip4-i 3
		]
		--assert 3 = oip4-i

===end-group===

===start-group=== "inheritance"

	--test-- "inherit-1"
		proto: context [
			a: 123
			get-a: does [a]
		]
		new: make proto [a: 99]
		--assert new/a
		--assert new/get-a = 99
		--assert proto/get-a = 123

	--test-- "inherit-2"
		new/a: 456
		--assert new/get-a = 456
		proto/a: 759
		--assert proto/a = 759
		--assert new/get-a = 456

	--test-- "inherit-3"
		newnew: make new [
			reset: does [a: none]
		]
		--assert newnew/a = 456
		newnew/reset
		--assert none? newnew/a
		--assert new/a = 456
		--assert proto/a = 759

	--test-- "inherit-4"
		base: context [
			v: 0
			foo: does [v]
		]

		i: 0
		list: []
		loop 2 [
			bb: make base [v: i]
			--assert bb/foo = i
			append list bb
			i: i + 1
		]
		--assert object? list/1
		--assert list/1/v = 0
		--assert list/2/v = 1

	--test-- "inherit-5"
		base5: context [
			b: 123
			get-b: does [b]
			a: object [
				b: 456
				double: does [b * 2]
				set-b: func [/with v] [b: either with [v]['hello]]
			]
		]
		proto5: context [
			b: 999
			value: 71
			foo: does [b + value]
		]
		new: make base5 proto5
		--assert object? new
		--assert new/b = 999
		--assert new/value = 71
		--assert new/a/b = 456
		--assert base5/b = 123

	--test-- "inherit-6"
		--assert new/get-b = 999
		--assert new/a/double = 912
		--assert new/a/set-b/with 10
		--assert new/a/b = 10
		--assert new/b = 999
		--assert base5/b = 123
		--assert new/a/double = 20
		--assert base5/a/double = 20

	--test-- "inherit-7"
		;--assert new/a = base5/a 			;@@ COMPARE action not implemented yet

	--test-- "inherit-8"
		;--assert new/foo = 1070

===end-group===

~~~end-file~~~

Red [
	Title:   "Red/System object! datatype test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %object-test.red
	Version: "0.1.0"
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2014 Nenad Rakocevic & Peter W A Wood. All rights reserved."
	License: "BSD-3 - https://github.com/dockimbel/Red/blob/origin/BSD-3-License.txt"
]

#include  %../../../quick-test/quick-test.red

~~~start-file~~~ "object"

===start-group=== "simple object tests"

	--test-- "simple object 1"
		so1-a: 0
		so1-o: make object! [so1-a: 1]
		--assert so1-a = 0
		--assert so1-o/so1-a = 1

	--test-- "simple object 2"
		so2-s: "0"
		so2-o: make object! [so2-s: "1"]
		--assert so2-s = "0"
		--assert so2-o/so2-s = "1"

	--test-- "simple object 3"
		so3-s: "0"
		so3-i: 0
		so3-l: true
		so3-c: #"a"
		so3-b: [a b c]
		so3-f: func [][0]
		so3-bs: charset #"^(00)"
		so3-o: make object! [
			so3-s: "1"
			so3-i: 1
			so3-l: false
			so3-c: #"b"
			so3-b: [a b d]
			so3-f: func [][1]
			so3-bs: charset #"^(01)"
		]
		--assert so3-s = "0"
		--assert so3-o/so3-s = "1"
		--assert so3-i = 0
		--assert so3-o/so3-i = 1
		--assert so3-l = true
		--assert so3-o/so3-l = false
		--assert so3-c = #"a"
		--assert so3-o/so3-c = #"b"
		--assert so3-b = [a b c]
		--assert so3-o/so3-b = [a b d]
		--assert so3-f = 0
		--assert so3-o/so3-f = 1
		--assert "make bitset! #{80}" = mold so3-bs
		--assert "make bitset! #{40}" = mold so3-o/so3-bs

===end-group===

===start-group=== "nested objects"

	--test-- "no1"
		no1-o: make object! [o: make object! [i: 1] ]
		--assert no1-o/o/i = 1

	--test-- "no2"
		no2-o1: make object! [
			o2: make object! [
				i: 1
			]
		]
		--assert no2-o1/o2/i = 1

	--test-- "no3"
		no3-o1: make object! [
			o2: make object! [
			o3: make object! [
			o4: make object! [
				i: 1
			]]]
		]
		--assert no3-o1/o2/o3/o4/i = 1

	--test-- "no4"
		no4-o1: make object! [
			o2: make object! [
			o3: make object! [
			o4: make object! [
			o5: make object! [
			o6: make object! [
			o7: make object! [
				i: 1
			]]]]]]
		]
		--assert no4-o1/o2/o3/o4/o5/o6/o7/i = 1

	--test-- "no5"
		no5-o1: make object! [
			o2: make object! [
			o3: make object! [
			o4: make object! [
			o5: make object! [
			o6: make object! [
			o7: make object! [
			o8: make object! [
			o9: make object! [
			o10: make object! [
			o11: make object! [
			o12: make object! [
			o13: make object! [
			o14: make object! [
			o15: make object! [
				i: 1
			]]]]]]]]]]]]]]
		]
		--assert no5-o1/o2/o3/o4/o5/o6/o7/o8/o9/o10/o11/o12/o13/o14/o15/i = 1

	--test-- "no6"
		no6-o1: make object! [
			o2: make object! [
			o3: make object! [
			o4: make object! [
			o5: make object! [
			o6: make object! [
			o7: make object! [
			o8: make object! [
			o9: make object! [
			o10: make object! [
			o11: make object! [
			o12: make object! [
			o13: make object! [
			o14: make object! [
			o15: make object! [
			o16: make object! [
				i: 1
			]]]]]]]]]]]]]]]
		]
		--assert no6-o1/o2/o3/o4/o5/o6/o7/o8/o9/o10/o11/o12/o13/o14/o15/o16/i = 1

	--test-- "no7"
		no7-o1: make object! [
			o2: make object! [
			o3: make object! [
			o4: make object! [
			o5: make object! [
			o6: make object! [
			o7: make object! [
			o8: make object! [
			o9: make object! [
			o10: make object! [
			o11: make object! [
			o12: make object! [
			o13: make object! [
			o14: make object! [
			o15: make object! [
			o16: make object! [
			o17: make object! [
				i: 1
			]]]]]]]]]]]]]]]]
		]
		--assert no7-o1/o2/o3/o4/o5/o6/o7/o8/o9/o10/o11/o12/o13/o14/o15/o16/o17/i = 1

===end-group===

===start-group=== "object prototype tests"

	--test-- "op1"
		op1-o1: make object! [i: 1]
		op1-o2: make op1-o1 []
		--assert op1-o2/i = 1

	--test-- "op2"
		op2-o1: make object! [i: 1]
		op2-o2: make op2-o1 [i: 2]
		--assert op2-o2/i = 2
		--assert op2-o1/i = 1

	--test-- "op3"
		op3-o1: make object! [i: 1]
		op3-o2: make op3-o1 [i: 2 j: 3]
		--assert op3-o2/i = 2
		--assert op3-o2/j = 3

===end-group===

===start-group=== "object initialisation processing"

	--test-- "oip1"
		oip1-i: 1
		oip1-o: make object! [
			i: oip1-i
		]
		--assert 1 = oip1-o/i

	--test-- "oip2"
		oip2-i: 1
		oip2-o: make object! [
			i: either oip2-i = 1 [2] [3]
		]
		--assert 2 = oip2-o/i

	--test-- "oip3"
		oip3-i: 1
		oip3-o: make object! [
			i: 0
			set 'oip3-i 2
		]
		--assert 2 = oip3-i

	--test-- "oip4"
		oip4-o: make object! [
			i: 0
			set 'oip4-i 3
		]
		--assert 3 = oip4-i

===end-group===

~~~end-file~~~


FIX: minor typo in file header (thanks to cR3X for noticing).

Red/System [
	Title:   "Red/System MacOS X runtime"
	Author:  "Nenad Rakocevic"
	File: 	 %darwin.reds
	Rights:  "Copyright (C) 2011 Nenad Rakocevic. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/red-system/runtime/BSL-License.txt
	}
]

#define OS_TYPE		4

#syscall [
	write: 4 [
		fd		[integer!]
		buffer	[c-string!]
		count	[integer!]
		return: [integer!]
	]
]

#if use-natives? = yes [
	#syscall [
		quit: 1 [							;-- "exit" syscall
			status	[integer!]
		]
	]
]

;-------------------------------------------
;-- Retrieve command-line information from stack
;-------------------------------------------
system/args-count: 	pop
system/args-list: 	as str-array! system/stack/top
system/env-vars: 	system/args-list + system/args-count + 1

#include %BSD.reds

Red/System [
	Title:   "Red/System MacOS X runtime"
	Author:  "Nenad Rakocevic"
	File: 	 %macosx.reds
	Rights:  "Copyright (C) 2011 Nenad Rakocevic. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/red-system/runtime/BSL-License.txt
	}
]

#define OS_TYPE		4

#syscall [
	write: 4 [
		fd		[integer!]
		buffer	[c-string!]
		count	[integer!]
		return: [integer!]
	]
]

#if use-natives? = yes [
	#syscall [
		quit: 1 [							;-- "exit" syscall
			status	[integer!]
		]
	]
]

;-------------------------------------------
;-- Retrieve command-line information from stack
;-------------------------------------------
system/args-count: 	pop
system/args-list: 	as str-array! system/stack/top
system/env-vars: 	system/args-list + system/args-count + 1

#include %BSD.reds


Fixed improperly entabbed file.

Fixed improperly entabbed file.

Red [
	Title:   "Red base environment definitions"
	Author:  "Nenad Rakocevic"
	File: 	 %boot.red
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2013 Nenad Rakocevic. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/BSL-License.txt
	}
]

;-- datatype! is not defined here for obvious circular reference issue

unset!:			make datatype! #get-definition TYPE_UNSET
none!:			make datatype! #get-definition TYPE_NONE
logic!:			make datatype! #get-definition TYPE_LOGIC
block!:			make datatype! #get-definition TYPE_BLOCK
string!:		make datatype! #get-definition TYPE_STRING
integer!:		make datatype! #get-definition TYPE_INTEGER
;symbol!:		make datatype! #get-definition TYPE_SYMBOL
;context!:		make datatype! #get-definition TYPE_CONTEXT
word!:			make datatype! #get-definition TYPE_WORD
error!:			make datatype! #get-definition TYPE_ERROR
typeset!:		make datatype! #get-definition TYPE_TYPESET
file!:			make datatype! #get-definition TYPE_FILE

set-word!:		make datatype! #get-definition TYPE_SET_WORD
get-word!:		make datatype! #get-definition TYPE_GET_WORD
lit-word!:		make datatype! #get-definition TYPE_LIT_WORD
refinement!:	make datatype! #get-definition TYPE_REFINEMENT
binary!:		make datatype! #get-definition TYPE_BINARY
paren!:			make datatype! #get-definition TYPE_PAREN
char!:			make datatype! #get-definition TYPE_CHAR
issue!:			make datatype! #get-definition TYPE_ISSUE
path!:			make datatype! #get-definition TYPE_PATH
set-path!:		make datatype! #get-definition TYPE_SET_PATH
get-path!:		make datatype! #get-definition TYPE_GET_PATH
lit-path!:		make datatype! #get-definition TYPE_LIT_PATH
native!:		make datatype! #get-definition TYPE_NATIVE
action!:		make datatype! #get-definition TYPE_ACTION
op!:			make datatype! #get-definition TYPE_OP
function!:		make datatype! #get-definition TYPE_FUNCTION
closure!:		make datatype! #get-definition TYPE_CLOSURE
routine!:		make datatype! #get-definition TYPE_ROUTINE
object!:		make datatype! #get-definition TYPE_OBJECT
port!:			make datatype! #get-definition TYPE_PORT
bitset!:		make datatype! #get-definition TYPE_BITSET
float!:			make datatype! #get-definition TYPE_FLOAT

none:  			make none! 0
true:  			make logic! 1
false: 			make logic! 0

;------------------------------------------
;-				Actions					  -
;------------------------------------------

make: make action! [
	[									;--	this one works!	;-)
		"Returns a new value made from a specification for that value's type."
		type	 [any-type!] "The datatype or a prototype value."
		spec	 [any-type!] "The specification	of the new value."
		return:  [any-type!] "Returns the specified datatype."
	]
	#get-definition ACT_MAKE
]

;random

reflect: make action! [[
		value	[any-type!]
		field 	[word!]
	]
	#get-definition ACT_REFLECT
]

;to

form: make action! [[
		value	  [any-type!]
		/part
			limit [integer!]
		return:	  [string!]
	]
	#get-definition ACT_FORM
]

mold: make action! [[
		value	  [any-type!]
		/only
		/all
		/flat
		/part
			limit [integer!]
		return:	  [string!]
	]
	#get-definition ACT_MOLD
]

;-- Scalar actions --

absolute: make action! [
	[
		"Returns the non-negative value."
		value	 [number!]
		return:  [number!]
	]
	#get-definition ACT_ABSOLUTE
]

add: make action! [
	[
		"Returns the sum of the two values."
		value1	 [number!]
		value2	 [number!]
		return:  [number!]
	]
	#get-definition ACT_ADD
]

divide: make action! [
	[
		"Returns the quotient of two values."
		value1	 [number!] "The dividend (numerator)."
		value2	 [number!] "The divisor (denominator)."
		return:  [number!]
	]
	#get-definition ACT_DIVIDE
]

multiply: make action! [
	[
		"Returns one value multiplied by another."
		value1	 [number!]
		value2	 [number!]
		return:  [number!]
	]
	#get-definition ACT_MULTIPLY
]

negate: make action! [
	[
		"Returns the inverse value."
		number 	 [number!]
		return:  [number!]
	]
	#get-definition ACT_NEGATE
]

power: make action! [
	[
		"Returns a number raised to a given power (exponent)."
		number	 [number!] "Base value."
		exponent [number!] "The power (index) to raise the base value by."
		return:	 [number!]
	]
	#get-definition ACT_POWER
]

remainder: make action! [
	[
		"Returns what is left over when one value is divided by another."
		value1 	 [number!]
		value2 	 [number!]
		return:  [number!]
	]
	#get-definition ACT_REMAINDER
]

round: make action! [[
		n		[number!]
		/to
		scale	[number!]
		/even
		/down
		/half-down
		/floor
		/ceiling
		/half-ceiling
	]
	#get-definition ACT_ROUND
]

subtract: make action! [
	[
		"Returns the difference between two values."
		value1	 [number!]
		value2	 [number!]
		return:  [number!]
	]
	#get-definition ACT_SUBTRACT
]

even?: make action! [
	[
		"Returns true if the number is evenly divisible by 2."
		number 	 [number!]
		return:  [number!]
	]
	#get-definition ACT_EVEN?
]

odd?: make action! [
	[
		"Returns true if the number has a remainder of 1 when divided by 2."
		number 	 [number!]
		return:  [number!]
	]
	#get-definition ACT_ODD?
]

;-- Bitwise actions --

;and~
;complement
;or~
;xor~

;-- Series actions --

append: make action! [[
		series	   [series!]
		value	   [any-type!]
		/part
			length [number! series!]
		/only
		/dup
			count  [number!]
		return:    [series!]
	]
	#get-definition ACT_APPEND
]

at: make action! [[
		series	 [series!]
		index 	 [integer!]
		return:  [series!]
	]
	#get-definition ACT_AT
]

back: make action! [[
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_BACK
]

;change

clear: make action! [[
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_CLEAR
]

copy: make action! [[
		value	 [series!]
		/part
			length [number! series!]
		/deep
		/types
			kind [datatype!]
		return:  [series!]
	]
	#get-definition ACT_COPY
]

find: make action! [[
		series	 [series! none!]
		value 	 [any-type!]
		/part
			length [number! series!]
		/only
		/case
		/any
		/with
			wild [string!]
		/skip
			size [integer!]
		/last
		/reverse
		/tail
		/match
	]
	#get-definition ACT_FIND
]

head: make action! [[
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_HEAD
]

head?: make action! [[
		series	 [series!]
		return:  [logic!]
	]
	#get-definition ACT_HEAD?
]

index?: make action! [[
		series	 [series!]
		return:  [integer!]
	]
	#get-definition ACT_INDEX?
]

;insert

length?: make action! [[
		series	 [series!]
		return:  [integer!]
	]
	#get-definition ACT_LENGTH?
]

next: make action! [[
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_NEXT
]

pick: make action! [[
		series	 [series!]
		index 	 [integer! logic!]
		return:  [any-type!]
	]
	#get-definition ACT_PICK
]

poke: make action! [[
		series	 [series!]
		index 	 [integer! logic!]
		value 	 [any-type!]
		return:  [series!]
	]
	#get-definition ACT_POKE
]

remove: make action! [[
		series	 [series! none!]
		/part
			length [number! series!]
		return:  [series! none!]
	]
	#get-definition ACT_REMOVE
]

;reverse

select: make action! [[
		series	 [series! none!]
		value 	 [any-type!]
		/part
			length [number! series!]
		/only
		/case
		/any
		/with
			wild [string!]
		/skip
			size [integer!]
		/last
		/reverse
		return:  [any-type!]
	]
	#get-definition ACT_SELECT
]

;sort

skip: make action! [[
		series	 [series!]
		offset 	 [integer!]
		return:  [series!]
	]
	#get-definition ACT_SKIP
]

;swap

tail: make action! [[
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_TAIL
]

tail?: make action! [[
		series	 [series!]
		return:  [logic!]
	]
	#get-definition ACT_TAIL?
]

;take
;trim

;-- I/O actions --

;create
;close
;delete
;modify
;open
;open?
;query
;read
;rename
;update
;write

;------------------------------------------
;-				Natives					  -
;------------------------------------------

if: make native! [
	[
		"If condition is TRUE, evaluate block; else return NONE."
		cond  	 [any-type!] "Test condition."
		then-blk [block!] "Block to evaluate."
	]
	#get-definition NAT_IF
]

unless: make native! [
	[
		"If condition is not TRUE, evaluate block; else return NONE."
		cond  	 [any-type!] "Test condition."
		then-blk [block!] "Block to evaluate."
	]
	#get-definition NAT_UNLESS
]

either: make native! [
	[
		"If condition is TRUE, eval true-block; else eval false-blk."
		cond  	  [any-type!] "Test condition."
		true-blk  [block!] "Block to evaluate if condition is TRUE."
		false-blk [block!] "Block to evaluate if condition is not TRUE."
	]
	#get-definition NAT_EITHER
]

any: make native! [
	[
		"Evaluates conditions, returning at the first that is TRUE."
		conds [block!] "Test conditions."
	]
	#get-definition NAT_ANY
]

all: make native! [
	[
		"Evaluates conditions, returning at the first that is not TRUE."
		conds [block!] "Test conditions."
	]
	#get-definition NAT_ALL
]

while: make native! [
	[
		"Evaluates body until condition is TRUE."
		cond [block!] "Test condition."
		body [block!] "Block to evaluate."
	]
	#get-definition NAT_WHILE
]

until: make native! [
	[
		"Evaluates body until it is TRUE."
		body [block!] "Block to evaluate."
	]
	#get-definition NAT_UNTIL
]

loop: make native! [
	[
		"Evaluates body a number of times."
		count [integer!] "Number of times to evaluate body."
		body  [block!]   "Block to evaluate."
	]
	#get-definition NAT_LOOP
]

repeat: make native! [
	[
		"Evaluates body a number of times, tracking iteration count."
		'word [word!]    "Iteration counter. Not local to loop."
		value [integer!] "Number of times to evaluate body."
		body  [block!]   "Block to evaluate."
	]
	#get-definition NAT_REPEAT
]

foreach: make native! [
	[
		"Evaluates body for each value in a series."
		'word  [word!]   "Word, or words, to set on each iteration."
		series [series!] "Series to iterate over."
		body   [block!]  "Block to evaluate."
	]
	#get-definition NAT_FOREACH
]

forall: make native! [
	[
		"Evaluates body for all values in a series."
		'word [word!]   "Word referring to series to iterate over."
		body  [block!]  "Block to evaluate."
	]
	#get-definition NAT_FORALL
]

;break: make native! [
;	[]													;@@ add /return option
;	none
;]

func: make native! [[
		spec [block!]
		body [block!]
	]
	#get-definition NAT_FUNC
]

function: make native! [[
		spec [block!]
		body [block!]
	]
	#get-definition NAT_FUNCTION
]

does: make native! [[
		body [block!]
	]
	#get-definition NAT_DOES
]

has: make native! [[
		vars [block!]
		body [block!]
	]
	#get-definition NAT_HAS
]

exit: make native! [
	[]
	#get-definition NAT_EXIT
]

return: make native! [[
		value [any-type!]
	]
	#get-definition NAT_RETURN
]

switch: make native! [[
		value [any-type!]
		cases [block!]
		/default
			case [block!]
	]
	#get-definition NAT_SWITCH
]

case: make native! [[
		cases [block!]
		/all
	]
	#get-definition NAT_CASE
]

do: make native! [[
		value [any-type!]
	]
	#get-definition NAT_DO
]

reduce: make native! [[
		value [any-type!]
		/into
			out [any-block!]
	]
	#get-definition NAT_REDUCE
]

compose: make native! [[
		value [block!]
		/deep
		/only
		/into
			out [any-block!]
	]
	#get-definition NAT_COMPOSE
]

get: make native! [[
		word	[word!]
		/any
		return: [any-type!]
	]
	#get-definition NAT_GET
]

set: make native! [[
		word	[any-word!]
		value	[any-type!]
		/any
		return: [any-type!]
	]
	#get-definition NAT_SET
]

print: make native! [[
		value	[any-type!]
	]
	#get-definition NAT_PRINT
]

prin: make native! [[
		value	[any-type!]
	]
	#get-definition NAT_PRIN
]

equal?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_EQUAL?
]

not-equal?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_NOT_EQUAL?
]

strict-equal?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_STRICT_EQUAL?
]

lesser?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_LESSER?
]

greater?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_GREATER?
]

lesser-or-equal?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_LESSER_OR_EQUAL?
]

greater-or-equal?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_GREATER_OR_EQUAL?
]

same?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_SAME?
]

not: make native! [[
		value [any-type!]
	]
	#get-definition NAT_NOT
]

halt: make native! [
	[]
	#get-definition NAT_HALT
]

type?: make native! [[
		value [any-type!]
		/word
	]
	#get-definition NAT_TYPE?
]

load: make native! [[
		source [file! url! string! binary! block!]
		/header
		/all
		/type [word! none!]
	]
	#get-definition NAT_LOAD
]

stats: make native! [[
		/show
		/info
		return: [integer! block!]
	]
	#get-definition NAT_STATS
]

;------------------------------------------
;-			   Operators				  -
;------------------------------------------

;-- #load temporary directive is used to workaround REBOL LOAD limitations on some words

#load set-word! "+"  make op! :add
#load set-word! "-"  make op! :subtract
#load set-word! "*"  make op! :multiply
#load set-word! "/"  make op! :divide
#load set-word! "="  make op! :equal?
#load set-word! "<>" make op! :not-equal?
#load set-word! "==" make op! :strict-equal?
#load set-word! "=?" make op! :same?
#load set-word! "<"  make op! :lesser?
#load set-word! ">"  make op! :greater?
#load set-word! "<=" make op! :lesser-or-equal?
#load set-word! ">=" make op! :greater-or-equal?

;------------------------------------------
;-				Scalars					  -
;------------------------------------------
Red: true												;-- ultimate Truth ;-) (pre-defines Red word)

yes: on: true
no: off: false
;empty?: :tail?

tab:		 #"^-"
cr: 		 #"^M"
newline: lf: #"^/"
escape:      #"^["
slash: 		 #"/"
sp: space: 	 #" "
null: 		 #"^@"
crlf:		 "^M^/"

;------------------------------------------
;-			   Mezzanines				  -
;------------------------------------------

quit-return: routine [
	status			[integer!]
][
	quit status
]
quit: func [
	/return status	[integer!]
][
	quit-return any [status 0]
]

empty?: func [
	series	[series!]
	return:	[logic!]
][
	tail? series
]

??: func ['value [word!]][
	prin mold :value
	prin ": "
	probe get/any :value
]

probe: func [value][
	print mold value
	value
]

first:	func [s [series!]][pick s 1]					;@@ temporary definitions, should be natives ?
second:	func [s [series!]][pick s 2]
third:	func [s [series!]][pick s 3]
fourth:	func [s [series!]][pick s 4]
fifth:	func [s [series!]][pick s 5]

last:	func [s [series!]][pick back tail s 1]

action?:	 func [value [any-type!]][action!	= type? value]
block?:		 func [value [any-type!]][block!	= type? value]
char?: 		 func [value [any-type!]][char!		= type? value]
datatype?:	 func [value [any-type!]][datatype!	= type? value]
file?:		 func [value [any-type!]][file!		= type? value]
function?:	 func [value [any-type!]][function!	= type? value]
get-path?:	 func [value [any-type!]][get-path!	= type? value]
get-word?:	 func [value [any-type!]][get-word!	= type? value]
integer?:    func [value [any-type!]][integer!	= type? value]
issue?:    	 func [value [any-type!]][issue!	= type? value]
lit-path?:	 func [value [any-type!]][lit-path!	= type? value]
lit-word?:	 func [value [any-type!]][lit-word!	= type? value]
logic?:		 func [value [any-type!]][logic!	= type? value]
native?:	 func [value [any-type!]][native!	= type? value]
none?:		 func [value [any-type!]][none!		= type? value]
op?:		 func [value [any-type!]][op!		= type? value]
paren?:		 func [value [any-type!]][paren!	= type? value]
path?:		 func [value [any-type!]][path!		= type? value]
refinement?: func [value [any-type!]][refinement! = type? value]
set-path?:	 func [value [any-type!]][set-path!	= type? value]
set-word?:	 func [value [any-type!]][set-word!	= type? value]
string?:	 func [value [any-type!]][string!	= type? value]
unset?:		 func [value [any-type!]][unset!	= type? value]
word?:		 func [value [any-type!]][word!		= type? value]

spec-of: func [value][reflect :value 'spec]
body-of: func [value][reflect :value 'body]

system: function [
	/version
	/words
	/platform
][
	case [
		version [#version]
		words	[#system [_context/get-words]]
		platform [
			#system [
				#switch OS [
					Windows  [SET_RETURN(words/_windows)]
					Syllable [SET_RETURN(words/_syllable)]
					MacOSX	 [SET_RETURN(words/_macosx)]
					#default [SET_RETURN(words/_linux)]
				]
			]
		]
	]
]


FEAT: simplified the MOLDed vector form for obvious representations.

Red/System [
	Title:   "Vector! datatype runtime functions"
	Author:  "Nenad Rakocevic"
	File: 	 %vector.reds
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2012 Nenad Rakocevic. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/BSL-License.txt
	}
]

vector: context [
	verbose: 0

	rs-length?: func [
		vec 	[red-vector!]
		return: [integer!]
	][
		string/get-length as red-string! vec no
	]

	rs-skip: func [
		vec 	[red-vector!]
		len		[integer!]
		return: [logic!]
	][
		string/rs-skip as red-string! vec len
	]

	rs-next: func [
		vec 	[red-vector!]
		return: [logic!]
		/local
			s [series!]
	][
		rs-skip vec 1
	]

	rs-head: func [
		vec	    [red-vector!]
		return: [byte-ptr!]
		/local
			s [series!]
	][
		s: GET_BUFFER(vec)
		(as byte-ptr! s/offset) + (vec/head << (GET_UNIT(s) >> 1))
	]

	rs-tail: func [
		vec	    [red-vector!]
		return: [byte-ptr!]
		/local
			s [series!]
	][
		s: GET_BUFFER(vec)
		as byte-ptr! s/tail
	]

	rs-tail?: func [
		vec	    [red-vector!]
		return: [logic!]
		/local
			s [series!]
	][
		s: GET_BUFFER(vec)
		(as byte-ptr! s/offset) + (vec/head << (GET_UNIT(s) >> 1)) >= as byte-ptr! s/tail
	]

	rs-clear: func [
		vec [red-vector!]
		/local
			s [series!]
	][
		s: GET_BUFFER(vec)
		s/tail: as cell! (as byte-ptr! s/offset) + (vec/head << (GET_UNIT(s) >> 1))
	]

	rs-append-int: func [
		vec		[red-vector!]
		n		[integer!]
		/local
			s	 [series!]
			p	 [byte-ptr!]
			p4	 [int-ptr!]
	][
		s: GET_BUFFER(vec)
		p: alloc-tail-unit s 4
		p4: as int-ptr! p
		p4/value: n
	]

	rs-append: func [
		vec		[red-vector!]
		value	[red-value!]
		return: [red-value!]
		/local
			s	 [series!]
			p	 [byte-ptr!]
			unit [integer!]
	][
		assert TYPE_OF(value) = vec/type
		s: GET_BUFFER(vec)
		unit: GET_UNIT(s)
		p: alloc-tail-unit s either unit = 6 [8][unit]
		set-value p value unit
		value
	]

	rs-insert: func [
		vec		[red-vector!]
		offset	[integer!]								;-- offset from head in elements
		value	[red-value!]
		return: [series!]
		/local
			s	  [series!]
			p	  [byte-ptr!]
			unit  [integer!]
			unit2 [integer!]
	][
		s: GET_BUFFER(vec)
		unit: GET_UNIT(s)
		unit2: either unit = 6 [8][unit]

		if ((as byte-ptr! s/tail) + unit2) > ((as byte-ptr! s + 1) + s/size) [
			s: expand-series s 0
		]
		p: (as byte-ptr! s/offset) + (offset << (unit >> 1))

		move-memory										;-- make space
			p + unit2
			p
			as-integer (as byte-ptr! s/tail) - p

		s/tail: as cell! (as byte-ptr! s/tail) + unit2

		set-value p value unit
		s
	]

	get-value-int: func [
		p		[int-ptr!]
		unit	[integer!]
		return: [integer!]
	][
		switch unit [
			1 [p/value and FFh]
			2 [p/value and FFFFh]
			4 [p/value]
		]
	]

	get-value: func [
		p		[byte-ptr!]
		unit	[integer!]
		type	[integer!]
		return: [red-value!]
		/local
			int    [red-integer!]
			float  [red-float!]
			pf	   [pointer! [float!]]
			pf32   [pointer! [float32!]]
	][
		switch type [
			TYPE_CHAR
			TYPE_INTEGER [
				int: as red-integer! stack/push*
				int/header: type
				int/value: get-value-int as int-ptr! p unit
				as red-value! int
			]
			TYPE_FLOAT [
				float: as red-float! stack/push*
				float/header: TYPE_FLOAT
				float/value: either unit = 6 [
								pf: as pointer! [float!] p
								pf/value
							][
								pf32: as pointer! [float32!] p
								as-float pf32/value
							]
				as red-value! float
			]
		]
	]

	set-value: func [
		p		[byte-ptr!]
		value	[red-value!]
		unit	[integer!]
		/local
			int  [red-integer!]
			f	 [red-float!]
			p4	 [int-ptr!]
			pf	 [pointer! [float!]]
			pf32 [pointer! [float32!]]
	][
		switch TYPE_OF(value) [
			TYPE_CHAR
			TYPE_INTEGER [ 			;-- char! and integer! structs are overlapping
				int: as red-integer! value
				p4: as int-ptr! p
				p4/value: switch unit [
					1 [int/value and FFh or (p4/value and FFFFFF00h)]
					2 [int/value and FFFFh or (p4/value and FFFF0000h)]
					4 [int/value]
				]
			]
			TYPE_FLOAT [
				f: as red-float! value
				either unit = 6 [
					pf: as pointer! [float!] p
					pf/value: f/value
				][
					pf32: as pointer! [float32!] p
					pf32/value: as float32! f/value
				]
			]
			default [
				fire [TO_ERROR(script invalid-type) datatype/push TYPE_OF(value)]
			]
		]
	]

	append-values: func [
		vec	[red-vector!]
		blk [red-block!]
		/local
			value [red-value!]
			tail  [red-value!]
	][
		value: block/rs-head blk
		tail:  block/rs-tail blk

		while [value < tail][
			rs-append vec value
			value: value + 1
		]
	]

	clone: func [
		vec		[red-vector!]							;-- clone the vector in-place
		return: [red-vector!]
		/local
			new    [node!]
			s	   [series!]
			target [series!]
			size   [integer!]
	][
		s: GET_BUFFER(vec)
		size: s/size									;-- @@ head position ignored
		new: alloc-bytes size

		unless zero? size [
			target: as series! new/value
			copy-memory
				as byte-ptr! target/offset
				as byte-ptr! s/offset
				size
			target/tail: as cell! ((as byte-ptr! target/offset) + size)
		]
		vec/node: new
		vec
	]

	push: func [
		vec [red-vector!]
	][
		#if debug? = yes [if verbose > 0 [print-line "vector/push"]]

		copy-cell as red-value! vec stack/push*
	]

	make-at: func [
		slot	[red-value!]
		size	[integer!]
		type	[integer!]
		unit	[integer!]
		return: [red-vector!]
		/local
			vec [red-vector!]
			s	[series!]
	][
		vec: as red-vector! slot
		vec/header: TYPE_VECTOR							;-- implicit reset of all header flags
		vec/head: 	0
		vec/node: 	alloc-bytes size * unit
		vec/type:	type

		s: GET_BUFFER(vec)
		if unit = 8 [unit: 6]
		s/flags: s/flags and flag-unit-mask or unit
		vec
	]

	;--- Actions ---

	make: func [
		proto	[red-value!]
		spec	[red-value!]
		return:	[red-vector!]
		/local
			s	  [series!]
			w	  [red-word!]
			vec	  [red-vector!]
			int	  [red-integer!]
			value [red-value!]
			sym   [integer!]
			size  [integer!]
			blk-sz [integer!]
			unit  [integer!]
			type  [integer!]
			fill? [logic!]
			end   [byte-ptr!]
	][
		#if debug? = yes [if verbose > 0 [print-line "vector/make"]]

		fill?: yes
		size: 0
		unit: 0
		type: TYPE_OF(spec)

		switch type [
			TYPE_INTEGER [
				int: as red-integer! spec
				size: int/value
			]
			TYPE_BLOCK [
				size:  block/rs-length? as red-block! spec
				either zero? size [
					type: TYPE_INTEGER
				][
					value: block/rs-head as red-block! spec
					type:  TYPE_OF(value)
					if type = TYPE_WORD [
						if size < 2 [
							fire [TO_ERROR(script invalid-spec-field) spec]
						]

						;-- data type
						w: as red-word! value
						sym: symbol/resolve w/symbol
						type: case [
							sym = words/integer!	[TYPE_INTEGER]
							sym = words/char!		[TYPE_CHAR]
							sym = words/float!		[TYPE_FLOAT]
							true					[TYPE_INTEGER]
						]

						;-- bit size
						block/rs-next as red-block! spec
						value: block/rs-head as red-block! spec
						int: as red-integer! value
						unit: int/value >> 3

						;-- size or block values
						block/rs-next as red-block! spec
						value: block/rs-head as red-block! spec
						either TYPE_OF(value) = TYPE_INTEGER [
							int: as red-integer! value
							size: int/value
							either block/rs-next as red-block! spec [
								spec: value
							][
								spec: block/rs-head as red-block! spec
							]
						][
							either TYPE_OF(value) = TYPE_BLOCK [
								spec: value
								size: block/rs-length? as red-block! spec
							][
								fire [TO_ERROR(script invalid-spec-field) spec]
							]
						]
					]
					if zero? unit [
						unit:  switch type [
							TYPE_CHAR
							TYPE_INTEGER [size? integer!]
							TYPE_FLOAT	 [size? float!]
							default [
								fire [TO_ERROR(script invalid-type) datatype/push type]
								0
							]
						]
					]
				]
			]
			default [--NOT_IMPLEMENTED--]
		]

		if TYPE_OF(spec) = TYPE_BLOCK [
			blk-sz: block/rs-length? as red-block! spec
			if blk-sz >= size [size: blk-sz fill?: no]
		]
		if size <= 0 [fill?: no size: 1]
		if zero? unit [unit: 4]
		vec: make-at stack/push* size type unit

		if TYPE_OF(spec) = TYPE_BLOCK [
			append-values vec as red-block! spec
		]
		if fill? [
			s: GET_BUFFER(vec)
			end: (as byte-ptr! s/offset) + (size * unit)
			fill as byte-ptr! s/tail end null
			s/tail: as cell! end
		]
		vec
	]

	serialize: func [
		vec		[red-vector!]
		buffer	[red-string!]
		only?	[logic!]
		all?	[logic!]
		flat?	[logic!]
		arg		[red-value!]
		part	[integer!]
		mold?	[logic!]
		return: [integer!]
		/local
			s		[series!]
			p		[byte-ptr!]
			end		[byte-ptr!]
			unit	[integer!]
			pf		[pointer! [float!]]
			pf32	[pointer! [float32!]]
			formed	[c-string!]
	][
		#if debug? = yes [if verbose > 0 [print-line "vector/serialize"]]

		s: GET_BUFFER(vec)
		unit: GET_UNIT(s)
		p: (as byte-ptr! s/offset) + (vec/head << (unit >> 1))
		end: as byte-ptr! s/tail
		if unit = 6 [unit: 8]

		while [p < end][
			if all [OPTION?(arg) part <= 0][return part]

			either vec/type = TYPE_CHAR [
				part: either mold? [
					string/concatenate-literal buffer {#"}
					string/append-escaped-char
							buffer
							get-value-int as int-ptr! p unit
							string/ESC_CHAR
							all?
					string/append-char GET_BUFFER(buffer) as-integer #"^""
					part - 4
				][
					string/append-escaped-char
							buffer
							get-value-int as int-ptr! p unit
							string/ESC_CHAR
							all?
					part - 1
				]
			][
				either vec/type = TYPE_FLOAT [
					formed: either unit = 8 [
						pf: as pointer! [float!] p
						float/form-float pf/value no
					][
						pf32: as pointer! [float32!] p
						float/form-float as-float pf32/value yes
					]
				][
					formed: integer/form-signed get-value-int as int-ptr! p unit
				]
				string/concatenate-literal buffer formed
				part: part - system/words/length? formed	;@@ optimize by removing length?
			]
			if p + unit < end [
				string/append-char GET_BUFFER(buffer) as-integer space
				part: part - 1
			]
			p: p + unit
		]
		part
	]

	form: func [
		vec		[red-vector!]
		buffer	[red-string!]
		arg		[red-value!]
		part 	[integer!]
		return: [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "vector/form"]]

		serialize vec buffer no no no arg part no
	]

	mold: func [
		vec		[red-vector!]
		buffer	[red-string!]
		only?	[logic!]
		all?	[logic!]
		flat?	[logic!]
		arg		[red-value!]
		part	[integer!]
		indent	[integer!]
		return:	[integer!]
		/local
			formed [c-string!]
			s	   [series!]
			unit   [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "vector/mold"]]

		string/concatenate-literal buffer "make vector! ["
		part: part - 14

		s: GET_BUFFER(vec)
		unit: GET_UNIT(s)
		if unit = 6 [unit: 8]

		either any [
			all [unit = 4 any [vec/type = TYPE_CHAR vec/type = TYPE_INTEGER]]
			all [unit = 8 vec/type = TYPE_FLOAT]
		][
			part: serialize vec buffer only? all? flat? arg part yes
			string/append-char GET_BUFFER(buffer) as-integer #"]"
			part - 1
		][
			string/concatenate-literal buffer switch vec/type [
				TYPE_CHAR		[part: part - 5 "char!"]
				TYPE_INTEGER	[part: part - 8 "integer!"]
				TYPE_FLOAT		[part: part - 6 "float!"]
			]
			string/append-char GET_BUFFER(buffer) as-integer space

			formed: integer/form-signed unit << 3
			string/concatenate-literal buffer formed
			string/append-char GET_BUFFER(buffer) as-integer space
			part: part - system/words/length? formed

			string/append-char GET_BUFFER(buffer) as-integer #"["
			part: part - 4									;-- 3 spaces + "["

			part: serialize vec buffer only? all? flat? arg part yes

			string/concatenate-literal buffer "]]"
			part - 2
		]
	]

	;--- Modifying actions ---

	insert: func [
		vec		 [red-vector!]
		value	 [red-value!]
		part-arg [red-value!]
		only?	 [logic!]
		dup-arg	 [red-value!]
		append?	 [logic!]
		return:	 [red-value!]
		/local
			src		  [red-block!]
			cell	  [red-value!]
			limit	  [red-value!]
			int		  [red-integer!]
			char	  [red-char!]
			sp		  [red-vector!]
			s		  [series!]
			s2		  [series!]
			dup-n	  [integer!]
			cnt		  [integer!]
			part	  [integer!]
			len		  [integer!]
			added	  [integer!]
			vec-type  [integer!]
			tail?	  [logic!]
	][
		#if debug? = yes [if verbose > 0 [print-line "vector/insert"]]

		dup-n: 1
		cnt:   1
		part: -1
		vec-type: vec/type

		if OPTION?(part-arg) [
			part: either TYPE_OF(part-arg) = TYPE_INTEGER [
				int: as red-integer! part-arg
				int/value
			][
				sp: as red-vector! part-arg
				unless all [
					TYPE_OF(sp) = TYPE_VECTOR
					sp/node = vec/node
				][
					fire [TO_ERROR(script invalid-part) part-arg]
				]
				sp/head + 1								;-- /head is 0-based
			]
		]
		if OPTION?(dup-arg) [
			int: as red-integer! dup-arg
			cnt: int/value
			if negative? cnt [return as red-value! vec]
			dup-n: cnt
		]

		s: GET_BUFFER(vec)
		tail?: any [
			(as-integer s/tail - s/offset) >> (GET_UNIT(s) >> 1) = vec/head
			append?
		]

		while [not zero? cnt][							;-- /dup support
			either TYPE_OF(value) = TYPE_BLOCK [		;@@ replace it with: typeset/any-block?
				src: as red-block! value
				s2: GET_BUFFER(src)
				cell:  s2/offset + src/head
				limit: cell + block/rs-length? src
			][
				cell:  value
				limit: value + 1
			]
			added: 0

			while [all [cell < limit added <> part]][	;-- multiple values case
				if TYPE_OF(cell) <> vec-type [
					fire [TO_ERROR(script invalid-type) datatype/push TYPE_OF(cell)]
				]
				either tail? [
					rs-append vec cell
				][
					rs-insert vec vec/head + added cell
				]
				added: added + 1
				cell: cell + 1
			]
			cnt: cnt - 1
		]
		unless append? [
			added: added * dup-n
			vec/head: vec/head + added
			s: GET_BUFFER(vec)
			assert (as byte-ptr! s/offset) + (vec/head << (GET_UNIT(s) >> 1)) <= as byte-ptr! s/tail
		]
		as red-value! vec
	]

	do-math: func [
		type		[math-op!]
		return:		[red-value!]
		/local
			left	[red-vector!]
			right	[red-vector!]
			s1		[series!]
			s2		[series!]
			unit	[integer!]
			unit1	[integer!]
			unit2	[integer!]
			len		[integer!]
			len1	[integer!]
			len2	[integer!]
			v1		[integer!]
			v2		[integer!]
			i		[integer!]
			node	[node!]
			buffer	[series!]
			p		[byte-ptr!]
			p1		[byte-ptr!]
			p2		[byte-ptr!]
			p4		[int-ptr!]
	][
		left: as red-vector! stack/arguments
		right: left + 1

		assert TYPE_OF(right) = TYPE_VECTOR

		s1: GET_BUFFER(left)
		s2: GET_BUFFER(right)
		unit1: GET_UNIT(s1)
		unit2: GET_UNIT(s2)
		len1: rs-length? left
		len2: rs-length? right

		p1: (as byte-ptr! s1/offset) + (left/head << (unit1 >> 1))
		p2: (as byte-ptr! s2/offset) + (right/head << (unit2 >> 1))
		either len1 > len2 [len: len1][
			len: len2
			len2: len1							;-- set len2 to minimum length
			p: p1 p1: p2 p2: p
			unit: unit1 unit1: unit2 unit2: unit
		]
		unit: either unit1 > unit2 [unit1][unit2]
		node: alloc-bytes len << (unit >> 1)
		buffer: as series! node/value
		buffer/flags: buffer/flags and flag-unit-mask or unit
		buffer/tail: as cell! (as byte-ptr! buffer/offset) + (len << (unit >> 1))

		i: 0
		p:  as byte-ptr! buffer/offset
		while [i < len][
			v1: get-value-int as int-ptr! p1 unit1
			if i < len2 [
				v2: get-value-int as int-ptr! p2 unit2
				v1: switch type [
					OP_ADD [v1 + v2]
					OP_SUB [v1 - v2]
					OP_MUL [v1 * v2]
					OP_REM [v1 % v2]
					OP_AND [v1 and v2]
					OP_OR  [v1 or v2]
					OP_XOR [v1 xor v2]
					OP_DIV [
						either zero? v2 [
							fire [TO_ERROR(math zero-divide)]
							0								;-- pass the compiler's type-checking
						][
							v1 / v2
						]
					]
				]
				p2: p2 + unit2
			]
			p4: as int-ptr! p
			p4/value: switch unit [
				1 [v1 and FFh or (p4/value and FFFFFF00h)]
				2 [v1 and FFFFh or (p4/value and FFFF0000h)]
				4 [v1]
			]
			i:  i  + 1
			p:  p  + unit
			p1: p1 + unit1
		]
		left/node: node
		left/head: 0
		as red-value! left
	]

	add: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "vector/add"]]
		do-math OP_ADD
	]

	divide: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "vector/divide"]]
		do-math OP_DIV
	]

	multiply: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "vector/multiply"]]
		do-math OP_MUL
	]

	remainder: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "vector/remainder"]]
		do-math OP_REM
	]

	subtract: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "vector/subtract"]]
		do-math OP_SUB
	]

	and~: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "vector/and~"]]
		do-math OP_AND
	]

	or~: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "vector/or~"]]
		do-math OP_OR
	]

	xor~: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "vector/xor~"]]
		do-math OP_XOR
	]

	init: does [
		datatype/register [
			TYPE_VECTOR
			TYPE_STRING
			"vector!"
			;-- General actions --
			:make
			null			;random
			null			;reflect
			null			;to
			:form
			:mold
			INHERIT_ACTION	;eval-path
			null			;set-path
			null			;compare
			;-- Scalar actions --
			null			;absolute
			:add
			:divide
			:multiply
			null			;negate
			null			;power
			:remainder
			null			;round
			:subtract
			null			;even?
			null			;odd?
			;-- Bitwise actions --
			:and~
			null			;complement
			:or~
			:xor~
			;-- Series actions --
			null			;append
			INHERIT_ACTION	;at
			INHERIT_ACTION	;back
			null			;change
			INHERIT_ACTION	;clear
			INHERIT_ACTION	;copy
			INHERIT_ACTION	;find
			INHERIT_ACTION	;head
			INHERIT_ACTION	;head?
			INHERIT_ACTION	;index?
			INHERIT_ACTION	;insert
			INHERIT_ACTION	;length?
			INHERIT_ACTION	;next
			INHERIT_ACTION	;pick
			INHERIT_ACTION	;poke
			INHERIT_ACTION	;remove
			INHERIT_ACTION	;reverse
			INHERIT_ACTION	;select
			INHERIT_ACTION	;sort
			INHERIT_ACTION	;skip
			null			;swap
			INHERIT_ACTION	;tail
			INHERIT_ACTION	;tail?
			INHERIT_ACTION	;take
			null			;trim
			;-- I/O actions --
			null			;create
			null			;close
			null			;delete
			null			;modify
			null			;open
			null			;open?
			null			;query
			null			;read
			null			;rename
			null			;update
			null			;write
		]
	]
]

Red/System [
	Title:   "Vector! datatype runtime functions"
	Author:  "Nenad Rakocevic"
	File: 	 %vector.reds
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2012 Nenad Rakocevic. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/BSL-License.txt
	}
]

vector: context [
	verbose: 0

	rs-length?: func [
		vec 	[red-vector!]
		return: [integer!]
	][
		string/get-length as red-string! vec no
	]

	rs-skip: func [
		vec 	[red-vector!]
		len		[integer!]
		return: [logic!]
	][
		string/rs-skip as red-string! vec len
	]

	rs-next: func [
		vec 	[red-vector!]
		return: [logic!]
		/local
			s [series!]
	][
		rs-skip vec 1
	]

	rs-head: func [
		vec	    [red-vector!]
		return: [byte-ptr!]
		/local
			s [series!]
	][
		s: GET_BUFFER(vec)
		(as byte-ptr! s/offset) + (vec/head << (GET_UNIT(s) >> 1))
	]

	rs-tail: func [
		vec	    [red-vector!]
		return: [byte-ptr!]
		/local
			s [series!]
	][
		s: GET_BUFFER(vec)
		as byte-ptr! s/tail
	]

	rs-tail?: func [
		vec	    [red-vector!]
		return: [logic!]
		/local
			s [series!]
	][
		s: GET_BUFFER(vec)
		(as byte-ptr! s/offset) + (vec/head << (GET_UNIT(s) >> 1)) >= as byte-ptr! s/tail
	]

	rs-clear: func [
		vec [red-vector!]
		/local
			s [series!]
	][
		s: GET_BUFFER(vec)
		s/tail: as cell! (as byte-ptr! s/offset) + (vec/head << (GET_UNIT(s) >> 1))
	]

	rs-append-int: func [
		vec		[red-vector!]
		n		[integer!]
		/local
			s	 [series!]
			p	 [byte-ptr!]
			p4	 [int-ptr!]
	][
		s: GET_BUFFER(vec)
		p: alloc-tail-unit s 4
		p4: as int-ptr! p
		p4/value: n
	]

	rs-append: func [
		vec		[red-vector!]
		value	[red-value!]
		return: [red-value!]
		/local
			s	 [series!]
			p	 [byte-ptr!]
			unit [integer!]
	][
		assert TYPE_OF(value) = vec/type
		s: GET_BUFFER(vec)
		unit: GET_UNIT(s)
		p: alloc-tail-unit s either unit = 6 [8][unit]
		set-value p value unit
		value
	]

	rs-insert: func [
		vec		[red-vector!]
		offset	[integer!]								;-- offset from head in elements
		value	[red-value!]
		return: [series!]
		/local
			s	  [series!]
			p	  [byte-ptr!]
			unit  [integer!]
			unit2 [integer!]
	][
		s: GET_BUFFER(vec)
		unit: GET_UNIT(s)
		unit2: either unit = 6 [8][unit]

		if ((as byte-ptr! s/tail) + unit2) > ((as byte-ptr! s + 1) + s/size) [
			s: expand-series s 0
		]
		p: (as byte-ptr! s/offset) + (offset << (unit >> 1))

		move-memory										;-- make space
			p + unit2
			p
			as-integer (as byte-ptr! s/tail) - p

		s/tail: as cell! (as byte-ptr! s/tail) + unit2

		set-value p value unit
		s
	]

	get-value-int: func [
		p		[int-ptr!]
		unit	[integer!]
		return: [integer!]
	][
		switch unit [
			1 [p/value and FFh]
			2 [p/value and FFFFh]
			4 [p/value]
		]
	]

	get-value: func [
		p		[byte-ptr!]
		unit	[integer!]
		type	[integer!]
		return: [red-value!]
		/local
			int    [red-integer!]
			float  [red-float!]
			pf	   [pointer! [float!]]
			pf32   [pointer! [float32!]]
	][
		switch type [
			TYPE_CHAR
			TYPE_INTEGER [
				int: as red-integer! stack/push*
				int/header: type
				int/value: get-value-int as int-ptr! p unit
				as red-value! int
			]
			TYPE_FLOAT [
				float: as red-float! stack/push*
				float/header: TYPE_FLOAT
				float/value: either unit = 6 [
								pf: as pointer! [float!] p
								pf/value
							][
								pf32: as pointer! [float32!] p
								as-float pf32/value
							]
				as red-value! float
			]
		]
	]

	set-value: func [
		p		[byte-ptr!]
		value	[red-value!]
		unit	[integer!]
		/local
			int  [red-integer!]
			f	 [red-float!]
			p4	 [int-ptr!]
			pf	 [pointer! [float!]]
			pf32 [pointer! [float32!]]
	][
		switch TYPE_OF(value) [
			TYPE_CHAR
			TYPE_INTEGER [ 			;-- char! and integer! structs are overlapping
				int: as red-integer! value
				p4: as int-ptr! p
				p4/value: switch unit [
					1 [int/value and FFh or (p4/value and FFFFFF00h)]
					2 [int/value and FFFFh or (p4/value and FFFF0000h)]
					4 [int/value]
				]
			]
			TYPE_FLOAT [
				f: as red-float! value
				either unit = 6 [
					pf: as pointer! [float!] p
					pf/value: f/value
				][
					pf32: as pointer! [float32!] p
					pf32/value: as float32! f/value
				]
			]
			default [
				fire [TO_ERROR(script invalid-type) datatype/push TYPE_OF(value)]
			]
		]
	]

	append-values: func [
		vec	[red-vector!]
		blk [red-block!]
		/local
			value [red-value!]
			tail  [red-value!]
	][
		value: block/rs-head blk
		tail:  block/rs-tail blk

		while [value < tail][
			rs-append vec value
			value: value + 1
		]
	]

	clone: func [
		vec		[red-vector!]							;-- clone the vector in-place
		return: [red-vector!]
		/local
			new    [node!]
			s	   [series!]
			target [series!]
			size   [integer!]
	][
		s: GET_BUFFER(vec)
		size: s/size									;-- @@ head position ignored
		new: alloc-bytes size

		unless zero? size [
			target: as series! new/value
			copy-memory
				as byte-ptr! target/offset
				as byte-ptr! s/offset
				size
			target/tail: as cell! ((as byte-ptr! target/offset) + size)
		]
		vec/node: new
		vec
	]

	push: func [
		vec [red-vector!]
	][
		#if debug? = yes [if verbose > 0 [print-line "vector/push"]]

		copy-cell as red-value! vec stack/push*
	]

	make-at: func [
		slot	[red-value!]
		size	[integer!]
		type	[integer!]
		unit	[integer!]
		return: [red-vector!]
		/local
			vec [red-vector!]
			s	[series!]
	][
		vec: as red-vector! slot
		vec/header: TYPE_VECTOR							;-- implicit reset of all header flags
		vec/head: 	0
		vec/node: 	alloc-bytes size * unit
		vec/type:	type

		s: GET_BUFFER(vec)
		if unit = 8 [unit: 6]
		s/flags: s/flags and flag-unit-mask or unit
		vec
	]

	;--- Actions ---

	make: func [
		proto	[red-value!]
		spec	[red-value!]
		return:	[red-vector!]
		/local
			s	  [series!]
			w	  [red-word!]
			vec	  [red-vector!]
			int	  [red-integer!]
			value [red-value!]
			sym   [integer!]
			size  [integer!]
			blk-sz [integer!]
			unit  [integer!]
			type  [integer!]
			fill? [logic!]
			end   [byte-ptr!]
	][
		#if debug? = yes [if verbose > 0 [print-line "vector/make"]]

		fill?: yes
		size: 0
		unit: 0
		type: TYPE_OF(spec)

		switch type [
			TYPE_INTEGER [
				int: as red-integer! spec
				size: int/value
			]
			TYPE_BLOCK [
				size:  block/rs-length? as red-block! spec
				either zero? size [
					type: TYPE_INTEGER
				][
					value: block/rs-head as red-block! spec
					type:  TYPE_OF(value)
					if type = TYPE_WORD [
						if size < 2 [
							fire [TO_ERROR(script invalid-spec-field) spec]
						]

						;-- data type
						w: as red-word! value
						sym: symbol/resolve w/symbol
						type: case [
							sym = words/integer!	[TYPE_INTEGER]
							sym = words/char!		[TYPE_CHAR]
							sym = words/float!		[TYPE_FLOAT]
							true					[TYPE_INTEGER]
						]

						;-- bit size
						block/rs-next as red-block! spec
						value: block/rs-head as red-block! spec
						int: as red-integer! value
						unit: int/value >> 3

						;-- size or block values
						block/rs-next as red-block! spec
						value: block/rs-head as red-block! spec
						either TYPE_OF(value) = TYPE_INTEGER [
							int: as red-integer! value
							size: int/value
							either block/rs-next as red-block! spec [
								spec: value
							][
								spec: block/rs-head as red-block! spec
							]
						][
							either TYPE_OF(value) = TYPE_BLOCK [
								spec: value
								size: block/rs-length? as red-block! spec
							][
								fire [TO_ERROR(script invalid-spec-field) spec]
							]
						]
					]
					if zero? unit [
						unit:  switch type [
							TYPE_CHAR
							TYPE_INTEGER [size? integer!]
							TYPE_FLOAT	 [size? float!]
							default [
								fire [TO_ERROR(script invalid-type) datatype/push type]
								0
							]
						]
					]
				]
			]
			default [--NOT_IMPLEMENTED--]
		]

		if TYPE_OF(spec) = TYPE_BLOCK [
			blk-sz: block/rs-length? as red-block! spec
			if blk-sz >= size [size: blk-sz fill?: no]
		]
		if size <= 0 [fill?: no size: 1]
		if zero? unit [unit: 4]
		vec: make-at stack/push* size type unit

		if TYPE_OF(spec) = TYPE_BLOCK [
			append-values vec as red-block! spec
		]
		if fill? [
			s: GET_BUFFER(vec)
			end: (as byte-ptr! s/offset) + (size * unit)
			fill as byte-ptr! s/tail end null
			s/tail: as cell! end
		]
		vec
	]

	serialize: func [
		vec		[red-vector!]
		buffer	[red-string!]
		only?	[logic!]
		all?	[logic!]
		flat?	[logic!]
		arg		[red-value!]
		part	[integer!]
		mold?	[logic!]
		return: [integer!]
		/local
			s		[series!]
			p		[byte-ptr!]
			end		[byte-ptr!]
			unit	[integer!]
			pf		[pointer! [float!]]
			pf32	[pointer! [float32!]]
			formed	[c-string!]
	][
		#if debug? = yes [if verbose > 0 [print-line "vector/serialize"]]

		s: GET_BUFFER(vec)
		unit: GET_UNIT(s)
		p: (as byte-ptr! s/offset) + (vec/head << (unit >> 1))
		end: as byte-ptr! s/tail
		if unit = 6 [unit: 8]

		while [p < end][
			if all [OPTION?(arg) part <= 0][return part]

			either vec/type = TYPE_CHAR [
				part: either mold? [
					string/concatenate-literal buffer {#"}
					string/append-escaped-char
							buffer
							get-value-int as int-ptr! p unit
							string/ESC_CHAR
							all?
					string/append-char GET_BUFFER(buffer) as-integer #"^""
					part - 4
				][
					string/append-escaped-char
							buffer
							get-value-int as int-ptr! p unit
							string/ESC_CHAR
							all?
					part - 1
				]
			][
				either vec/type = TYPE_FLOAT [
					formed: either unit = 8 [
						pf: as pointer! [float!] p
						float/form-float pf/value no
					][
						pf32: as pointer! [float32!] p
						float/form-float as-float pf32/value yes
					]
				][
					formed: integer/form-signed get-value-int as int-ptr! p unit
				]
				string/concatenate-literal buffer formed
				part: part - system/words/length? formed	;@@ optimize by removing length?
			]
			if p + unit < end [
				string/append-char GET_BUFFER(buffer) as-integer space
				part: part - 1
			]
			p: p + unit
		]
		part
	]

	form: func [
		vec		[red-vector!]
		buffer	[red-string!]
		arg		[red-value!]
		part 	[integer!]
		return: [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "vector/form"]]

		serialize vec buffer no no no arg part no
	]

	mold: func [
		vec		[red-vector!]
		buffer	[red-string!]
		only?	[logic!]
		all?	[logic!]
		flat?	[logic!]
		arg		[red-value!]
		part	[integer!]
		indent	[integer!]
		return:	[integer!]
		/local
			s	 [series!]
			unit [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "vector/mold"]]

		string/concatenate-literal buffer "make vector! ["
		part: part - 14

		string/concatenate-literal buffer switch vec/type [
			TYPE_CHAR		[part: part - 5 "char!"]
			TYPE_INTEGER	[part: part - 8 "integer!"]
			TYPE_FLOAT		[part: part - 6 "float!"]
		]
		string/append-char GET_BUFFER(buffer) as-integer space

		s: GET_BUFFER(vec)
		unit: GET_UNIT(s)
		if unit = 6 [unit: 8]
		formed: integer/form-signed unit << 3
		string/concatenate-literal buffer formed
		string/append-char GET_BUFFER(buffer) as-integer space
		part: part - system/words/length? formed

		formed: integer/form-signed rs-length? vec
		string/concatenate-literal buffer formed
		string/append-char GET_BUFFER(buffer) as-integer space
		part: part - system/words/length? formed

		string/append-char GET_BUFFER(buffer) as-integer #"["
		part: part - 4									;-- 3 spaces + "["

		part: serialize vec buffer only? all? flat? arg part yes

		string/concatenate-literal buffer "]]"
		part - 2
	]

	;--- Modifying actions ---

	insert: func [
		vec		 [red-vector!]
		value	 [red-value!]
		part-arg [red-value!]
		only?	 [logic!]
		dup-arg	 [red-value!]
		append?	 [logic!]
		return:	 [red-value!]
		/local
			src		  [red-block!]
			cell	  [red-value!]
			limit	  [red-value!]
			int		  [red-integer!]
			char	  [red-char!]
			sp		  [red-vector!]
			s		  [series!]
			s2		  [series!]
			dup-n	  [integer!]
			cnt		  [integer!]
			part	  [integer!]
			len		  [integer!]
			added	  [integer!]
			vec-type  [integer!]
			tail?	  [logic!]
	][
		#if debug? = yes [if verbose > 0 [print-line "vector/insert"]]

		dup-n: 1
		cnt:   1
		part: -1
		vec-type: vec/type

		if OPTION?(part-arg) [
			part: either TYPE_OF(part-arg) = TYPE_INTEGER [
				int: as red-integer! part-arg
				int/value
			][
				sp: as red-vector! part-arg
				unless all [
					TYPE_OF(sp) = TYPE_VECTOR
					sp/node = vec/node
				][
					fire [TO_ERROR(script invalid-part) part-arg]
				]
				sp/head + 1								;-- /head is 0-based
			]
		]
		if OPTION?(dup-arg) [
			int: as red-integer! dup-arg
			cnt: int/value
			if negative? cnt [return as red-value! vec]
			dup-n: cnt
		]

		s: GET_BUFFER(vec)
		tail?: any [
			(as-integer s/tail - s/offset) >> (GET_UNIT(s) >> 1) = vec/head
			append?
		]

		while [not zero? cnt][							;-- /dup support
			either TYPE_OF(value) = TYPE_BLOCK [		;@@ replace it with: typeset/any-block?
				src: as red-block! value
				s2: GET_BUFFER(src)
				cell:  s2/offset + src/head
				limit: cell + block/rs-length? src
			][
				cell:  value
				limit: value + 1
			]
			added: 0

			while [all [cell < limit added <> part]][	;-- multiple values case
				if TYPE_OF(cell) <> vec-type [
					fire [TO_ERROR(script invalid-type) datatype/push TYPE_OF(cell)]
				]
				either tail? [
					rs-append vec cell
				][
					rs-insert vec vec/head + added cell
				]
				added: added + 1
				cell: cell + 1
			]
			cnt: cnt - 1
		]
		unless append? [
			added: added * dup-n
			vec/head: vec/head + added
			s: GET_BUFFER(vec)
			assert (as byte-ptr! s/offset) + (vec/head << (GET_UNIT(s) >> 1)) <= as byte-ptr! s/tail
		]
		as red-value! vec
	]

	do-math: func [
		type		[math-op!]
		return:		[red-value!]
		/local
			left	[red-vector!]
			right	[red-vector!]
			s1		[series!]
			s2		[series!]
			unit	[integer!]
			unit1	[integer!]
			unit2	[integer!]
			len		[integer!]
			len1	[integer!]
			len2	[integer!]
			v1		[integer!]
			v2		[integer!]
			i		[integer!]
			node	[node!]
			buffer	[series!]
			p		[byte-ptr!]
			p1		[byte-ptr!]
			p2		[byte-ptr!]
			p4		[int-ptr!]
	][
		left: as red-vector! stack/arguments
		right: left + 1

		assert TYPE_OF(right) = TYPE_VECTOR

		s1: GET_BUFFER(left)
		s2: GET_BUFFER(right)
		unit1: GET_UNIT(s1)
		unit2: GET_UNIT(s2)
		len1: rs-length? left
		len2: rs-length? right

		p1: (as byte-ptr! s1/offset) + (left/head << (unit1 >> 1))
		p2: (as byte-ptr! s2/offset) + (right/head << (unit2 >> 1))
		either len1 > len2 [len: len1][
			len: len2
			len2: len1							;-- set len2 to minimum length
			p: p1 p1: p2 p2: p
			unit: unit1 unit1: unit2 unit2: unit
		]
		unit: either unit1 > unit2 [unit1][unit2]
		node: alloc-bytes len << (unit >> 1)
		buffer: as series! node/value
		buffer/flags: buffer/flags and flag-unit-mask or unit
		buffer/tail: as cell! (as byte-ptr! buffer/offset) + (len << (unit >> 1))

		i: 0
		p:  as byte-ptr! buffer/offset
		while [i < len][
			v1: get-value-int as int-ptr! p1 unit1
			if i < len2 [
				v2: get-value-int as int-ptr! p2 unit2
				v1: switch type [
					OP_ADD [v1 + v2]
					OP_SUB [v1 - v2]
					OP_MUL [v1 * v2]
					OP_REM [v1 % v2]
					OP_AND [v1 and v2]
					OP_OR  [v1 or v2]
					OP_XOR [v1 xor v2]
					OP_DIV [
						either zero? v2 [
							fire [TO_ERROR(math zero-divide)]
							0								;-- pass the compiler's type-checking
						][
							v1 / v2
						]
					]
				]
				p2: p2 + unit2
			]
			p4: as int-ptr! p
			p4/value: switch unit [
				1 [v1 and FFh or (p4/value and FFFFFF00h)]
				2 [v1 and FFFFh or (p4/value and FFFF0000h)]
				4 [v1]
			]
			i:  i  + 1
			p:  p  + unit
			p1: p1 + unit1
		]
		left/node: node
		left/head: 0
		as red-value! left
	]

	add: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "vector/add"]]
		do-math OP_ADD
	]

	divide: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "vector/divide"]]
		do-math OP_DIV
	]

	multiply: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "vector/multiply"]]
		do-math OP_MUL
	]

	remainder: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "vector/remainder"]]
		do-math OP_REM
	]

	subtract: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "vector/subtract"]]
		do-math OP_SUB
	]

	and~: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "vector/and~"]]
		do-math OP_AND
	]

	or~: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "vector/or~"]]
		do-math OP_OR
	]

	xor~: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "vector/xor~"]]
		do-math OP_XOR
	]

	init: does [
		datatype/register [
			TYPE_VECTOR
			TYPE_STRING
			"vector!"
			;-- General actions --
			:make
			null			;random
			null			;reflect
			null			;to
			:form
			:mold
			INHERIT_ACTION	;eval-path
			null			;set-path
			null			;compare
			;-- Scalar actions --
			null			;absolute
			:add
			:divide
			:multiply
			null			;negate
			null			;power
			:remainder
			null			;round
			:subtract
			null			;even?
			null			;odd?
			;-- Bitwise actions --
			:and~
			null			;complement
			:or~
			:xor~
			;-- Series actions --
			null			;append
			INHERIT_ACTION	;at
			INHERIT_ACTION	;back
			null			;change
			INHERIT_ACTION	;clear
			INHERIT_ACTION	;copy
			INHERIT_ACTION	;find
			INHERIT_ACTION	;head
			INHERIT_ACTION	;head?
			INHERIT_ACTION	;index?
			INHERIT_ACTION	;insert
			INHERIT_ACTION	;length?
			INHERIT_ACTION	;next
			INHERIT_ACTION	;pick
			INHERIT_ACTION	;poke
			INHERIT_ACTION	;remove
			INHERIT_ACTION	;reverse
			INHERIT_ACTION	;select
			INHERIT_ACTION	;sort
			INHERIT_ACTION	;skip
			null			;swap
			INHERIT_ACTION	;tail
			INHERIT_ACTION	;tail?
			INHERIT_ACTION	;take
			null			;trim
			;-- I/O actions --
			null			;create
			null			;close
			null			;delete
			null			;modify
			null			;open
			null			;open?
			null			;query
			null			;read
			null			;rename
			null			;update
			null			;write
		]
	]
]