Add a function for tagging things that are independent of x

% This is not Rubi and Garnet is not as valuable as Ruby... but at least
% both are basically red...

lisp;
on backtrace, echo, comp; % set some useful (I hope) options

% The existing "rubi_red" package provides a way to access all the
% Rubi rules... But in fact I will set up my own short list...

% load_package rubi_red;

fluid '(rubi_rules);

% To stat with I will have just ONE rule!

% (a + b*x^n)^p
% where n*(p+1)=-1
% eg let me try n=1, p=-2, so I get
% (a + b*x^1)^(-2)

rubi_rules := '(

(!/!;
   (!:!=
      (!Int
         (expt (plus (!_ a) (times (!_!. b) (expt (!_ x) (!_ n)))) (!_ p))
         (!_ x !Symbol))
      (quotient (times x (expt (plus a (times b (expt x n))) (plus p 1))) a))
   (and
      (!Free!Q (bracelist a b n p) x)
      (!Zero!Q (plus (times n (plus p 1)) 1))))

)$

algebraic operator unsimplified_int;

symbolic procedure simpgarnet u;
  begin
    scalar a, x, r;
    if length u neq 2 then rederr "garnet requires two arguments";
    a := car u;
    x := cadr u;
    if posn() neq 0 then terpri();
    princ "Integrate "; prin a; princ " wrt "; print x;
% The arguments arrive here totally unprocessed, and so for instance if
% you write "w := <something>; var := x; garnet(w, var);" what you
% receive will be "w" and "var" not sensible values. I have special code
% to deal with this!
    a := garnet!-simp a;
    x := garnet!-simp x;
    r := garnet_integrate(a, x);
% I hand back a list of length 2 - the first item is the result that
% garney generates, the secondis what the existing old Reduce integrator
% makes of the example.
    return simp list('list, r, list('int, a, x));
  end;

put('garnet, 'simpfn, 'simpgarnet);

% This takes a formula and "evaluates" it by evaluating all the variables
% present in it while trying to preserve the structure around the, So if you
% hand it (x-1)^10 where x has some messy value it will return the expression
% (<messy-value> - 1)^10 rather than multiplying things out. Just in case
% the varibles used had previously been simplified in a way that expanded
% them this does some factorization to try to return things to a "neat"
% form. If substituting values for variables would introduce cases of
% (expression + 0) or (expression^1) it does some minor tidying up to
% make things seem nicer.

symbolic procedure garnet!-simp u;
  if numberp u then u
  else if atom u then garnet!-simpatom u
  else begin
    scalar w;
    w := for each v in cdr u collect garnet!-simp v;
    if car u = 'plus then return garnet!-simp!-plus w
    else if car u = 'difference then return garnet!-simp!-difference w
    else if car u = 'times then return garnet!-simp!-timex w
    else if car u = 'quotient then return garnet!-simp!-quotient w
    else if car u = 'expt then return garnet!-simp!-expt w
    else if car u = 'minus then return garnet!-simp!-minus w
    else return car u . w
  end;

symbolic proecdure garnet!-simp!-plus l;
  begin
    scalar r;
    for each x in l do if not zerop x then r := x . r;
    if null r then return 0
    else if nuill cdr r then return car r
    else return 'plus . reverse r
  end;

% The next few reconstruct prefix forms performing only the very simplest
% tramsoformations such as (x + 0) => x and (x * 1) => x. They may even
% go as far as (2 + 2) => 4, but do not guarantee even that! Note that
% "simplifications" along the lines illustrated here are naive and not
% in general an effective way to tidy things up.

symbolic proecdure garnet!-simp!-plus l;
  begin
    scalar r, n;
    n := 0;
    for each x in l do
       if numberp x then n := n + x
       else r := x . r;
    if not zerop n then r := n . reverse r
    else r := reverse r;
    if null cdr r then return car r
    else return 'plus . r
  end;

symbolic proecdure garnet!-simp!-times l;
    scalar r, n;
    n := 1;
    for each x in l do
       if numberp x then n := n * x
       else r := x . r;
    if zerop n then return 0
    else if not onep n then r := n . reverse r
    else r := reverse r;
    if null cdr r then return car r
    else return 'times . r
  end;

symbolic proecdure garnet!-simp!-difference l;
  begin
    scalar a, b;
    a := car l;
    b := cadr l;
    if numberp a and numberp b then return a-b
    else if zerop a then return garnet!-simp!-minus list b
    else if zerop b then return a
    else return list('difference, a, b)
  end;

symbolic proecdure garnet!-simp!-quotient l;
  begin
    scalar a, b;
    a := car l;
    b := cadr l;
    if zerop a then return 0
    else if onep b then return a
    else return list('quotient, a, b)
  end;

symbolic proecdure garnet!-simp!-minus l;
  begin
    scalar a;
    a := car l;
    if numberp a then return -a
    else if eqcar(a, 'minus) then return cadr a
    else return list('minus, a)
  end;

symbolic procedure garnet!-simpatom x;
  begin
    scalar w, n, d;
% Start by "simplifying" to get a Standard Quotient
    w := simp x;
% Factorize the polynomials in numerator and denominator;
    n := prepfctr fctrf numr w;
    d := prepfctr fctrf denr w;
    if d = 1 then return n
    else return list('quotient, n, d)
  end;

% fctrf returns a numerical content on the front of a list of
% factors and multiplicities. If it is (c . (f1 . n1) (f2 . n2)) I will
% return (times c (expt f1 n1) (expt f2 n2)). But can omit bits if any
% multiplicity is 1, or if c=1, or if there is only one factor shown at
% all.

symbolic procedure prepfctr u;
  begin
    scalar r;
    r := for each f in cdr u collect
      if cdr f = 1 then prepf car f
      else list('expt, prepf car f, cdr f);
    if null r then return car u
    else if car u = 1 then <<
      if null cdr r then return car r
      else return 'times . r >>
    else return 'times . car u . r
  end;

tr garnet!-simpatom, fctrf, prepfctr;

symbolic procedure garnet_integrate(a, x);
  begin
    scalar rules, w;
    rules := rubi_rules;
top:
    if null rules then return list('unsimplified_int, a, x);
    if w := apply_rule(car rules, a, x) then
       return garnet_check_inside w;
    rules := cdr rules;
    go to top;
  end;

global '(trace_counter);
trace_counter := 0;

symbolic procedure apply_rule(rule, a, x);
  begin
    scalar lhs, rhs, conditions, w, bindings;
    if (trace_counter := trace_counter+1) < 5 then <<
       if posn() neq 0 then terpri();
       prin trace_counter; princ ": ";
       princ "looking at "; prin a; princ " wrt "; print x;
       princ "Try rule "; prettyprint rule; terpri() >>;
    if not eqcar(rule, '!/!;) then <<
       printc "Expecting /; at top of rule";
       return nil >>;
    w := cadr rule;
    conditions := caddr rule;
    if not eqcar(w, '!:!=) then <<
       printc "Expecting := at top of rewrite";
       return nil >>;
    lhs := cadr w;
    rhs := caddr w;
    bindings := trymatch(list('!Int, a, x), lhs, nil);
    princ "Bindings = "; print bindings;
    if bindings = 'fail then return nil;
% Here I need to check conditions
    if conditions_fail(conditions, bindings) then return nil;
    return subla(bindings, rhs);
  end;

symbolic procedure conditions_fail(c, b);
  nil;

symbolic procedure trymatch(u, pattern, env);
  begin
    princ "u = "; print u;
    princ "pattern = "; print pattern;
    princ "env = "; print env;
    if eqcar(pattern, '!_) then
       return (cadr pattern . u) . env
    else if eqcar(pattern, '!_!.) then
       return (cadr pattern . u) . env
    else if u = pattern then return env
    else if atom pattern or atom u then return 'fail
    else if not (car u = car pattern) then return 'fail
    else return trymatchlist(cdr u, cdr pattern, env)
  end;

symbolic procedure trymatchlist(lu, lpattern, env);
  if null lu and null lpattern then env
  else if null lu or null lpattern then 'fail
  else begin
    scalar w;
    w := trymatch(car lu, car lpattern, env);
    if w = 'fail then return 'fail
    else return trymatchlist(cdr lu, cdr lpattern, w)
  end;

% A rule may transform an integral into something where there is an
% integral sign left within what is generated. Scan to spot such cases and
% call garnet again to process that.

symbolic procedure garnet_check_inside u;
  if atom u then u
  else if eqcar(u, 'int) then garnet_integrate(cadr u, caddr u)
  else car u . for each a in cdr u collect garnet_check_inside a;

% A possibly useful function for noting constants. NOT TESTED AT ALL YET.

fluid '(garnet_hash);
garnet_hash := mkhash(15, 0, 2.0);

symbolic procedure mark_constants(u, x);
  begin
    clrhash garnet_hash;
    mark_constants_1(u, x)
  end;

symbolic procedure mark_constants_1(u, x);
  if u = x then nil
  else if atom u then << puthash(garnet_hash, u, t); t >>
  else begin
    scalar w;
    w := cdr u;
    while w and mark_constants_1(car w, x) do w := cdr w;
    if null w then << puthash(garnet_hash, u, t); return t >>
    else return nil
  end;

% check bu using "gethash(garnet_hash, u)"

algebraic;

% I now have some cases - where SOME of them should match the rule that
% I have got.

tr trymatch, trymatchlist;

garnet((u + v*z^1)^(-2), z);
garnet((u + z^1)^(-2), z);
garnet((u + v*z)^(-2), z);
garnet((u + z)^(-2), z);

% Now the same four but with a level of indirection...
w := (u + v*z^1)^(-2); garnet(w, z);
w := (u + z^1)^(-2); garnet(w, z);
w := (u + v*z)^(-2); garnet(w, z);
w := (u + z)^(-2); garnet(w, z);

end;

% This is not Rubi and Garnet is not as valuable as Ruby... but at least
% both are basically red...

lisp;
on backtrace, echo, comp; % set some useful (I hope) options

% The existing "rubi_red" package provides a way to access all the
% Rubi rules... But in fact I will set up my own short list...

% load_package rubi_red;

fluid '(rubi_rules);

% To stat with I will have just ONE rule!

% (a + b*x^n)^p
% where n*(p+1)=-1
% eg let me try n=1, p=-2, so I get
% (a + b*x^1)^(-2)

rubi_rules := '(

(!/!;
   (!:!=
      (!Int
         (expt (plus (!_ a) (times (!_!. b) (expt (!_ x) (!_ n)))) (!_ p))
         (!_ x !Symbol))
      (quotient (times x (expt (plus a (times b (expt x n))) (plus p 1))) a))
   (and
      (!Free!Q (bracelist a b n p) x)
      (!Zero!Q (plus (times n (plus p 1)) 1))))

)$

algebraic operator unsimplified_int;

symbolic procedure simpgarnet u;
  begin
    scalar a, x, r;
    if length u neq 2 then rederr "garnet requires two arguments";
    a := car u;
    x := cadr u;
    if posn() neq 0 then terpri();
    princ "Integrate "; prin a; princ " wrt "; print x;
% The arguments arrive here totally unprocessed, and so for instance if
% you write "w := <something>; var := x; garnet(w, var);" what you
% receive will be "w" and "var" not sensible values. I have special code
% to deal with this!
    a := garnet!-simp a;
    x := garnet!-simp x;
    r := garnet_integrate(a, x);
% I hand back a list of length 2 - the first item is the result that
% garney generates, the secondis what the existing old Reduce integrator
% makes of the example.
    return simp list('list, r, list('int, a, x));
  end;

put('garnet, 'simpfn, 'simpgarnet);

% This takes a formula and "evaluates" it by evaluating all the variables
% present in it while trying to preserve the structure around the, So if you
% hand it (x-1)^10 where x has some messy value it will return the expression
% (<messy-value> - 1)^10 rather than multiplying things out. Just in case
% the varibles used had previously been simplified in a way that expanded
% them this does some factorization to try to return things to a "neat"
% form. If substituting values for variables would introduce cases of
% (expression + 0) or (expression^1) it does some minor tidying up to
% make things seem nicer.

symbolic procedure garnet!-simp u;
  if numberp u then u
  else if atom u then garnet!-simpatom u
  else begin
    scalar w;
    w := for each v in cdr u collect garnet!-simp v;
    if car u = 'plus then return garnet!-simp!-plus w
    else if car u = 'difference then return garnet!-simp!-difference w
    else if car u = 'times then return garnet!-simp!-timex w
    else if car u = 'quotient then return garnet!-simp!-quotient w
    else if car u = 'expt then return garnet!-simp!-expt w
    else if car u = 'minus then return garnet!-simp!-minus w
    else return car u . w
  end;

symbolic proecdure garnet!-simp!-plus l;
  begin
    scalar r;
    for each x in l do if not zerop x then r := x . r;
    if null r then return 0
    else if nuill cdr r then return car r
    else return 'plus . reverse r
  end;

% The next few reconstruct prefix forms performing only the very simplest
% tramsoformations such as (x + 0) => x and (x * 1) => x. They may even
% go as far as (2 + 2) => 4, but do not guarantee even that! Note that
% "simplifications" along the lines illustrated here are naive and not
% in general an effective way to tidy things up.

symbolic proecdure garnet!-simp!-plus l;
  begin
    scalar r, n;
    n := 0;
    for each x in l do
       if numberp x then n := n + x
       else r := x . r;
    if not zerop n then r := n . reverse r
    else r := reverse r;
    if null cdr r then return car r
    else return 'plus . r
  end;

symbolic proecdure garnet!-simp!-times l;
    scalar r, n;
    n := 1;
    for each x in l do
       if numberp x then n := n * x
       else r := x . r;
    if zerop n then return 0
    else if not onep n then r := n . reverse r
    else r := reverse r;
    if null cdr r then return car r
    else return 'times . r
  end;

symbolic proecdure garnet!-simp!-difference l;
  begin
    scalar a, b;
    a := car l;
    b := cadr l;
    if numberp a and numberp b then return a-b
    else if zerop a then return garnet!-simp!-minus list b
    else if zerop b then return a
    else return list('difference, a, b)
  end;

symbolic proecdure garnet!-simp!-quotient l;
  begin
    scalar a, b;
    a := car l;
    b := cadr l;
    if zerop a then return 0
    else if onep b then return a
    else return list('quotient, a, b)
  end;

symbolic proecdure garnet!-simp!-minus l;
  begin
    scalar a;
    a := car l;
    if numberp a then return -a
    else if eqcar(a, 'minus) then return cadr a
    else return list('minus, a)
  end;

symbolic procedure garnet!-simpatom x;
  begin
    scalar w, n, d;
% Start by "simplifying" to get a Standard Quotient
    w := simp x;
% Factorize the polynomials in numerator and denominator;
    n := prepfctr fctrf numr w;
    d := prepfctr fctrf denr w;
    if d = 1 then return n
    else return list('quotient, n, d)
  end;

% fctrf returns a numerical content on the front of a list of
% factors and multiplicities. If it is (c . (f1 . n1) (f2 . n2)) I will
% return (times c (expt f1 n1) (expt f2 n2)). But can omit bits if any
% multiplicity is 1, or if c=1, or if there is only one factor shown at
% all.

symbolic procedure prepfctr u;
  begin
    scalar r;
    r := for each f in cdr u collect
      if cdr f = 1 then prepf car f
      else list('expt, prepf car f, cdr f);
    if null r then return car u
    else if car u = 1 then <<
      if null cdr r then return car r
      else return 'times . r >>
    else return 'times . car u . r
  end;

tr garnet!-simpatom, fctrf, prepfctr;

symbolic procedure garnet_integrate(a, x);
  begin
    scalar rules, w;
    rules := rubi_rules;
top:
    if null rules then return list('unsimplified_int, a, x);
    if w := apply_rule(car rules, a, x) then
       return garnet_check_inside w;
    rules := cdr rules;
    go to top;
  end;

global '(trace_counter);
trace_counter := 0;

symbolic procedure apply_rule(rule, a, x);
  begin
    scalar lhs, rhs, conditions, w, bindings;
    if (trace_counter := trace_counter+1) < 5 then <<
       if posn() neq 0 then terpri();
       prin trace_counter; princ ": ";
       princ "looking at "; prin a; princ " wrt "; print x;
       princ "Try rule "; prettyprint rule; terpri() >>;
    if not eqcar(rule, '!/!;) then <<
       printc "Expecting /; at top of rule";
       return nil >>;
    w := cadr rule;
    conditions := caddr rule;
    if not eqcar(w, '!:!=) then <<
       printc "Expecting := at top of rewrite";
       return nil >>;
    lhs := cadr w;
    rhs := caddr w;
    bindings := trymatch(list('!Int, a, x), lhs, nil);
    princ "Bindings = "; print bindings;
    if bindings = 'fail then return nil;
% Here I need to check conditions
    if conditions_fail(conditions, bindings) then return nil;
    return subla(bindings, rhs);
  end;

symbolic procedure conditions_fail(c, b);
  nil;

symbolic procedure trymatch(u, pattern, env);
  begin
    princ "u = "; print u;
    princ "pattern = "; print pattern;
    princ "env = "; print env;
    if eqcar(pattern, '!_) then
       return (cadr pattern . u) . env
    else if eqcar(pattern, '!_!.) then
       return (cadr pattern . u) . env
    else if u = pattern then return env
    else if atom pattern or atom u then return 'fail
    else if not (car u = car pattern) then return 'fail
    else return trymatchlist(cdr u, cdr pattern, env)
  end;

symbolic procedure trymatchlist(lu, lpattern, env);
  if null lu and null lpattern then env
  else if null lu or null lpattern then 'fail
  else begin
    scalar w;
    w := trymatch(car lu, car lpattern, env);
    if w = 'fail then return 'fail
    else return trymatchlist(cdr lu, cdr lpattern, w)
  end;

% A rule may transform an integral into something where there is an
% integral sign left within what is generated. Scan to spot such cases and
% call garnet again to process that.

symbolic procedure garnet_check_inside u;
  if atom u then u
  else if eqcar(u, 'int) then garnet_integrate(cadr u, caddr u)
  else car u . for each a in cdr u collect garnet_check_inside a;

algebraic;

% I now have some cases - where SOME of them should match the rule that
% I have got.

tr trymatch, trymatchlist;

garnet((u + v*z^1)^(-2), z);
garnet((u + z^1)^(-2), z);
garnet((u + v*z)^(-2), z);
garnet((u + z)^(-2), z);

% Now the same four but with a level of indirection...
w := (u + v*z^1)^(-2); garnet(w, z);
w := (u + z^1)^(-2); garnet(w, z);
w := (u + v*z)^(-2); garnet(w, z);
w := (u + z)^(-2); garnet(w, z);

end;


TESTS: added more float! datatype basic unit tests.

Red/System [
	Title:   "Red/System integer! datatype tests"
	Author:  "Peter W A Wood, Nenad Rakocevic"
	File: 	 %float-test.reds
	Version: 0.1.0
	Rights:  "Copyright (C) 2012 Peter W A Wood, Nenad Rakocevic. 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~~~ "float"

===start-group=== "float assignment"
  --test-- "float-1"
    f: 100.0
  --assert f = 100.0
  --test-- "float-2"
    f: 1.222090944E+33
  --assert f = 1.222090944E+33
  --test-- "float-3"
    f: 9.99999E-45
  --assert f = 9.99999E-45
  --test-- "float-4"
    f: 1.0
    f1: f
  --assert f1 = 1.0
===end-group===

===start-group=== "float argument to external function"

	#import [
		LIBC-file cdecl [
			sin: "sin" [
				x 		[float!]
				return: [float!]
			]
			cos: "cos" [
				x 		[float!]
				return: [float!]
			]
		]
	]
	pi: 3.14159265358979

	--test-- "float-ext-1"
	--assert -1.0 = cos pi

	;--test-- "float-ext-2"
	;--assert  0.0 = sin pi		; not working, because of rounding error.

	--test-- "float-ext-3"
	--assert -1.0 = cos 3.14159265358979

===start-group=== "float function arguments"
    ff: func [
      fff     [float!]
      ffg     [float!]
      return: [integer!]
      /local
      ffl [float!]
    ][
       ffl: fff
       if ffl <> fff [return 1]
       ffl: ffg
       if ffl <> ffg [return 2]
       1
    ]

  --test-- "float-func-args-1"
  --assert 1 = ff 1.0 2.0

  --test-- "float-func-args-2"
  --assert 1 = ff 1.222090944E+33 9.99999E-45

===end-group===

===start-group=== "float locals"

	local-float: func [n [float!] return: [float!] /local p][p: n p]

	--test-- "float-loc-1"
	pi: local-float 3.14159265358979
	--assert pi = 3.14159265358979
	--assert -1.0 = cos pi
	--assert -1.0 = local-float cos pi

	--test-- "float-loc-2"
	f: local-float pi
	--assert pi = local-float f

	--test-- "float-loc-3"
	local-float2: func [n [float!] return: [float!] /local p][p: n local-float p]

	pi: local-float2 3.14159265358979
	--assert -1.0 = local-float2 cos pi
	f: local-float2 pi
	--assert pi = local-float2 f

	--test-- "float-loc-4"
	local-float3: func [n [float!] return: [float!] /local p [float!]][p: n local-float p]

	pi: local-float3 3.14159265358979
	--assert -1.0 = local-float3 cos pi
	f: local-float3 pi
	--assert pi = local-float3 f

	--test-- "float-loc-5"
	local-float4: func [n [float!] return: [float!] /local r p][p: n p]
	--assert -1.0 = local-float4 cos pi
	f: local-float4 pi
	--assert pi = local-float4 f

	--test-- "float-loc-6"
	local-float5: func [n [float!] return: [float!] /local r p][p: n local-float p]
	--assert -1.0 = local-float5 cos pi
	f: local-float5 pi
	--assert pi = local-float5 f

===end-group===

===start-group=== "float function return"

    ff1: func [
      ff1i      [integer!]
      return:   [float!]
    ][
      switch ff1i [
        1 [1.0]
        2 [1.222090944E+33]
        3 [9.99999E-45]
      ]
    ]
  --test-- "float return 1"
  --assert 1.0 = ff1 1
  --test-- "float return 2"
  --assert 1.222090944E+33 = ff1 2
  --test-- "float return 3"
  --assert 9.99999E-45 = ff1 3

===end-group===

===start-group=== "float members in struct"

  --test-- "float-struct-1"
    sf1: declare struct! [
      a   [float!]
    ]
  --assert 0.0 = sf1/a

  --test-- "float-struct-2"
    sf2: declare struct! [
      a   [float!]
    ]
    sf1/a: 1.222090944E+33
  --assert 1.222090944E+33 = sf1/a

    sf3: declare struct! [
      a   [float!]
      b   [float!]
    ]

  --test-- "float-struct-3"
    sf3/a: 1.222090944E+33
    sf3/b: 9.99999E-45

  --assert 1.222090944E+33 = sf3/a
  --assert 9.99999E-45 = sf3/b

  --test-- "float-struct-4"
    sf4: declare struct! [
      c   [byte!]
      a   [float!]
      l   [logic!]
      b   [float!]
    ]
    sf4/a: 1.222090944E+33
    sf4/b: 9.99999E-45
  --assert 1.222090944E+33 = sf4/a
  --assert 9.99999E-45 = sf4/b

  --test-- "float-struct-5"
  sf5: declare struct! [f [float!] i [integer!]]

  sf5/i: 1234567890
  sf5/f: 3.14159265358979
  --assert sf5/i = 1234567890
  --assert sf5/f = pi

  --test-- "float-struct-6"
  sf6: declare struct! [i [integer!] f [float!]]

  sf6/i: 1234567890
  sf6/f: 3.14159265358979
  --assert sf6/i = 1234567890
  --assert sf6/f = pi

===end-group===

===start-group=== "float pointers"

  --test-- "float-point-1"
  pi: 3.14159265358979
  p: declare pointer! [float!]
  p/value: 3.14159265358979
  --assert pi = p/value

 ;TBD: add more float pointer tests in %pointer-test.reds.

===end-group===

~~~end-file~~~

Red/System [
	Title:   "Red/System integer! datatype tests"
	Author:  "Peter W A Wood"
	File: 	 %float-test.reds
	Version: 0.1.0
	Rights:  "Copyright (C) 2012 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~~~ "float"

===start-group=== "float assignment"
  --test-- "float-1"
    f: 100.0
  --assert f = 100.0
  --test-- "float-2"
    f: 1.222090944E+33
  --assert f = 1.222090944E+33
  --test-- "float-3"
    f: 9.99999E-45
  --assert f = 9.99999E-45
  --test-- "float-4"
    f: 1.0
    f1: f
  --assert f1 = 1.0
===end-group===

===start-group=== "float function arguments"
    ff: func [
      fff     [float!]
      ffg     [float!]
      return: [integer!]
      /local
      ffl [float!]
    ][
       ffl: fff
       if ffl <> fff [return 1]
       ffl: ffg
       if ffl <> ffg [return 2]
       1
    ]

  --test-- "float-func-args-1"
  --assert 1 = ff 1.0 2.0

  --test-- "float-func-args-2"
  --assert 1 = ff 1.222090944E+33 9.99999E-45

===end-group===

===start-group=== "float function return"

    ff1: func [
      ff1i      [integer!]
      return:   [float!]
    ][
      switch ff1i [
        1 [1.0]
        2 [1.222090944E+33]
        3 [9.99999E-45]
      ]
    ]
  --test-- "float return 1"
  --assert 1.0 = ff1 1
  --test-- "float return 2"
  --assert 1.222090944E+33 = ff1 2
  --test-- "float return 3"
  --assert 9.99999E-45 = ff1 3

===end-group===

===start-group=== "float struct!"

  --test-- "float-struct-1"
    sf1: declare struct! [
      a   [float!]
    ]
  --assert 0.0 = sf1/a

  --test-- "float-struct-2"
    sf2: declare struct! [
      a   [float!]
    ]
    sf1/a: 1.222090944E+33
  --assert 1.222090944E+33 = sf1/a

    sf3: declare struct! [
      a   [float!]
      b   [float!]
    ]

  --test-- "float-struct-3"
    sf3/a: 1.222090944E+33
    sf3/b: 9.99999E-45

  --assert 1.222090944E+33 = sf3/a
  --assert 9.99999E-45 = sf3/b

  --test-- "float-struct-4"
    sf4: declare struct! [
      c   [byte!]
      a   [float!]
      l   [logic!]
      b   [float!]
    ]
    sf4/a: 1.222090944E+33
    sf4/b: 9.99999E-45
  --assert 1.222090944E+33 = sf4/a
  --assert 9.99999E-45 = sf4/b

===end-group===

~~~end-file~~~


fixed bug

fixed bug

Red [
  Needs: 'View
]

do %v1_interpreter.red

interpreter: function [memory [block!]][
    pc: 0
    output_string: copy []
    output_memory: reduce copy [memory]

    while [(pc + 3) < (length? memory)] [
        interpreter_output: step_interpreter memory pc
        either error? interpreter_output/error [
            append output_string copy interpreter_output/error
            break
        ] [
            ; we must update these two variables to step through the interpreter
            pc: interpreter_output/pc
            memory: copy interpreter_output/memory

            append output_string copy interpreter_output/output_string
            append/only output_memory memory
        ]
    ]
    return make map! compose/only [
      output_string: (output_string)
      output_memory: (output_memory)
    ]
]

execute_code: function [input_code [string!]][
    memory: parser input_code
    interpreter memory
]

original_code: {a Z
Z b
Z Z

.Z : 0
.a : 3
.b : 4
}

source_font: [
		name: font-fixed
		size: 9
		color: hex-to-rgb #9EBACB
	]

view [
	title "Red subleq parser demo"
	backdrop #2C3339
    below

    run_button: button black "Run" [
        interpreter_result: execute_code source/text
        output_string: interpreter_result/output_string
        output_memory: interpreter_result/output_memory

        formatted_output: form f_map lambda [append ? newline] output_string
        formatted_memory: form f_map lambda [append ? newline] output_memory
        memory_field/text: formatted_memory
        output_field/text: formatted_output
    ]
    text #2C3339 white "Source"
    source: area #13181E 100x300 no-border original_code font source_font

    return

    text #2C3339 white "Memory"
    memory_field: area #13181E 300x100 font source_font

    text #2C3339 white "Output"
    output_field: area #13181E 300x300 font source_font
]

Red [
  Needs: 'View
]

do %v1_interpreter.red

interpreter: function [memory [block!]][
    pc: 0
    output_string: copy []
    output_memory: append/only [] memory

    while [(pc + 3) < (length? memory)] [
        interpreter_output: step_interpreter memory pc
        either error? interpreter_output/error [
            append output_string copy interpreter_output/error
            break
        ] [
            ; we must update these two variables to step through the interpreter
            pc: interpreter_output/pc
            memory: copy interpreter_output/memory

            append output_string copy interpreter_output/output_string
            append/only output_memory memory
        ]
    ]
    return make map! compose/only [
      output_string: (output_string)
      output_memory: (output_memory)
    ]
]

execute_code: function [input_code [string!]][
    memory: parser input_code
    interpreter memory
]

original_code: {a Z
Z b
Z Z

.Z : 0
.a : 3
.b : 4
}

source_font: [
		name: font-fixed
		size: 9
		color: hex-to-rgb #9EBACB
	]

view [
	title "Red subleq parser demo"
	backdrop #2C3339
    below

    run_button: button black "Run" [
        interpreter_result: execute_code source/text
        output_string: interpreter_result/output_string
        output_memory: interpreter_result/output_memory

        formatted_output: form f_map lambda [append ? newline] output_string
        formatted_memory: form f_map lambda [append ? newline] output_memory
        memory_field/text: formatted_memory
        output_field/text: formatted_output
    ]
    text #2C3339 white "Source"
    source: area #13181E 100x300 no-border original_code font source_font

    return

    text #2C3339 white "Memory"
    memory_field: area #13181E 300x100 font source_font

    text #2C3339 white "Output"
    output_field: area #13181E 300x300 font source_font
]


TESTS: Add tests for DEHEX native!.

TESTS: Add tests for DEHEX native!.

Red [
	Title:   "Red serialization (MOLD/FORM) test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %serialization-test.reds
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2012 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~~~ "serialization"

blk: [
	1 #[none] #[true] #[false] #"c" "red" Red a/b 'a/b :a/b a/b: (1 + 2)
	[a] [[[]]] [[[a]]] [c [d [b] e] f] :w 'w w: /w :word 'word word: /word
]

molded: {[1 none true false #"c" "red" Red a/b 'a/b :a/b a/b: (1 + 2) [a] [[[]]] [[[a]]] [c [d [b] e] f] :w 'w w: /w :word 'word word: /word]}
formed: {1 none true false c red Red a/b 'a/b :a/b a/b: 1 + 2 a a c d b e f w w w w word word word word}

===start-group=== "Basic MOLD tests"

	--test-- "mold-1"
	--assert "[]" = mold []

	--test-- "mold-2"
	--assert "" = mold/only []

	--test-- "mold-3"
	--assert "[1 2 3]" = mold [1 2 3]

	--test-- "mold-4"
	--assert "1 2 3" = mold/only [1 2 3]

	--test-- "mold-5"
	--assert molded = mold blk

	--test-- "mold-6"
		repeat i 132 [
			--assert (copy/part molded i) = mold/part blk i
		]

	--test-- "mold-7"
	--assert "[a [b] c]" = mold [a [b] c]

===end-group===

===start-group=== "Basic FORM tests"

	--test-- "form-1"
	--assert "" = form []

	--test-- "form-2"
	--assert "1 2 3" = form [1 2 3]

	--test-- "form-3"
	--assert formed	= form blk

	--test-- "form-4"
	repeat i 132 [
		--assert (copy/part formed i) = form/part blk i
	]

	--test-- "form-5"
	--assert "a a" = form [[""] [a] [] [a] [[[]]]]

===end-group===

===start-group=== "mold strings"
	--test-- "mold-string-1"
	--assert {"abcde"} = mold {abcde}

	--test-- "mold-string-2"
	--assert {"^^(3A7)^^(3B1)^^(1FD6)^^(3C1)^^(3B5), ^^(3BA)^^(3CC)^^(3C3)^^(3BC)^^(3B5)"} = mold/all "Χαῖρε, κόσμε"

	--test-- "mold-string3 #issue 498"
	--assert {{""}} = mold mold {}

	--test-- "mold-string4"
	--assert {"abcde"} = mold "abcde"

	--test-- "mold-string5"
	--assert {"abc^^(2710)def"} = mold/all "abc✐def"

	--test-- "mold-string6"
	--assert {"abc^^(10000)def"} = mold/all "abc^(010000)def"

	--test-- "mold-string6"
		--assert {"目录1"} = mold "目录1"

	--test-- "mold-string7"
		--assert {"%e录1"} = mold "%e录1"

===end-group===

===start-group=== "logic"

	--test-- "mold-logic1"
	--assert "true" = mold true
	--assert "false" = mold false
	--assert "none" = mold none

===end-group===

===start-group=== "block"

	--test-- "mold-block1"
	--assert "[a b c d e]" = mold [a b c d e]
	--assert "[b c d e]" = mold next [a b c d e]
	--assert "[c d e]" = mold at [a b c d e ] 3
	--assert "[]" = mold tail [a b c d e]

===end-group===

===start-group=== "integer"

	--test-- "mold-integer1"
	--assert "1" = mold 1
	--assert "-1" = mold FFFFFFFFh
	--assert "2147483647" = mold 7FFFFFFFh
	--assert "-2147483648" = mold 80000000h
	--assert "0" = mold 00h

===end-group===

===start-group=== "file"

	--test-- "mold-file1"
		--assert "%目录1" = mold %目录1

	--test-- "mold-file2"
		--assert "%^^(76EE)^^(5F55)1" = mold/all %目录1

===end-group===

===start-group=== "mold/only"
	--test-- "mold/only-1 issue #458"
	--assert "a [b] c" = mold/only [a [b] c]
	--test-- "mold/only-2"
	--assert {"a"} = mold/only "a"
	--test-- "mold/only-3"
		a: 1
		b: 2
		c: 3
	--assert {3} = mold/only (a (b) c)
	--test-- "mold/only-4"
	--assert "a" = mold/only [a]
	--test-- "mold/only-5"
	--assert "a [b] c [d [e] f] g" = mold/only [a [b] c [d [e] f] g]
===end-group===

===start-group=== "mold/all"
	--test-- "mold/all-1"
		--assert  {"^^(76EE)^^(5F55)1"} = mold/all "目录1"
===end-group===

===start-group=== "dehex"
	--test-- "dehex-1"
		--assert  "a b" = dehex "a%20b"
	--test-- "dehex-2"
		--assert  "a%2目b" = dehex "a%2目b"
	--test-- "dehex-3"
		--assert  "a^@b" = dehex "a%00b"
	--test-- "dehex-4"
		--assert  "a%~b" = dehex "a%~b"
===end-group===

~~~end-file~~~

Red [
	Title:   "Red serialization (MOLD/FORM) test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %serialization-test.reds
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2012 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~~~ "serialization"

blk: [
	1 #[none] #[true] #[false] #"c" "red" Red a/b 'a/b :a/b a/b: (1 + 2)
	[a] [[[]]] [[[a]]] [c [d [b] e] f] :w 'w w: /w :word 'word word: /word
]

molded: {[1 none true false #"c" "red" Red a/b 'a/b :a/b a/b: (1 + 2) [a] [[[]]] [[[a]]] [c [d [b] e] f] :w 'w w: /w :word 'word word: /word]}
formed: {1 none true false c red Red a/b 'a/b :a/b a/b: 1 + 2 a a c d b e f w w w w word word word word}

===start-group=== "Basic MOLD tests"

	--test-- "mold-1"
	--assert "[]" = mold []

	--test-- "mold-2"
	--assert "" = mold/only []

	--test-- "mold-3"
	--assert "[1 2 3]" = mold [1 2 3]

	--test-- "mold-4"
	--assert "1 2 3" = mold/only [1 2 3]

	--test-- "mold-5"
	--assert molded = mold blk

	--test-- "mold-6"
		repeat i 132 [
			--assert (copy/part molded i) = mold/part blk i
		]

	--test-- "mold-7"
	--assert "[a [b] c]" = mold [a [b] c]

===end-group===

===start-group=== "Basic FORM tests"

	--test-- "form-1"
	--assert "" = form []

	--test-- "form-2"
	--assert "1 2 3" = form [1 2 3]

	--test-- "form-3"
	--assert formed	= form blk

	--test-- "form-4"
	repeat i 132 [
		--assert (copy/part formed i) = form/part blk i
	]

	--test-- "form-5"
	--assert "a a" = form [[""] [a] [] [a] [[[]]]]

===end-group===

===start-group=== "mold strings"
	--test-- "mold-string-1"
	--assert {"abcde"} = mold {abcde}

	--test-- "mold-string-2"
	--assert {"^^(3A7)^^(3B1)^^(1FD6)^^(3C1)^^(3B5), ^^(3BA)^^(3CC)^^(3C3)^^(3BC)^^(3B5)"} = mold/all "Χαῖρε, κόσμε"

	--test-- "mold-string3 #issue 498"
	--assert {{""}} = mold mold {}

	--test-- "mold-string4"
	--assert {"abcde"} = mold "abcde"

	--test-- "mold-string5"
	--assert {"abc^^(2710)def"} = mold/all "abc✐def"

	--test-- "mold-string6"
	--assert {"abc^^(10000)def"} = mold/all "abc^(010000)def"

	--test-- "mold-string6"
		--assert {"目录1"} = mold "目录1"

	--test-- "mold-string7"
		--assert {"%e录1"} = mold "%e录1"

===end-group===

===start-group=== "logic"

	--test-- "mold-logic1"
	--assert "true" = mold true
	--assert "false" = mold false
	--assert "none" = mold none

===end-group===

===start-group=== "block"

	--test-- "mold-block1"
	--assert "[a b c d e]" = mold [a b c d e]
	--assert "[b c d e]" = mold next [a b c d e]
	--assert "[c d e]" = mold at [a b c d e ] 3
	--assert "[]" = mold tail [a b c d e]

===end-group===

===start-group=== "integer"

	--test-- "mold-integer1"
	--assert "1" = mold 1
	--assert "-1" = mold FFFFFFFFh
	--assert "2147483647" = mold 7FFFFFFFh
	--assert "-2147483648" = mold 80000000h
	--assert "0" = mold 00h

===end-group===

===start-group=== "file"

	--test-- "mold-file1"
		--assert "%目录1" = mold %目录1

	--test-- "mold-file2"
		--assert "%^^(76EE)^^(5F55)1" = mold/all %目录1

===end-group===

===start-group=== "mold/only"
	--test-- "mold/only-1 issue #458"
	--assert "a [b] c" = mold/only [a [b] c]
	--test-- "mold/only-2"
	--assert {"a"} = mold/only "a"
	--test-- "mold/only-3"
		a: 1
		b: 2
		c: 3
	--assert {3} = mold/only (a (b) c)
	--test-- "mold/only-4"
	--assert "a" = mold/only [a]
	--test-- "mold/only-5"
	--assert "a [b] c [d [e] f] g" = mold/only [a [b] c [d [e] f] g]
===end-group===

===start-group=== "mold/all"
	--test-- "mold/all-1"
		--assert  {"^^(76EE)^^(5F55)1"} = mold/all "目录1"
===end-group===

~~~end-file~~~


FIX: updated all function class structures to match <spec> field from red-function!.

Red/System [
	Title:   "Alias definitions for datatype structures"
	Author:  "Nenad Rakocevic"
	File: 	 %structures.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/red-system/runtime/BSL-License.txt
	}
	Note: {
		Putting all aliases in this file for early inclusion in %red.reds solves
		cross-referencing issues in datatypes definitions.
	}
]

#define red-value!	cell!

red-datatype!: alias struct! [
	header 	[integer!]								;-- cell header
	value	[integer!]								;-- datatype ID
	_pad2	[integer!]
	_pad3	[integer!]
]

red-unset!: alias struct! [
	header 	[integer!]								;-- cell header only, no payload
	_pad1	[integer!]
	_pad2	[integer!]
	_pad3	[integer!]
]

red-none!: alias struct! [
	header 	[integer!]								;-- cell header only, no payload
	_pad1	[integer!]
	_pad2	[integer!]
	_pad3	[integer!]
]

red-logic!: alias struct! [
	header 	[integer!]								;-- cell header
	value	[logic!]								;-- 1: TRUE, 0: FALSE
	_pad1	[integer!]
	_pad2	[integer!]
]

red-series!: alias struct! [
	header 	[integer!]								;-- cell header
	head	[integer!]								;-- series's head index (zero-based)
	node	[node!]									;-- series node pointer
	_pad	[integer!]
]

red-block!: alias struct! [
	header 	[integer!]								;-- cell header
	head	[integer!]								;-- block's head index (zero-based)
	node	[node!]									;-- series node pointer
	_pad	[integer!]
]

red-paren!: alias struct! [
	header 	[integer!]								;-- cell header
	head	[integer!]								;-- paren's head index (zero-based)
	node	[node!]									;-- series node pointer
	_pad	[integer!]
]

red-path!: alias struct! [
	header 	[integer!]								;-- cell header
	head	[integer!]								;-- path's head index (zero-based)
	node	[node!]									;-- series node pointer
	_pad	[integer!]
]

red-lit-path!: alias struct! [
	header 	[integer!]								;-- cell header
	head	[integer!]								;-- path's head index (zero-based)
	node	[node!]									;-- series node pointer
	_pad	[integer!]
]

red-set-path!: alias struct! [
	header 	[integer!]								;-- cell header
	head	[integer!]								;-- path's head index (zero-based)
	node	[node!]									;-- series node pointer
	_pad	[integer!]
]

red-get-path!: alias struct! [
	header 	[integer!]								;-- cell header
	head	[integer!]								;-- path's head index (zero-based)
	node	[node!]									;-- series node pointer
	_pad	[integer!]
]

red-string!: alias struct! [
	header 	[integer!]								;-- cell header
	head	[integer!]								;-- string's head index (zero-based)
	node	[node!]									;-- series node pointer
	cache	[c-string!]								;-- UTF-8 cached version of the string (experimental)
]

red-file!: alias struct! [
	header 	[integer!]								;-- cell header
	head	[integer!]								;-- string's head index (zero-based)
	node	[node!]									;-- series node pointer
	cache	[c-string!]								;-- UTF-8 cached version of the string (experimental)
]

red-symbol!: alias struct! [
	header 	[integer!]								;-- cell header
	alias	[integer!]								;-- Alias symbol index
	node	[node!]									;-- string series node pointer
	cache	[c-string!]								;-- UTF-8 cached version of the string (experimental)
]

red-integer!: alias struct! [
	header 	[integer!]								;-- cell header
	padding	[integer!]								;-- align value on 64-bit boundary
	value	[integer!]								;-- 32-bit signed integer value
	_pad	[integer!]
]

red-context!: alias struct! [
	header 	[integer!]								;-- cell header
	symbols	[node!]									;-- array of symbols ID
	values	[node!]									;-- block of values (do not move this field!)
	self	[node!]									;-- indirect auto-reference (optimization)
]

red-object!: alias struct! [
	header 	[integer!]								;-- cell header
	ctx		[node!]									;-- context reference
	_pad1	[integer!]
	_pad2	[integer!]
]

red-word!: alias struct! [
	header 	[integer!]								;-- cell header
	ctx		[node!]									;-- context reference
	symbol	[integer!]								;-- index in symbol table
	index	[integer!]								;-- index in context
]

red-refinement!: alias struct! [
	header 	[integer!]								;-- cell header
	ctx		[node!]									;-- context reference
	symbol	[integer!]								;-- index in symbol table
	index	[integer!]								;-- index in context
]

red-char!: alias struct! [
	header 	[integer!]								;-- cell header
	_pad1	[integer!]
	value	[integer!]								;-- UCS-4 codepoint
	_pad2	[integer!]
]

red-action!: alias struct! [
	header 	[integer!]								;-- cell header
	symbols	[node!]									;-- action cleaned-up spec block reference
	spec	[node!]									;-- action spec block reference
	code	[integer!]								;-- native code function pointer
]

red-native!: alias struct! [
	header 	[integer!]								;-- cell header
	symbols	[node!]									;-- native cleaned-up spec block reference
	spec	[node!]									;-- native spec block reference
	code	[integer!]								;-- native code function pointer
]

red-op!: alias struct! [
	header 	[integer!]								;-- cell header
	symbols	[node!]									;-- op cleaned-up spec block reference
	spec	[node!]									;-- op spec block reference
	code	[integer!]								;-- native code function pointer
]

red-function!: alias struct! [
	header 	[integer!]								;-- cell header
	ctx		[node!]									;-- function's context
	spec	[node!]									;-- native spec block buffer reference
	more	[node!]									;-- additional members storage block:
	;	body	 [red-block!]						;-- 	function's body block
	;	symbols	 [red-block!]						;-- 	native cleaned-up spec block reference
	;	native   [node!]							;-- 	JIT-compiled body (binary!)
]

red-routine!: alias struct! [
	header 	[integer!]								;-- cell header
	symbols	[node!]									;-- routine cleaned-up spec block reference
	spec	[node!]									;-- routine spec block buffer reference
	more	[node!]									;-- additional members storage block:
	;	body	 [red-block!]						;-- 	routine's body block
	;	symbols	 [red-block!]						;-- 	routine cleaned-up spec block reference
	;	native   [node!]							;-- 	compiled body (binary!)
]

Red/System [
	Title:   "Alias definitions for datatype structures"
	Author:  "Nenad Rakocevic"
	File: 	 %structures.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/red-system/runtime/BSL-License.txt
	}
	Note: {
		Putting all aliases in this file for early inclusion in %red.reds solves
		cross-referencing issues in datatypes definitions.
	}
]

#define red-value!	cell!

red-datatype!: alias struct! [
	header 	[integer!]								;-- cell header
	value	[integer!]								;-- datatype ID
	_pad2	[integer!]
	_pad3	[integer!]
]

red-unset!: alias struct! [
	header 	[integer!]								;-- cell header only, no payload
	_pad1	[integer!]
	_pad2	[integer!]
	_pad3	[integer!]
]

red-none!: alias struct! [
	header 	[integer!]								;-- cell header only, no payload
	_pad1	[integer!]
	_pad2	[integer!]
	_pad3	[integer!]
]

red-logic!: alias struct! [
	header 	[integer!]								;-- cell header
	value	[logic!]								;-- 1: TRUE, 0: FALSE
	_pad1	[integer!]
	_pad2	[integer!]
]

red-series!: alias struct! [
	header 	[integer!]								;-- cell header
	head	[integer!]								;-- series's head index (zero-based)
	node	[node!]									;-- series node pointer
	_pad	[integer!]
]

red-block!: alias struct! [
	header 	[integer!]								;-- cell header
	head	[integer!]								;-- block's head index (zero-based)
	node	[node!]									;-- series node pointer
	_pad	[integer!]
]

red-paren!: alias struct! [
	header 	[integer!]								;-- cell header
	head	[integer!]								;-- paren's head index (zero-based)
	node	[node!]									;-- series node pointer
	_pad	[integer!]
]

red-path!: alias struct! [
	header 	[integer!]								;-- cell header
	head	[integer!]								;-- path's head index (zero-based)
	node	[node!]									;-- series node pointer
	_pad	[integer!]
]

red-lit-path!: alias struct! [
	header 	[integer!]								;-- cell header
	head	[integer!]								;-- path's head index (zero-based)
	node	[node!]									;-- series node pointer
	_pad	[integer!]
]

red-set-path!: alias struct! [
	header 	[integer!]								;-- cell header
	head	[integer!]								;-- path's head index (zero-based)
	node	[node!]									;-- series node pointer
	_pad	[integer!]
]

red-get-path!: alias struct! [
	header 	[integer!]								;-- cell header
	head	[integer!]								;-- path's head index (zero-based)
	node	[node!]									;-- series node pointer
	_pad	[integer!]
]

red-string!: alias struct! [
	header 	[integer!]								;-- cell header
	head	[integer!]								;-- string's head index (zero-based)
	node	[node!]									;-- series node pointer
	cache	[c-string!]								;-- UTF-8 cached version of the string (experimental)
]

red-file!: alias struct! [
	header 	[integer!]								;-- cell header
	head	[integer!]								;-- string's head index (zero-based)
	node	[node!]									;-- series node pointer
	cache	[c-string!]								;-- UTF-8 cached version of the string (experimental)
]

red-symbol!: alias struct! [
	header 	[integer!]								;-- cell header
	alias	[integer!]								;-- Alias symbol index
	node	[node!]									;-- string series node pointer
	cache	[c-string!]								;-- UTF-8 cached version of the string (experimental)
]

red-integer!: alias struct! [
	header 	[integer!]								;-- cell header
	padding	[integer!]								;-- align value on 64-bit boundary
	value	[integer!]								;-- 32-bit signed integer value
	_pad	[integer!]
]

red-context!: alias struct! [
	header 	[integer!]								;-- cell header
	symbols	[node!]									;-- array of symbols ID
	values	[node!]									;-- block of values (do not move this field!)
	self	[node!]									;-- indirect auto-reference (optimization)
]

red-object!: alias struct! [
	header 	[integer!]								;-- cell header
	ctx		[node!]									;-- context reference
	_pad1	[integer!]
	_pad2	[integer!]
]

red-word!: alias struct! [
	header 	[integer!]								;-- cell header
	ctx		[node!]									;-- context reference
	symbol	[integer!]								;-- index in symbol table
	index	[integer!]								;-- index in context
]

red-refinement!: alias struct! [
	header 	[integer!]								;-- cell header
	ctx		[node!]									;-- context reference
	symbol	[integer!]								;-- index in symbol table
	index	[integer!]								;-- index in context
]

red-char!: alias struct! [
	header 	[integer!]								;-- cell header
	_pad1	[integer!]
	value	[integer!]								;-- UCS-4 codepoint
	_pad2	[integer!]
]

red-action!: alias struct! [
	header 	[integer!]								;-- cell header
	spec	[node!]									;-- action spec block reference
	symbols	[node!]									;-- action cleaned-up spec block reference
	code	[integer!]								;-- native code function pointer
]

red-native!: alias struct! [
	header 	[integer!]								;-- cell header
	spec	[node!]									;-- native spec block reference
	symbols	[node!]									;-- native cleaned-up spec block reference
	code	[integer!]								;-- native code function pointer
]

red-op!: alias struct! [
	header 	[integer!]								;-- cell header
	spec	[node!]									;-- op spec block reference
	symbols	[node!]									;-- op cleaned-up spec block reference
	code	[integer!]								;-- native code function pointer
]

red-function!: alias struct! [
	header 	[integer!]								;-- cell header
	ctx		[node!]									;-- function's context
	spec	[node!]									;-- native spec block buffer reference
	more	[node!]									;-- additional members storage block:
	;	body	 [red-block!]						;-- 	function's body block
	;	symbols	 [red-block!]						;-- 	native cleaned-up spec block reference
	;	native   [node!]							;-- 	JIT-compiled body (binary!)
]

red-routine!: alias struct! [
	header 	[integer!]								;-- cell header
	spec	[node!]									;-- routine spec block buffer reference
	symbols	[node!]									;-- routine cleaned-up spec block reference
	more	[node!]									;-- additional members storage block:
	;	body	 [red-block!]						;-- 	routine's body block
	;	symbols	 [red-block!]						;-- 	routine cleaned-up spec block reference
	;	native   [node!]							;-- 	compiled body (binary!)
]