Add a start of a sketch of code to compile a set of rules into Lisp code...

%
% This is a start of a sketch of code to generate stuff that does
% bulk pattern matching.

% pl will be a list of rules ane here I will make the format
%   ((pattern1 replacement1) (pattern2 replacement2) ...)
% with no side-conditions. I am going to try a pretty simplistic
% scheme first. One serious issue is that if I followed this and
% applied it to a set of 2000 rewrites it would create a totally
% HUGE procedure that would be unmanagable. My idea for coping with that
% will be to use the unwinding into code for just the top few layers
% of the matching and when it has reduced things to at most a dozen (?)
% cases I will drop back to something that is in effet interpreted.

symbolic procedure compile_patterns pl;
  begin
% I will first dispatch on whether the pattern is atomic or not.
    scalar atomics, nonatomic;
    for each p in pl do
      if atom car p then atomics := p . atomics
      else nonatomics := p . nonatomics;
    atomics := reverse atomics;
    nonatomics := reverse nonatomics;
    if null atomics then return compile_nonatomics nonatomics
    else if null nonatomics then return compile_atomics atomics;
    return list('cond,
      list(list('atom, '!*arg!*), compile_atomics atomics, depth),
      list(t, compile_nonatomics nonatomics))
  end;

symbolic procedure compile_atomics pl;
  'cond . append(
     for each p in pl collect
       list(list('eq, !*arg!*, mkquote car p), cadr p),
     '(t 'failed));

symbolic procedure ordercar(a, b);
  orderp(car a, car b);

symbolic procedure compile_nonatomics pl;
% If I only have a "few" patterns left I will use a general purpose
% matching function that will look at each one at a time sequentially. I do
% this so I do not generate bulky in-line code for matching all the way down.
  if length pl < 7 list('matchfunction, mkquote p, '!*arg!*)
  else begin
    scalar u, v, w;
% I want to dispatch on all the various leading operators that are
% present in the list of patterns. I sort the list to bring equal operators
% together. Well this may be bad if the sort method used is not stable
% and if the order of rules matters.
    pl := sort(pl, function ordercar);
    u := caaar pl; % leading operator of first rule.
    while pl do <<
      while pl and u = caaar pl do <<
        v := car pl . v;
        pl := cdr pl >>;
      w := reverse v . w;
      v := nil;
      if pl then u := caaar pl >>;
% w should now be a list that separates out the cases according to their
% leading operators...
    return 'something
  end;

% Well this is where I will stop just now!

error: pathspec 'Rubi_Red/make-matcher.red' did not match any file(s) known to git


adding test

adding test

error: pathspec 'coffeefilte.red' did not match any file(s) known to git


Added oip shortcut to serve as example

Added oip shortcut to serve as example

error: pathspec 'WebTemplates/public_site_v1/s/oip/RedirectFromFolder.red' did not match any file(s) known to git


added sample_source_1.reds

added sample_source_1.reds

error: pathspec 'test/sample_source_1.reds' did not match any file(s) known to git


sudoku

sudoku

Red [
  url: https://www.codewars.com/kata/53db96041f1a7d32dc0004d2
]

row: function [board num] [
  copy/part skip board num - 1 * 9 9
]

column: function [board num] [
  extract (at board num) 9
]

region: function [board num] [
  x: num - 1 // 3 + 1
  y: (to-integer num - 1 / 3) * 3 + 1
  out: copy []
  foreach z reduce [y (y + 1) (y + 2)] [
    append out copy/part skip row board z (x - 1 * 3) 3
  ]
  out
]

valid?: function [blk] [
  repeat x 9 [
	pos: blk
	if pos: find blk x [
	  if find next pos x [return false]
	]
  ]
  true
]

done-or-not: function [board] [
  repeat x 9 [
	if not all [
	  valid? row board x
	  valid? column board x
	  valid? region board x
	] [return "Try again!"]
  ]
  "Finished!"
]

print done-or-not [5 3 4 6 7 8 9 1 2
                   6 7 2 1 9 5 3 4 8
                   1 9 8 3 4 2 5 6 7
                   8 5 9 7 6 1 4 2 3
                   4 2 6 8 5 3 7 9 1
                   7 1 3 9 2 4 8 5 6
                   9 6 1 5 3 7 2 8 4
                   2 8 7 4 1 9 6 3 5
                   3 4 5 2 8 6 1 7 9]

print done-or-not [5 3 4 6 7 8 9 1 2
                   6 7 2 1 9 0 3 4 9
                   1 0 0 3 4 2 5 6 0
                   8 5 9 7 6 1 0 2 0
                   4 2 6 8 5 3 7 9 1
                   7 1 3 9 2 4 8 5 6
                   9 0 1 5 3 7 2 1 4
                   2 8 7 4 1 9 6 3 5
                   3 0 0 4 8 1 1 7 9]

error: pathspec 'src/codingpuzzle/did-i-finish-my-sudoku.red' did not match any file(s) known to git


FIX: missing macosx.reds file

FIX: missing macosx.reds file

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
#define LIBC-file	"libc.dylib"

#define SA_SIGINFO   00000004h				;-- POSIX value?
#define SA_RESTART   10000000h				;-- POSIX value?

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

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

#include %BSD.reds

#if use-natives? = yes [
	prin: func [s [c-string!] return: [integer!]][
		write stdout s length? s
	]

	print: func [s [c-string!] return: [integer!]][
		prin s
		write stdout newline 1
	]
]

error: pathspec 'red-system/runtime/macosx.reds' did not match any file(s) known to git


forgot new warrior

forgot new warrior

;redcode-94
;name pdQscan
;author P.Kline
;assert CORESIZE == 8000

qM       equ    (6249+1)
qMod     equ    4249
ptScan   equ    8
ptDecode equ    51
ptLaunch equ    81
qStep    equ    (250/2-1)

qA      equ     ((qMod*(tA-qPtr))%CORESIZE+1)
qB      equ     ((qMod*(tB-qPtr))%CORESIZE+1)
qC      equ     ((qMod*(tC-qPtr))%CORESIZE+1)
qD      equ     ((qMod*(tD-qPtr))%CORESIZE+1)
qE      equ     ((qMod*(tE-qPtr))%CORESIZE+1)
qF      equ     ((qMod*(tF-qPtr))%CORESIZE+1)
qG      equ     ((qMod*(tG-qPtr))%CORESIZE+1)
qH      equ     ((qMod*(tH-qPtr))%CORESIZE+1)
qI      equ     ((qMod*(tI-qPtr))%CORESIZE+1)
qJ      equ     ((qMod*(tJ-qPtr))%CORESIZE+1)

tA       dat     tE           ,qA
tB       dat     1            ,qB
tC       dat     tF           ,qC
tD       dat     tJ           ,qD
bM       dat     0            ,-67
     for ptScan-CURLINE
         dat     0,0
     rof
qGo      sne     qPtr+qA*qM   ,qPtr+qA*qM+qStep
         seq     <tA          ,qPtr+(qA-1)*qM+qStep
         djn.a   decode       ,{tB
         sne     qPtr+qB*qM   ,qPtr+qB*qM+qStep
         seq     <tB          ,qPtr+(qB-1)*qM+qStep
         jmp     decode       ,{tB
         sne     qPtr+qC*qM   ,qPtr+qC*qM+qStep
         seq     <tC          ,qPtr+(qC-1)*qM+qStep
tE       jmp     decode       ,qE
         sne     qPtr+qD*qM   ,qPtr+qD*qM+qStep
         seq     <tD          ,qPtr+(qD-1)*qM+qStep
         jmp     decode       ,}tB

         sne     qPtr+qE*qM   ,qPtr+qE*qM+qStep
         seq     <tE          ,qPtr+(qE-1)*qM+qStep
         jmp     decode       ,{decode
         sne     qPtr+qF*qM   ,qPtr+qF*qM+qStep
         seq     <tF          ,qPtr+(qF-1)*qM+qStep
jJ       jmp     decode       ,}decode

         sne     qPtr+qG*qM   ,qPtr+qG*qM+qStep
         seq     <tG          ,qPtr+(qG-1)*qM+qStep
         jmp     decode-1     ,{pH
         sne     qPtr+qH*qM   ,qPtr+qH*qM+qStep
pH       seq     <tH          ,qPtr+(qH-1)*qM+qStep
tF       jmp     decode-1     ,qF
         sne     qPtr+qI*qM   ,qPtr+qI*qM+qStep
         seq     <tI          ,qPtr+(qI-1)*qM+qStep
         jmp     decode-1     ,}pH

         sne     qPtr+qJ*qM   ,qPtr+qJ*qM+qStep
         seq     <tJ          ,qPtr+(qJ-1)*qM+qStep
         jmp     jJ           ,}decode
tJ       jmp     pGo          ,qJ
     for ptDecode-CURLINE
         dat     0,0
     rof
         mov.a   #pH-decode   ,decode
decode   mul.b   *tB          ,qPtr
         sne     null         ,@qPtr
         add.ab  #qStep       ,qPtr
         mov     bM           ,@qPtr
qPtr     mov     bM           ,@qM
         add.ab  #6           ,qPtr
         djn.b   -3           ,#16
         jmp     pGo
     for ptLaunch-CURLINE
         dat     0,0
     rof
pStep    equ     (7*3754)
pStep2   equ     (1303+7*1021)
pGo      mov     <pCopy       ,{pCopy
tG       spl     2            ,qG
tH       spl     1            ,qH
tI       spl     1            ,qI
         mov     <pCopy       ,{pCopy
pCopy    spl     1+7+4000     ,1+7
         mov     <1           ,{1
         spl     2000+7       ,7
pPap     spl     @0           ,>pStep
         mov     }pPap        ,>pPap
         mov     {pPap        ,<1
         spl     @0           ,>pStep2
         mov.i   #6000-1-2667 ,}2667
         mov.i   >0           ,}0

null     dat     0            ,0
         end     qGo

error: pathspec 'etc/warriors/koth/pdqscan.red' did not match any file(s) known to git


reverse-a-number

reverse-a-number

Red [
  url: http://www.codewars.com/kata/reverse-a-number
]

reverse-number: function [n] [
  s: to-string n
  either (first s) = #"-" [reverse next s] [reverse s]
  to-integer s
]

probe reverse-number 123
probe reverse-number -456
probe reverse-number 1000

error: pathspec 'src/codingpuzzle/reverse-a-number.red' did not match any file(s) known to git


Illustration of using Reduce to check a constrains after pattern matching!

lisp;
on echo;

% Here is one of the constrainsts from test case #1:

constraint := '(!Zero!Q (plus (times n (plus p 1)) 1));

% Here are the bindings that emerge from pattern-patching:

bindings := '((x . z) (p . -2) (n . 1) (x . z) (b . v) (a . u));

% Substitute in...

form := subla(bindings, cadr constraint);

% Get Reduce to simplify the expression, returning a "standrad quotient"
% which has the numerator as its car and denominator as its cdr. A
% numerator that is nil will denote a polynomial with no terms in it, ie
% the value zero...

sq := simp form;

% The proper way to check for zero...

null numr sq;

% ... and just to confirm, here is a conversion from the SQ back into
% prefix notation.

prepsq sq;

end;

error: pathspec 'Rubi_Red/demo.red' did not match any file(s) known to git


roman

roman

Red [
   Url: http://www.codewars.com/kata/roman-numerals-encoder
]

roman-numerals: [
  M  1000
  CM 900
  D  500
  CD 400
  C  100
  XC 90
  L  50
  XL 40
  X  10
  IX 9
  V  5
  IV 4
  I  1
]

solution: function [n] [
  s: copy []
  foreach [a b] roman-numerals [
    while [n >= b] [
      append s a
      n: n - b
    ]
  ]
  to-string s
]

print "I" = solution 1
print "IV" = solution 4
print "VI" = solution 6
print "XIV" = solution 14
print "XXI" = solution 21
print "LXXXIX" = solution 89
print "XCI" = solution 91
print "CMLXXXIV" = solution 984
print "M" = solution 1000
print "MDCCCLXXXIX" = solution 1889
print "MCMLXXXIX" = solution 1989

error: pathspec 'src/codingpuzzle/roman-numerals-encoder.red' did not match any file(s) known to git


Add definitions for POSIX signal numbers.

Red/System [
	Title:  "Red/System POSIX signal number definitions"
	Author: "Richard Nyberg"
	File:   %POSIX-signals.reds
	Tabs:   4
	Rights: "Copyright (C) 2014 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
	}
]
;; sources:
;;  http://fxr.watson.org/fxr/source/include/uapi/asm-generic/siginfo.h?v=linux-2.6;im=excerpts
;;  http://fxr.watson.org/fxr/source/sys/signal.h?v=FREEBSD10
;;  http://fxr.watson.org/fxr/source/bsd/sys/signal.h?v=xnu-1456.1.26;im=excerpts

#define SIGBUS [                            ;-- Bus access error
	#switch OS [MacOSX [10] FreeBSD [10] #default [7]]
]
#define SIGILL       4                      ;-- Illegal instruction
#define SIGFPE       8                      ;-- Floating point error
#define SIGSEGV     11                      ;-- Segmentation violation

#define SA_SIGINFO   [#switch OS [MacOSX [0040h] FreeBSD [0040h] #default [00000004h]]]
#define SA_RESTART   [#switch OS [MacOSX [0002h] FreeBSD [0002h] #default [10000000h]]]

#define ILL_ILLOPC   1
#define ILL_ILLOPN   [#switch OS [MacOSX [4] #default [2]]]
#define ILL_ILLADR   [#switch OS [MacOSX [5] #default [3]]]
#define ILL_ILLTRP   [#switch OS [MacOSX [2] #default [4]]]
#define ILL_PRVOPC   [#switch OS [MacOSX [3] #default [5]]]
#define ILL_PRVREG   6
#define ILL_COPROC   7
#define ILL_BADSTK   8

#define BUS_ADRALN   1
#define BUS_ADRERR   2
#define BUS_OBJERR   3
#define BUS_MCERR_AR 4                      ;-- Linux based systems only
#define BUS_MCERR_AO 5                      ;-- Linux based systems only

#define SEGV_MAPERR  1
#define SEGV_ACCERR  2

#define FPE_INTDIV   [#switch OS [MacOSX [7] FreeBSD [2] #default [1]]]
#define FPE_INTOVF   [#switch OS [MacOSX [8] FreeBSD [1] #default [2]]]
#define FPE_FLTDIV   [#switch OS [MacOSX [1] #default [3]]]
#define FPE_FLTOVF   [#switch OS [MacOSX [2] #default [4]]]
#define FPE_FLTUND   [#switch OS [MacOSX [3] #default [5]]]
#define FPE_FLTRES   [#switch OS [MacOSX [4] #default [6]]]
#define FPE_FLTINV   [#switch OS [MacOSX [5] #default [7]]]
#define FPE_FLTSUB   [#switch OS [MacOSX [6] #default [8]]]

error: pathspec 'system/runtime/POSIX-signals.reds' did not match any file(s) known to git


TESTS: added two bitset tests

TESTS: added two bitset tests

Red [
	Title:   "Red local contexts binding test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %bitset-test.red
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2013 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~~~ "bitset"

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

	--test-- "basic-bitset-1"
		bb-1-bs: make bitset! [0 1 2 3[
		--assert true = pick bb-1-bs 1
		--assert true = pick bb-1-bs 2
		--assert true = pick bb-1-bs 3
		--assert true = pick bb-1-bs 4
		--assert false = pick bb-1-bs 5
		--assert false = pick bb-1-bs 256
		--assert false = pick bb-1-bs 257
		--assert false = pick bb-1-bs 2147483647
		--assert false = pick bb-1-bs 2147483648

===end-group===

===start-group=== "poke"

	--test "poke-1"
		p-1-bs: make bitset! [0 1 2 3]
		poke p-1-bs 5 true
		--assert true = pick p-1-bs 1
		--assert true = pick p-1-bs 2
		--assert true = pick p-1-bs 3
		--assert true = pick p-1-bs 4
		--assert true = pick p-1-bs 5
		--assert false = pick p-1-bs 6

===end-group===

~~~end-file~~~

error: pathspec 'red/tests/source/units/bitset-test.red' did not match any file(s) known to git


TESTS: started object-test.red, it will not be added to run-all until there is compiler support for objects

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
do [								;-- temp until object! support in compiler
~~~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"

===end-group===

~~~end-file~~~

]								;-- temp until object! support in compiler

error: pathspec 'tests/source/units/object-test.red' did not match any file(s) known to git


digit-degree

digit-degree

Red [
  problem: {Let's define digit degree of some positive integer as the number of times we need to replace this number with the sum of its digits until we get to a one digit number.

            Given an integer, find its digit degree.

            Example

            For n = 5, the output should be
            digitDegree(n) = 0;
            For n = 100, the output should be
            digitDegree(n) = 1.
            1 + 0 + 0 = 1.
            For n = 91, the output should be
            digitDegree(n) = 2.
            9 + 1 = 10 -> 1 + 0 = 1.}
  ]

digit-degree: function [n] [
  steps: sum-digits: 0
  while [n >= 10] [
    sum-digits: sum-digits + n % 10
    n: n / 10
    if n < 10 [
      n: sum-digits + n
      sum-digits: 0
      steps: steps + 1
    ]
  ]
  steps
]

print digit-degree 5
print digit-degree 100
print digit-degree 91
print digit-degree 99

error: pathspec 'src/codingpuzzle/digit-degree.red' did not match any file(s) known to git


TESTS: added basic routine tests

TESTS: added basic routine tests

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

===start-group=== "routine return tests"

	--test-- "rr1"
		rr1-r: routine [
			return:		[integer!]
		][
			1
		]
	--assert 1 = rr1-r
comment { ***access violation***
	--test-- "rr2"
		rr2-r: routine [
			return:		[block!]
		][
			blk: declare red-block!
			blk: red/block/make-at blk 3
			blk: red/block/rs-append blk as red-value! as red-integer! 1
			blk: red/block/rs-append blk as red-value! as red-integer! 2
			blk: red/block/rs-append blk as red-value! as red-integer! 3
			blk
		]
	--assert [1 2 3] = rr2-r
}
	--test-- "rr3"
		rr3-r: routine [
			return:			[char!]
		][
			as red-char! 10000h
		]
	--assert #"^(10000)" = rr3-r

	--test-- "rr4"
		rr4-r: routine [
			return:			[logic!]
		][
			true
		]
	--assert rr4-r

	--test-- "rr5"
		rr5-r: routine [
			return:			[none!]
		][
			n: declare red-none!
			n
		]
	--assert none = rr5-r

comment { ***access violation***
	--test-- "rr6"
		rr6-r: routine [
			return:			[string!]
		][
			s: red/string/load "abcde^(E2)^(9C)^(90)é^(F0)^(90)^(80)^(80)" 20
			s
		]
	--assert "abcde^(2710)é^(010000)" = rr6-r
}

	--test-- "rr7"
		rr7-r: routine [
			return:			[unset!]
		][
			u: declare red-unset!
			u
		]
		--assert (prin "") = rr5-r

===end-group===

===start-group=== "routine yo-yo tests"

	--test-- "ry1"
		ry1-r: routine [
			i			[integer!]
			return:		[integer!]
		][
			i
		]
	--assert 1 = ry1-r 1

	--test-- "ry2"
		ry2-r: routine [
			b			[block!]
			return:		[block!]
		][
			b
		]
	--assert [1 2 3] = ry2-r [1 2 3]

	--test-- "ry3"
		ry3-r: routine [
			c				[char!]
			return:			[char!]
		][
			c
		]
	--assert #"^(10000)" = ry3-r #"^(10000)"

	--test-- "ry4"
		ry4-r: routine [
			l				[logic!]
			return:			[logic!]
		][
			l
		]
	--assert ry4-r true
	--assert not ry4-r false

	--test-- "ry5"
		ry5-r: routine [
			n				[none!]
			return:			[none!]
		][
			n
		]
	--assert none = ry5-r none

	--test-- "ry6"
		ry6-r: routine [
			s				[string!]
			return:			[string!]
		][
			s
		]
	--assert "abcde^(2710)é^(010000)" = ry6-r "abcde^(2710)é^(010000)"

	--test-- "ry7"
		ry7-r: routine [
			u				[unset!]
			return:			[unset!]
		][
			u
		]
		--assert (prin "") = ry7-r prin ""

===end-group===

~~~end-file~~~

error: pathspec 'red/tests/source/units/routine-test.red' did not match any file(s) known to git


added example in Red language

added example in Red language

Red [
    Title: "Simple hello world script"
]

print "Hello, World."

error: pathspec 'hello-red/hello-world.red' did not match any file(s) known to git


TESTS: added initial case-test.reds

TESTS: added initial case-test.reds

Red/System [
	Title:   "Red/System case function test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %case-test.reds
	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.reds

~~~start-file~~~ "case"

===start-group=== "case integer!"

#define case-int-1-code "case [ ci = 1 [1] ci = 2 [2] true [3]]"

	--test-- "case-int-1"
	  ci: 1
	--assert 1 = case [ ci = 1 [1] ci = 2 [2] true [3]]

	--test-- "case-int-2"
	  ci: 1
	  cr: case [
	    ci = 1 [1]
	    ci = 2 [2]
	    true [3]
	  ]
	--assert 1 = cr

	--test-- "case-int-3"
	  ci: 2
	--assert 2 = case [ ci = 1 [1] ci = 2 [2] true [3]]

	--test-- "case-int-4"
	  ci: 2
	  cr: case [
	    ci = 1 [1]
	    ci = 2 [2]
	    true [3]
	  ]
	--assert 2 = cr

	--test-- "case-int-5"
	  ci: 3
	--assert 3 = case [ ci = 1 [1] ci = 2 [2] true [3]]

	--test-- "case-int-6"
	  ci: 3
	  cr: case [
	    ci = 1 [1]
	    ci = 2 [2]
	    true [3]
	  ]
	--assert 3 = cr

	--test-- "case-int-7"
	  ci: 10
	--assert 3 = case [ ci = 1 [1] ci = 2 [2] true [3]]

	--test-- "case-int-2"
	  ci: 10
	  cr: case [
	    ci = 1 [1]
	    ci = 2 [2]
	    true [3]
	  ]
	--assert 3 = cr

===end-group===

~~~end-file~~~

error: pathspec 'red-system/tests/source/units/case-test.reds' did not match any file(s) known to git


FIX: missing file for Windows driver support.

Red/System [
	Title:   "Red/System Win32 runtime"
	Author:  "Nenad Rakocevic"
	File: 	 %win32.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
	}
]

#define OS_TYPE		1

;-- source: http://msdn.microsoft.com/en-us/library/windows/hardware/ff544113(v=vs.85).aspx

driver-object!: alias struct! [
	;@@ To be filled
	dummy [integer!] ;@@ just for the struct to be compilable
]

***-drv-entry-point: func [
	[callback]
	DriverObject [driver-object!]
	RegistryPath [byte-ptr!]					;-- Unicode string (UTF-16LE)
	return: [integer!]
][
	***-main
	#if target = 'IA-32 [
		x87-cword: system/fpu/control-word 		;-- save previous x87 control word
		system/fpu/init							;-- reset x87 state (@@ probably not safe for host program...)
		system/fpu/control-word: 0322h			;-- default control word: division by zero,
												;-- underflow and overflow raise exceptions.
		system/fpu/update
	]
	on-load DriverObject RegistryPath			;-- user code, must return a NTSTATUS value!
]

error: pathspec 'red-system/runtime/win32-driver.reds' did not match any file(s) known to git


RED file for C10

RED file for C10

{include %bin%\%REDNAME%}

[Common]
*.ico = .\resources; .\resources\tiles
*.bmp = .\resources; .\resources\tiles
*.clw = _classes
*.inc = _classes

error: pathspec 'Clarion100.red' did not match any file(s) known to git


interviewcake

interviewcake

Red [
  Url: https://www.interviewcake.com/question/ruby/recursive-str-permutations
]

permutations: function [str] [
  l: length? str
  either l = 1 [
    reduce [str]
  ] [
    sub-str: copy/part str l - 1
    c: last str

    result: copy []
    foreach s permutations sub-str [
      forall s [
        append result copy head insert s c
        remove s
      ]
      append result append s c
    ]

    result
  ]
]

probe permutations "cats"

error: pathspec 'src/interviewcake/recursive-string-permutations.red' did not match any file(s) known to git


picking-numbers

picking-numbers

Red [
  url: https://www.hackerrank.com/challenges/picking-numbers/problem
]

picking-numbers: function [a] [
  sort a
  p: copy reduce [first a none]
  len: copy [1 0]
  max-len: 1
  foreach i next a [
    switch/default i - p/1 [
      0 [len/1: len/1 + 1]
      1 [len/2: len/2 + 1 p/2: i]
    ] [
      max-len: max len/1 + len/2 max-len
      either all [p/2 i - p/2 = 1] [
        p/1: p/2 p/2: i
        len/1: len/2 len/2: 1
      ] [
        p/1: i p/2: none
        len/1: 1 len/2: 0
      ]
    ]
  ]
  max len/1 + len/2 max-len
]

print 4 = picking-numbers [1 2 2 3 3]
print 5 = picking-numbers [1 1 2 2 4 4 5 5 5]
print 3 = picking-numbers [4 6 5 3 3 1]
print 5 = picking-numbers [1 2 2 3 1 2]

error: pathspec 'src/codingpuzzle/picking-numbers.red' did not match any file(s) known to git


TESTS: start of lexer-test.red

TESTS: start of lexer-test.red

Red [
	Title:		"Red lexer test"
	Author:		"Peter W A Wood"
	File:		%print-test.red
	Tabs:		4
	Rights:		"Copyright (C) 2014 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
#include %../../../lexer.red

~~~start-file~~~ "lexer"

===start-group=== "transcode with none"

	--test-- "trans1"
		--assert [Red[] 1] = transcode {Red[] 1} none

	--test-- "trans2"
		--assert [Red[] a: 1] = transcode {Red[] a: 1} none

===end-group===

===start-group=== "literal values"

	--test-- "litval-integer1" --assert [1] = transcode {1} none
	--test-- "litval-integer2" --assert [+1] = transcode {+1} none
	--test-- "litval-integer3" --assert [-1] = transcode {-1} none
	--test-- "litval-integer4" --assert [0] = transcode {0} none
	--test-- "litval-integer5" --assert [+0] = transcode {+0} none
	--test-- "litval-integer6" --assert [0] = transcode {-0} none
	--test-- "litval-integer7" --assert 0 = -0
	--test-- "litval-integer8"
		--assert [2147483647] = transcode {2147483647} none
	--test-- "litval-integer9"
		--assert [-2147483648] = transcode {-2147483648} none
	--test-- "litval-integer10" --assert [01h] = transcode {01h} none
	--test-- "litval-integer11" --assert [00h] = transcode {00h} none
	--test-- "litval-integer12" --assert [-1] = transcode {FFFFFFFFh} none
	--test-- "litval-integer13"
		--assert [2147483647] = transcode {7FFFFFFFh} none
	--test-- "litval-integer14"
		--assert [-2147483648] = transcode {80000000h} none

===end-group===

	;print: :store-print

~~~end-file~~~

error: pathspec 'tests/source/compiler/lexer-test.red' did not match any file(s) known to git


Added red-example doc

Added red-example doc

Red [
	Author: "Toomas Vooglaid"
	Date: 7-9-2017
]
context [
	mtx: object [
		rows: cols: data: none
		get-col: func [col][extract at data col cols]
		get-row: func [row][copy/part at data row - 1 * cols + 1 cols]
		get-idx: func [row col][pick data row - 1 * cols + col]
		to-float: does [forall data [data/1: system/words/to-float data/1]]
		swap-dim: does [c: cols cols: rows rows: c]
		transpose: has [d i j r c][
			d: copy []
			repeat i cols [repeat j rows [append d get-idx j i]]
			swap-dim
			data: d
			self
		]
		rotate: func [n [integer!] /local d i][
			d: copy []
			switch n [
				1 [repeat i cols [append d copy reverse get-col i] swap-dim]
				2 [repeat i rows [append d reverse copy get-row rows + 1 - i]]
				3 [repeat i cols [append d copy get-col cols + 1 - i] swap-dim]
			]
			data: d
			self
		]
		show: does [new-line/skip copy data true]
		pretty: function [/bar][;[/local d i col-lengths][
			col-lengths: copy []
			repeat i cols [
				c: copy get-col i
				c: sort/compare c func [a b][(length? form a) > (length? form b)]
				append col-lengths length? form first c
			]
			cols2: copy []
			templ: copy []
			letters: "abcdefghijklmnopqrstuvwyz"
			repeat n cols [
				append cols2 to-word pick letters n
				append templ compose [
					pad/left (to-word pick letters n) (pick col-lengths n) (either bar and (n < cols) ["|"][""])
				]
			]
			print "^/"
			foreach (cols2) data [
				print compose templ
			]
			print "^/"
		]
	]
	add: func [op m1 m2][
		either all [m1/cols = m2/cols m1/rows = m2/rows][;length? m1/data length? m2/data [
			repeat i length? m1/data [m1/data/:i: m1/data/:i op m2/data/:i]
		][
			cause-error 'user 'message ["Matrices of unequal dimensions!"]
		]
		m1
	]
	multi: func [m1 m2 /local m3 val i j k l][
		either equal? l: m1/cols m2/rows [
			m3: make mtx [rows: m1/rows cols: m2/cols data: make block! (m1/rows * m2/cols)]
			repeat i m1/rows [
				repeat j m2/cols [
					val: 0
					repeat k l [val: (m1/get-idx i k) * (m2/get-idx k j) + val]
					append m3/data val
				]
			]
		][
			cause-error 'user 'message ["Dimensions don't match in multiplication!"]
		]
		m3
	]
	kronecker: func [m1 m2 /local m3 i j k l][
		m3: make mtx [rows: m1/rows * m2/rows cols: m1/cols * m2/cols data: make block! rows * cols]
		repeat i m1/rows [
			repeat j m2/rows [
				repeat k m1/cols [
					repeat l m2/cols [
						append m3/data (m1/get-idx i k) * (m2/get-idx j l)
		]]]]
		m3
	]
	transpose: func [m /local d i j r c][
		d: copy []
		repeat i c: m/cols [repeat j r: m/rows [append d m/get-idx j i]]
		m/cols: r m/rows: c	m/data: d
		m
	]
	rotate: func [n [integer!] m /local data i][
		data: copy []
		switch n [
			1 [repeat i m/cols [append data copy reverse m/get-col i] m/swap-dim]
			2 [repeat i m/rows [append data reverse copy m/get-row m/rows + 1 - i]]
			3 [repeat i m/cols [append data copy m/get-col m/cols + 1 - i] m/swap-dim]
		]
		m/data: data
		m
	]
	ops-rule: ['+ | '- | '* | '/ | '% | '** | '>> | '<< | '>>> | 'and | 'or | 'xor | 'div | 'x]
	set 'matrix func [spec /local rule result m w m1 m2 op op' var vars ops unary matrices][
		vars: copy [] ops: copy [] matrices: copy []
		matrix-rule: [[
			set dim pair! [set mdata block! | set w word! if (block? get/any w)(mdata: get w)]
			(either (dim/1 * dim/2) = length? mdata: reduce mdata [
				m: make mtx [rows: dim/1 cols: dim/2 data: mdata]
			][
				cause-error 'user 'message ["Data length does not match dimensions!"]
			]
			)
		|	set w word! if (object? get/any w)(set w m: make mtx get w)
		| 	set m number!
		]	(insert matrices m)]

		parse spec rule: [(m: none)[some [
			ahead paren! into rule
		|	set var set-word! (insert vars var) rule (var: take vars set var copy matrices/1)
		|	set unary ['transpose | 'rotate set n integer! | 'invert] rule (
				switch/default unary [
					rotate [self/rotate n matrices/1]
				][
					self/:unary matrices/1
				]
			)
		|	set op' ops-rule (insert ops op') [matrix-rule | ahead paren! into rule] (
				op': take ops set [m2 m1] take/part matrices 2
				case [
					op' = 'div [op: :/ either number? m1 [m1: to-float m1][m1/to-float]]
					op' = 'x []
					true [op: get op']
				]
				case [
					all [number? reduce m1 number? reduce m2] [m1: (reduce m1) op reduce m2]
					number? reduce m1 [data: m2/data forall data [data/1: (reduce m1) op data/1] m1: m2]
					number? reduce m2 [data: m1/data forall data [data/1: data/1 op reduce m2]]
					true [case [
						find exclude ops-rule ['x] op' [m1: self/add :op m1 m2]
						(same? op' 'x) or same? op' '× [m1: self/multi m1 m2]
						same? op' 'X [m1: self/kronecker m1 m2]
					]]
				]
				insert matrices m1
			)
		|	matrix-rule
		|	s: print ["No rule applied at: " :s]
		]]]
		either number? m1: take matrices [m1][new-line/skip copy m1/data true m1/cols]
	]
]

error: pathspec 'demo/kitchen-sink/docs/red.red' did not match any file(s) known to git


[MCPP-3] Added the first red test for rule 0-1-7. This test does not currently pass, as the checker is not yet implemented.

Signed-off-by: Matthew P. Del Buono <6a56c40a70dde98ab256c4d75e3232986adf3ef6@gmail.com>

int foo()
{
   return 0;
}

void bar()
{
   foo(); // non-compliant: 0-1-7
}

error: pathspec 'tests/0-1-7/IntDiscard.red' did not match any file(s) known to git


recipes-extra-data/dbus_0.91.red: add extra data for the dbus recipe

Apply patch and bump PR.

Signed-off-by: Mario Domenech Goulart <addb47291ee169f330801ce73520b96f2eaf20ea@ossystems.com.br>

PR = "r1"

SRC_URI += "file://ossystems-changes.patch"

error: pathspec 'scripts/recipes-extra-data/dbus_0.91.red' did not match any file(s) known to git


mini test with an empty production

mini test with an empty production

lisp;

in "lalr.red"$ in "yylex.red"$ in "yyparse.red"$ in "genparser.red"$
in "genparserprint.red"$

nil_grammar := '(
  (s  (("a" bb "c")))
  (bb (())
      (("b")))
);

parser := lalr_create_parser (nil, nil_grammar);

end;

error: pathspec 'lalr/test_grammar_nullproduction.red' did not match any file(s) known to git


day10

Red [
  Url: https://adventofcode.com/2017/day/10
]

input-length: 256

input: []
repeat i input-length [append input i - 1]

lengths: split read %../../resources/2017/day10 ","
forall lengths [change lengths to-integer lengths/1]

skip-size: 0

knot-hash: func [lengths] [
  foreach len lengths [
    idx: index? input

    sublist: copy []
    loop len [
      append sublist input/1
      if tail? input: next input [input: head input]
    ]

    reverse sublist

    input: skip head input idx - 1

    forall sublist [
      change input sublist/1
      if tail? input: next input [input: head input]
    ]

    skip-size: skip-size // input-length
    loop skip-size [
      if tail? input: next input [input: head input]
    ]

    skip-size: skip-size + 1
  ]
]

knot-hash lengths

input: head input

print input/1 * input/2
; 6909

;--- Part Two ---
clear input
clear lengths
skip-size: 0

repeat i input-length [append input i - 1]

s: read %../../resources/2017/day10
forall s [append lengths to-integer s/1]
append lengths [17 31 73 47 23]

loop 64 [
  knot-hash lengths
]

input: head input

dense-hash: []
loop 16 [
  sub: copy/part input 16
  a: 0
  forall sub [a: a xor sub/1]
  append dense-hash a

  input: skip input 16
]

forall dense-hash [
  change dense-hash lowercase form to-hex/size dense-hash/1 2
]

print rejoin dense-hash
; 9d5f4561367d379cfbf04f8c471c0095

error: pathspec 'src/aoc17-red/day10.red' did not match any file(s) known to git


stop-gninnips-my-sdrow

stop-gninnips-my-sdrow

Red [
  url: https://www.codewars.com/kata/stop-gninnips-my-sdrow
]

parser: context [
  letters: charset [#"a" - #"z" #"A" - #"Z"]
  word:    [some letters]

  spin-words: function [s] [
    parse s [
      some [pos1: word pos2: (l: (index? pos2) - (index? pos1)
                              if l >= 5 [
                                sub: copy/part pos1 l
                                change pos1 reverse sub
                              ])
            | space]
    ]
  ]
]

s: "Hey fellow warriors"
parser/spin-words s
print s = "Hey wollef sroirraw"

s: "This is a test"
parser/spin-words s
print s = "This is a test"

s: "This is another test"
parser/spin-words s
print s = "This is rehtona test"

error: pathspec 'src/codingpuzzle/stop-gninnips-my-sdrow.red' did not match any file(s) known to git


Added Tim's red uncommons

Added Tim's red uncommons

2 Act of Aggression
1 Act of Aggression (Foil)
3 Act of Treason
1 Akoum Boulderfoot
2 Arc Trail
2 Barrage Ogre
4 Bloodshot Trainee
4 Deathforge Shaman
4 Dragon Whelp
2 Earth Servant
2 Ember Hauler
2 Embersmith
3 Explosive Revelation
1 Fallen Ferromancer
1 Fire Servant
4 Fireball
1 Flaring Flame-kin
2 Forked Bolt
3 Furnace Celebration
1 Geosurge
3 Goblin Artillery
1 Goblin Ruinblaster
1 Goblin Ruinblaster (Foil)
2 Gut Shot
2 Hellfire Mongrel
1 Ignite Disorder
3 Jund Battlemage
1 Lust for War
1 Mark of Mutiny
4 Ogre Geargrabber
2 Oxidda Scrapmelter
2 Priest of Urabrask
5 Prodigal Pyromancer
3 Punishing Fire
1 Quest for the Goblin Lord
1 Quest for Pure Flame
2 Rapacious One
1 Ricochet Trap
3 Rumbling Aftershocks
2 Runeflare Trap
3 Slavering Nulls
2 Soulsurge Elemental
1 Surreal Memoir
1 Thunder-Thrash Elder
1 Thunderscape Battlemage
1 Tormentor Exarch
1 Tuktuk Scrapper
1 Unstable Footing
3 Valakut Fireboar
1 Vulshok Refugee
3 Whipflare

error: pathspec 'tim.uncommon.red' did not match any file(s) known to git


TESTS: added case-folding-test.red

TESTS: added case-folding-test.red

Red [
	Title:   "Red case folding test script"
	Author:  "Peter W A Wood"
	File: 	 %case-folding-test.red
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2015 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

do-fold: func [lower upper] [
	test-number: 0												;; no copy on purpose
	test-number: test-number + 1
	--test-- append "case-folding-" test-number
		--assert lower = upper
		--assert equal? lower upper
		--assert equal? uppercase lower upper
		--assert upper = uppercase lower
		--assert equal? lower lowercase upper
		--assert lower = lowercase upper
]

dont-fold: func [lower upper] [
	test-number: 0												;; no copy on purpose
	test-number: test-number + 1
	--test-- append "not-case-folding-" test-number
		--assert lower <> upper
		--assert not equal? lower upper
		--assert not equal? uppercase lower upper
		--assert upper <> uppercase lower
		--assert not equal? lower lowercase upper
		--assert lower <> lowercase upper
]

~~~start-file~~~ "case-folding"

===start-group=== "case-folding"

	do-fold "abcde" "ABCDE"
	do-fold "Abcde"	"ABCDE"
	do-fold "ba^(FB04)e" "BA^(FB04)E"
	do-fold "cant^(F9)" "CANT^(D9)"
	do-fold "cantu^(0300)" "CANTU^(0300)"
	do-fold "stra^(DF)e" "STRA^(1E9E)E"
	do-fold "i" "I"
	do-fold "^(0149)" "^(0149)"
	do-fold "^(03B0)" "^(03B0)"
	do-fold "^(0587)" "^(0587)"
	do-fold "^(1E96)" "^(1E96)"
	do-fold "^(1F80)" "^(1F80)"
	do-fold "^(1FBC)" "^(1FB3)"
	do-fold "^(1FBE)" "^(03B9)"
	do-fold "^(1FFC)" "^(1FF3)"
	do-fold "^(2126)" "^(03C9)"
	do-fold "^(2163)" "^(2173)"
	do-fold "^(00CE)" "^(00EE)"
	do-fold "^(0100)" "^(0101)"
	do-fold "^(017F)" "^(0073)"

===end-group===

===start-group=== "not-case-folding"

	dont-fold "ba^(FB04)e" "BAFFLE"
	dont-fold "stra^(DF)e" "STRASSE"
	dont-fold "weiss" "wie^(DF)"
	dont-fold "i" "^(0130)"
	dont-fold "^(0131)" "I"
	dont-fold "^(0149)" "^(02BC)^(6E)"
	dont-fold "^(03B0)" "^(03C5)^(0308)^(0301)"
	dont-fold "^(0587)" "^(0565)^(0582)"
	dont-fold "^(1E96)" "^(68)^(0331)"
	dont-fold "^(1F80)" "^(1F00)^(03B9)"
	dont-fold "^(1FBC)"	"^(03B1)^(03B9)"
	dont-fold "^(1FFC)" "^(03C9)^(03B9)"

===end-group===

~~~end-file~~~

error: pathspec 'tests/source/units/case-folding-test.red' did not match any file(s) known to git


DOCS: Start of datatype comparison matrix

Red [
	Title:   "Red database comparison matrix"
	Author:  "Peter W A Wood"
	Tabs:	 4
	Rights:  {Copyright (C) 2011-2014	Nenad Rakocevic,
										Andreas Bolka,
										Xie Qing Tian,
									 	Peter W A Wood. All rights reserved.}
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/BSL-License.txt
	}
]

comparison-matrix: [

	integer! [
		accessor! [
			equal "false"
			strict-equal "false"
			same? "false"
			comment "This is a comments"
		]
		action!	[
			equal "false"
			strict-equal "false"
			same? "false"

		]
		actor! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		bigint! [
			equal "the integer is converted to bigint!"
			strict-equal "the integer is converted to big int"
			same? "false"
		]
		bignum! [
			equal "the integer is converted to bignum!"
			strict-equal "false"
			same? "false"
		]
		bitset! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		binary! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		block! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		char! [
			equal "the char is automatically cast to integer"
			strict-equal "false"
			same? "false"
		]
		closure! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		context! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		datatype! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		date! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		decimal! [
			equal "the integer is converted to decimal!"
			strict-equal "false"
			same? "false"
		]
		email! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		error! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		file! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		float! [
			equal "the integer is converted to float!"
			strict-equal "false"
			same? "false"
		]
		float32! [
			equal "the integer is converted to float32!"
			strict-equal "false"
			same? "false"
		]
		function! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		get-path! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		get-word! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		image! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		integer! [
			equal "direct comparison"
			strict-equal "direct comparison"
			same? "equal values and same memory address"
		]
		ipv6! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		issue! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		lit-path! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		lit-word! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		map! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		module! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		logic! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		native! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		none! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		object! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		op! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		pair! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		paren! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		path! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		percent! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		point! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		port! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		refinement! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		routine! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		set! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		set-path! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		set-word! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		string! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		symbol! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		tag! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		time! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		tuple! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		typeset! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		unset! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		url! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		utype! [
			equal {user supplied direct comparison if of same utype!,
				   otherwise false}
		    strict-equal "as equal"
		    same? "same memory address"
		]
		vector! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
		word! [
			equal "false"
			strict-equal "false"
			same? "false"
		]
	]
]

error: pathspec 'docs/comparison-matrix.red' did not match any file(s) known to git


TESTS: start of vector-test.red

TESTS: start of vector-test.red

Red [
	Title:   "Red series test script"
	Author:  "Peter W A Wood"
	File: 	 %vector-test.red
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2013 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~~~ "vector"

===start-group=== "make"

	vector-make-test: func [
		name [string!]
		type [datatype!]
		spec [block!]
		len [integer!]
		test-value [char! float! integer!]
		/local
			vm-v
	][
		--test-- name
		vm-v: make vector! spec
		--assert len = length? vm-v
		foreach v vm-v [
			test-value: test-value + 1
			--assert test-value = v
			--assert type = type? v
		]
		--assert none = vm-v/0
		--assert none = vm-v/(len + 1)
	]

	--test-- "vector-make-1"
		vm1-v: make vector! 10
		--assert 10 = length? vm1-v
		foreach v vm1-v [
			--assert v = 0
			--assert integer! = type? v
		]
		--assert none = vm1-v/0
		--assert none = vm1-v/11

	vector-make-test "vector-make-2" integer! [1 2 3 4 5] 5 0

	vector-make-test "vector-make-3" char! [#"b" #"c" #"d" #"e"] 4 #"a"

	vector-make-test "vector-make-4" float! [1.0 2.0 3.0 4.0 5.0] 5 0.0

	vector-make-test "vector-make-5" integer! [integer! 8 [1 2 3 4 5]] 5 0

	vector-make-test "vector-make-6" integer! [integer! 16 [1 2 3 4 5]] 5 0

	vector-make-test "vector-make-7" integer! [integer! 32 [1 2 3 4 5]] 5 0

	vector-make-test "vector-make-8" float! [float! 64 [1.0 2.0 3.0 4.0 5.0]] 5 0.0

	vector-make-test "vector-make-9" float! [float! 32 [1.0 2.0 3.0 4.0 5.0]] 5 0.0

===end-group===

~~~end-file~~~

error: pathspec 'tests/source/units/vector-test.red' did not match any file(s) known to git


adding-my-best-warrior-yet

adding-my-best-warrior-yet

;redcode-94
;name     Uerige
;author   @alt_bier
;strategy Stone and Imp Spiral
;assert   CORESIZE == 8000 && MAXLENGTH >= 100
;----------------------------------------------------------
; Definitions
;----------------------------------
alt_s01     equ     2668
alt_s02     equ     alt_s01
alt_s03     equ     2667
alt_p01     equ     8
alt_p02     equ     alt_p01
alt_p03     equ     10
alt_o01     equ     -2
alt_o02     equ     0
alt_o03     equ     -7
eins_alt    equ     (gehen-1834)+2*alt_s02
bier_inc    equ     190
bier_offst  equ     701
dec_offst   equ     (alt_s03*2)-bier_inc
            org     gehen
;----------------------------------
; Start
;----------------------------------
gehen       mov.i   alt_2,eins_alt+alt_o02+2
            mov.i   alt_3,eins_alt+alt_o03
            mov.i   <bier_src,@bier_dst2
            mov.i   <bier_src,<bier_dst
            mov.i   <bier_src,<bier_dst
            mov.i   <bier_src,<bier_dst
            spl     @bier_dst,<dec_offst
            mov.i   <bier_src,<bier_dst
;----------------------------------
; Imps And Stones
;----------------------------------
alt_split   spl     1,<dec_offst
            spl     1,<dec_offst
            mov.i   alt_2,<gehen
bier_dst    mov.i   -2,#bier_end+1-bier_offst
bier_dst2   mov.i   -1,#bier_end+1-(bier_offst-1)
            spl     <0,#alt_vector
bier_src    djn.a   @(alt_vector-1),#bier_end+1
bier        mov.i   <bier_spl+5+bier_inc*800,bier_spl
bier_spl    spl     bier,<dec_offst+bier
            add.f   bier_end+1,bier
            djn.f   bier_spl,<dec_offst+bier
bier_end    mov.i   bier_inc,<-bier_inc
;----------------------------------
; Decoy
;----------------------------------
drink       for     42
            dat     0,0
            rof
;----------------------------------
; Vectors
;----------------------------------
alt_2       mov.i   #(alt_s02/2),alt_s02
alt_3       mov.i   #(alt_s03/2),alt_s03
alt_A_fld   equ     eins_alt+(alt_p&chug+1-2*drink)*alt_s&chug+alt_o&chug
alt_B_fld   equ     eins_alt+(alt_p&chug+0-2*drink)*alt_s&chug+alt_o&chug
chug        for     3
drink       for     (alt_p&chug)/2
            jmp     alt_A_fld,alt_B_fld
            rof
            rof
alt_vector
            end

error: pathspec 'uerige.red' did not match any file(s) known to git


TESTS: Add quick-test.red

TESTS: Add quick-test.red

Red [
	Title:   "Red simple testing framework"
	Author:  "Peter W A Wood"
	File: 	 %quick-test.red
	Version: "0.1.0"
	Rights:  "Copyright (C) 2012 Peter W A Wood. All rights reserved."
	License: "BSD-3 - https://github.com/dockimbel/Red/blob/master/BSD-3-License.txt"
]

;; counters
qt-run-tests: 0
qt-run-asserts: 0
qt-run-passes: 0
qt-run-failures: 0
qt-file-tests: 0
qt-file-asserts: 0
qt-file-passes: 0
qt-file-failures: 0

;; group switches
qt-group-name-not-printed: true
qt-group?: false

_qt-init-group: func [] [
  qt-group-name-not-printed: true
  qt-group?: false
  qt-group-name: ""
]

qt-init-run: func [] [
  qt-run-tests: 0
  qt-run-asserts: 0
  qt-run-passes: 0
  qt-run-failures: 0
  _qt-init-group
]

qt-init-file: func [] [
  qt-file-tests: 0
  qt-file-asserts: 0
  qt-file-passes: 0
  qt-file-failures: 0
  _qt-init-group
]

***start-run***: func[
    title [string!]
][
  qt-init-run
  qt-run-name: title
  prin "***Starting*** "
  print title
]

~~~start-file~~~: func [
  title [string!]
][
  qt-init-file
  prin "~~~started test~~~ "
  print title
  qt-file-name: title
  qt-group?: false
]

===start-group===: func [
  title [string!]
][
  qt-group-name: title
  qt-group?: true
]

--test--: func [
  title [string!]
][
  qt-test-name: title
  qt-file-tests: qt-file-tests + 1
]

--assert: func [
  assertion [logic!]
][

  qt-file-asserts: qt-file-asserts + 1

  either assertion [
     qt-file-passes: qt-file-passes + 1
  ][
    qt-file-failures: qt-file-failures + 1
    if qt-group? [
      if qt-group-name-not-printed [
        prin "===group=== "
        print qt-group-name
        qt-group-name-not-printed: false
      ]
    ]
    prin "--test-- "
    prin qt-test-name
    print " FAILED**************"
  ]
]

===end-group===: func [] [
  _qt-init-group
]

qt-print-totals: func [
  tests     [integer!]
  asserts   [integer!]
  passes    [integer!]
  failures  [integer!]
][
  prin  "  Number of Tests Performed:      "
  print tests
  prin  "  Number of Assertions Performed: "
  print asserts
  prin  "  Number of Assertions Passed:    "
  print passes
  prin  "  Number of Assertions Failed:    "
  print failures
  if failures <> 0 [
    print "****************TEST FAILURES****************"
  ]
]

~~~end-file~~~: func [] [
  print ""
  prin "~~~finished test~~~ "
  print qt-file-name
  qt-print-totals qt-file-tests qt-file-asserts qt-file-passes qt-file-failures
  print ""

  ;; update run totals
  qt-run-passes: qt-run-passes + qt-file-passes
  qt-run-asserts: qt-run-asserts + qt-file-asserts
  qt-run-failures: qt-run-failures + qt-file-failures
  qt-run-tests: qt-run-tests + qt-file-tests
]

***end-run***: func [][
  prin "***Finished*** "
  print qt-run-name
  qt-print-totals qt-run-tests
                  qt-run-asserts
                  qt-run-passes
                  qt-run-failures
]

error: pathspec 'quick-test/quick-test.red' did not match any file(s) known to git


FEAT: added crush compress and decompress algorithm.

Red/System [
	Title:   "Compress and decompress algorithms for Red runtime"
	Author:  "Qingtian Xie"
	File: 	 %compress.reds
	Tabs:	 4
	Rights:  "Copyright (C) 2015 Nenad Rakocevic & Xie Qingtian. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/BSL-License.txt
	}
	Notes: {
		Thanks for Ilya Muravyov making it in the Public Domain.
		http://sourceforge.net/projects/crush/?source=navbar
	}
]

crush: context [							;-- LZ77

	#define CRUSH_W_BITS 		21			;-- window size (17..23)
	#define CRUSH_W_SIZE 		2097152		;-- 1 << CRUSH_W_BITS
	#define CRUSH_W_MASK 		2097151		;-- CRUSH_W_SIZE - 1
	#define CRUSH_SLOT_BITS 	4
	#define CRUSH_NUM_SLOTS 	16			;-- 1 << CRUSH_SLOT_BITS

	#define CRUSH_A_BITS		2			;-- 1 xx
	#define CRUSH_B_BITS		2			;-- 01 xx
	#define CRUSH_C_BITS		2			;-- 001 xx
	#define CRUSH_D_BITS		3			;-- 0001 xxx
	#define CRUSH_E_BITS		5			;-- 00001 xxxxx
	#define CRUSH_F_BITS		9			;-- 00000 xxxxxxxxx
	#define CRUSH_A				4			;-- 1 << A_BITS;
	#define CRUSH_B				8			;-- (1 << B_BITS) + A
	#define CRUSH_C				12			;-- (1 << C_BITS) + B
	#define CRUSH_D				20			;-- (1 << D_BITS) + C
	#define CRUSH_E				52			;-- (1 << E_BITS) + D
	#define CRUSH_F				564			;-- (1 << F_BITS) + E
	#define CRUSH_MIN_MATCH 	3
	#define CRUSH_MAX_MATCH 	566			;-- (CRUSH_F - 1) + CRUSH_MIN_MATCH

	#define CRUSH_BUF_SIZE		67108864	;-- 1 << 26

	#define CRUSH_TOO_FAR		65536		;-- 1 << 16

	#define CRUSH_HASH1_LEN		3			;-- CRUSH_MIN_MATCH
	#define CRUSH_HASH2_LEN		4			;-- CRUSH_MIN_MATCH + 1
	#define CRUSH_HASH1_BITS	21
	#define CRUSH_HASH2_BITS	24
	#define CRUSH_HASH1_SIZE	2097152		;-- 1 << CRUSH_HASH1_BITS
	#define CRUSH_HASH2_SIZE	16777216    ;-- 1 << CRUSH_HASH2_BITS
	#define CRUSH_HASH1_MASK	2097151     ;-- CRUSH_HASH1_SIZE - 1
	#define CRUSH_HASH2_MASK	16777215    ;-- CRUSH_HASH2_SIZE - 1
	#define CRUSH_HASH1_SHIFT	7           ;-- (CRUSH_HASH1_BITS + (CRUSH_HASH1_LEN - 1)) / CRUSH_HASH1_LEN
	#define CRUSH_HASH2_SHIFT	6           ;-- (CRUSH_HASH2_BITS + (CRUSH_HASH2_LEN - 1)) / CRUSH_HASH2_LEN

	crush!: alias struct! [
		bit-buf		[integer!]
		bit-count	[integer!]
		input		[byte-ptr!]
		buf			[byte-ptr!]
		buf-size	[integer!]
		index		[integer!]
	]

	init: func [
		crush	[crush!]
		size	[integer!]
		input	[byte-ptr!]
	][
		crush/input: input
		crush/bit-buf: 0
		crush/bit-count: 0
		crush/index: 0
		crush/buf-size: either input = null [size / 4][size * 6]
		crush/buf: allocate crush/buf-size no
	]

	get-buf: func [
		crush	[crush!]
		size	[integer!]
		return: [byte-ptr!]
		/local
			buf			[byte-ptr!]
			index		[integer!]
			buf-size	[integer!]
	][
		buf: crush/buf
		buf-size: crush/buf-size
		index: crush/index

		if index >= buf-size [
			buf-size: buf-size + 4194304
			buf: allocate buf-size no
			move-memory buf crush/buf crush/buf-size
			free crush/buf
			crush/buf: buf
			crush/buf-size: buf-size
		]

		crush/index: index + size
		buf + index
	]

	put-bits: func [
		n		[integer!]
		x		[integer!]
		crush	[crush!]
		/local
			bit-buf		[integer!]
			bit-count	[integer!]
			buf			[byte-ptr!]
	][
		bit-buf: crush/bit-buf
		bit-count: crush/bit-count

		bit-buf: x << bit-count or bit-buf
		bit-count: bit-count + n
		while [bit-count >= 8][
			buf: get-buf crush 1
			buf/value: as byte! bit-buf
			bit-buf: bit-buf >> 8
			bit-count: bit-count - 8
		]
		crush/bit-buf: bit-buf
		crush/bit-count: bit-count
	]

	get-bits: func [
		n		[integer!]
		crush	[crush!]
		return: [integer!]
		/local
			input		[byte-ptr!]
			data		[integer!]
			bit-buf		[integer!]
			bit-count	[integer!]
	][
		input: crush/input
		bit-buf: crush/bit-buf
		bit-count: crush/bit-count

		while [bit-count < n][
			data: as-integer input/value
			input: input + 1
			bit-buf: data << bit-count or bit-buf
			bit-count: bit-count + 8
		]
		data: 1 << n - 1 and bit-buf
		crush/input: input
		crush/bit-buf: bit-buf >> n
		crush/bit-count: bit-count - n
		data
	]

	update-hash1: func [
		h		[integer!]
		c		[integer!]
		return: [integer!]
	][
		h << CRUSH_HASH1_SHIFT + c and CRUSH_HASH1_MASK
	]

	update-hash2: func [
		h		[integer!]
		c		[integer!]
		return: [integer!]
	][
		h << CRUSH_HASH2_SHIFT + c and CRUSH_HASH2_MASK
	]

	get-penalty: func [
		a		[integer!]
		b		[integer!]
		return: [integer!]
		/local
			p	[integer!]
	][
		p: 0
		while [a > b][
			a: a >> 3
			p: p + 1
		]
		p
	]

	compress: func [
		data	[byte-ptr!]
		length	[integer!]
		written [int-ptr!]
		return: [byte-ptr!]
		/local
			i			[integer!]
			s			[integer!]
			ss			[integer!]
			l			[integer!]
			p			[integer!]
			pp			[integer!]
			h1			[integer!]
			h2			[integer!]
			len			[integer!]
			log			[integer!]
			size		[integer!]
			offset		[integer!]
			max-match	[integer!]
			chain-len	[integer!]
			limit		[integer!]
			hash-size	[integer!]
			head		[int-ptr!]
			prev		[int-ptr!]
			output		[int-ptr!]
			buf			[byte-ptr!]
			continue?	[logic!]
			crush		[crush!]
	][
		hash-size: CRUSH_HASH1_SIZE + CRUSH_HASH2_SIZE
		head: as int-ptr! allocate hash-size * size? integer! no
		prev: as int-ptr! allocate CRUSH_W_SIZE * size? integer! no
		buf: allocate CRUSH_BUF_SIZE no

		crush: declare crush!
		init crush length null

		size: CRUSH_BUF_SIZE
		while [length > 0][
			if length < CRUSH_BUF_SIZE [size: length]
			copy-memory buf data size
			output: as int-ptr! get-buf crush 4
			output/value: size

			i: 1
			until [
				head/i: -1
				i: i + 1
				i > hash-size
			]

			h1: 0
			h2: 0
			i: 1
			until [
				h1: update-hash1 h1 as-integer buf/i
				i: i + 1
				i > CRUSH_HASH1_LEN
			]
			h1: h1 + 1
			i: 1
			until [
				h2: update-hash2 h2 as-integer buf/i
				i: i + 1
				i > CRUSH_HASH2_LEN
			]
			h2: h2 + 1

			crush/bit-buf: 0
			crush/bit-count: 0

			p: 0
			while [p < size][
				len: CRUSH_MIN_MATCH - 1
				offset: CRUSH_W_SIZE
				max-match: either CRUSH_MAX_MATCH < (size - p) [CRUSH_MAX_MATCH][size - p]
				limit: either 0 < (p - CRUSH_W_SIZE) [p - CRUSH_W_SIZE][0]

				if head/h1 >= limit [
					s: head/h1
					ss: s + 1
					pp: p + 1
					if buf/ss = buf/pp [
						l: 1
						continue?: yes
						while [all [continue? l < max-match]][
							l: l + 1
							ss: s + l
							pp: p + l
							if buf/ss <> buf/pp [l: l - 1 continue?: no]
						]
						if l > len [
							len: l
							offset: p - s
						]
					]
				]

				if len < CRUSH_MAX_MATCH [
					chain-len: 256
					ss: h2 + CRUSH_HASH1_SIZE
					s: head/ss

					while [all [chain-len <> 0 s >= limit]][
						chain-len: chain-len - 1
						ss: s + len + 1
						pp: p + len + 1
						if buf/ss = buf/pp [
							ss: s + 1
							pp: p + 1
							if buf/ss = buf/pp [
								l: 1
								continue?: yes
								while [all [continue? l < max-match]][
									l: l + 1
									ss: s + l
									pp: p + l
									if buf/ss <> buf/pp [l: l - 1 continue?: no]
								]
								if l > (len + get-penalty p - s >> 4 offset) [
									len: l
									offset: p - s
								]
								if l = max-match [chain-len: 0]
							]
						]
						ss: s and CRUSH_W_MASK + 1
						s: prev/ss
					]
				]

				if all [len = CRUSH_MIN_MATCH offset > CRUSH_TOO_FAR][len: 0]

				either len >= CRUSH_MIN_MATCH [			;-- Match
					put-bits 1 1 crush

					l: len - CRUSH_MIN_MATCH
					case [
						l < CRUSH_A [
							put-bits 1 1 crush
							put-bits CRUSH_A_BITS l crush
						]
						l < CRUSH_B [
							put-bits 2 1 << 1 crush
							put-bits CRUSH_B_BITS l - CRUSH_A crush
						]
						l < CRUSH_C [
							put-bits 3 1 << 2 crush
							put-bits CRUSH_C_BITS l - CRUSH_B crush
						]
						l < CRUSH_D [
							put-bits 4 1 << 3 crush
							put-bits CRUSH_D_BITS l - CRUSH_C crush
						]
						l < CRUSH_E [
							put-bits 5 1 << 4 crush
							put-bits CRUSH_E_BITS l - CRUSH_D crush
						]
						true [
							put-bits 5 0 crush
							put-bits CRUSH_F_BITS l - CRUSH_E crush
						]
					]

					offset: offset - 1
					log: CRUSH_W_BITS - CRUSH_NUM_SLOTS
					while [ss: 2 << log offset >= ss][log: log + 1]
					ss: CRUSH_W_BITS - CRUSH_NUM_SLOTS
					put-bits CRUSH_SLOT_BITS log - ss crush
					either log > ss [
						put-bits log offset - (1 << log) crush
					][
						ss: CRUSH_W_BITS - (CRUSH_NUM_SLOTS - 1)
						put-bits ss offset crush
					]
				][
					len: 1
					pp: p + 1
					put-bits 9 (as-integer buf/pp) << 1 crush
				]

				while [len <> 0][
					len: len - 1
					head/h1: p
					pp: p and CRUSH_W_MASK + 1
					ss: h2 + CRUSH_HASH1_SIZE
					prev/pp: head/ss
					head/ss: p
					p: p + 1
					pp: p + CRUSH_HASH1_LEN
					h1: 1 + update-hash1 h1 - 1 as-integer buf/pp
					pp: p + CRUSH_HASH2_LEN
					h2: 1 + update-hash2 h2 - 1 as-integer buf/pp
				]
			]

			put-bits 7 0 crush
			data: data + size
			length: length - CRUSH_BUF_SIZE
		]

		written/value: crush/index
		crush/buf
	]

	decompress: func [
		data	[byte-ptr!]
		length	[integer!]
		written [int-ptr!]
		return: [byte-ptr!]
		/local
			i			[integer!]
			s			[integer!]
			ss			[integer!]
			p			[integer!]
			pp			[integer!]
			len			[integer!]
			log			[integer!]
			size		[integer!]
			buf			[byte-ptr!]
			head		[int-ptr!]
			p4			[int-ptr!]
			crush		[crush!]
	][
		crush: declare crush!
		init crush length data

		head: as int-ptr! crush/input
		while [
			p4: as int-ptr! crush/input
			size: p4/value
			crush/input: as byte-ptr! p4 + 1
			(as-integer p4 - head) < length
		][
			if any [size < 1 size > CRUSH_BUF_SIZE][
				print-line ["File corrupted: size = " size]
				return null
			]

			crush/bit-buf: 0
			crush/bit-count: 0

			buf: get-buf crush size
			p: 0
			while [p < size][
				either 0 <> get-bits 1 crush [
					len: either 0 <> get-bits 1 crush [
						get-bits CRUSH_A_BITS crush
					][
						either 0 <> get-bits 1 crush [
							CRUSH_A + get-bits CRUSH_B_BITS crush
						][
							either 0 <> get-bits 1 crush [
								CRUSH_B + get-bits CRUSH_C_BITS crush
							][
								either 0 <> get-bits 1 crush [
									CRUSH_C + get-bits CRUSH_D_BITS crush
								][
									either 0 <> get-bits 1 crush [
										CRUSH_D + get-bits CRUSH_E_BITS crush
									][
										CRUSH_E + get-bits CRUSH_F_BITS crush
									]
								]
							]
						]
					]

					ss: CRUSH_W_BITS - CRUSH_NUM_SLOTS
					log: ss + get-bits CRUSH_SLOT_BITS crush
					pp: either log > ss [
						1 << log + get-bits log crush
					][
						get-bits ss + 1 crush
					]
					s: p + not pp
					if s < 0 [
						print-line ["File corrupted: s = " s]
						return null
					]

					p: p + 1
					s: s + 1
					buf/p: buf/s
					p: p + 1
					s: s + 1
					buf/p: buf/s
					p: p + 1
					s: s + 1
					buf/p: buf/s
					while [len <> 0] [
						len: len - 1
						p: p + 1
						s: s + 1
						buf/p: buf/s
					]
				][
					p: p + 1
					buf/p: as byte! get-bits 8 crush
				]
			]
		]

		written/value: crush/index
		crush/buf
	]
]

#export [crush/compress]

error: pathspec 'runtime/compress.reds' did not match any file(s) known to git


recipes-extra-data/scron_0.2.red: add extra data for the scron recipe

Signed-off-by: Mario Domenech Goulart <addb47291ee169f330801ce73520b96f2eaf20ea@ossystems.com.br>

PR = "r1"

INITSCRIPT_NAME = "scron"
INITSCRIPT_PARAMS = "start 90 2 3 4 5 ."

do_install_append() {
    install -d ${D}${INIT_D_DIR}
    install -m 755 ${S}/cron.init ${D}${INIT_D_DIR}/scron
}

inherit update-rc.d

error: pathspec 'scripts/recipes-extra-data/scron_0.2.red' did not match any file(s) known to git


FIX: missing function.reds file.

FIX: missing function.reds file.

Red/System [
	Title:   "Function! datatype runtime functions"
	Author:  "Nenad Rakocevic"
	File: 	 %function.reds
	Tabs:	 4
	Rights:  "Copyright (C) 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
	}
]

_function: context [
	verbose: 0

	push: func [
		spec	 [red-block!]
		body	 [red-block!]
		return:	 [red-context!]						;-- return function's local context
		/local
			cell [red-function!]
	][
		#if debug? = yes [if verbose > 0 [print-line "_function/push"]]

		cell: as red-function! stack/push*
		cell/header: TYPE_FUNCTION					;-- implicit reset of all header flags
		cell/spec:	 spec/node
		cell/ctx:	 _context/make spec yes
		cell/more:	 alloc-cells 2

		copy-cell
			as cell! body
			alloc-tail as series! cell/more/value

		cell/ctx
	]

	;-- Actions --

	datatype/register [
		TYPE_FUNCTION
		TYPE_CONTEXT
		"function"
		;-- General actions --
		null			;make
		null			;random
		null			;reflect
		null			;to
		null			;form
		null			;mold
		null			;get-path
		null			;set-path
		null			;compare
		;-- Scalar actions --
		null			;absolute
		null			;add
		null			;divide
		null			;multiply
		null			;negate
		null			;power
		null			;remainder
		null			;round
		null			;subtract
		null			;even?
		null			;odd?
		;-- Bitwise actions --
		null			;and~
		null			;complement
		null			;or~
		null			;xor~
		;-- Series actions --
		null			;append
		null			;at
		null			;back
		null			;change
		null			;clear
		null			;copy
		null			;find
		null			;head
		null			;head?
		null			;index?
		null			;insert
		null			;length?
		null			;next
		null			;pick
		null			;poke
		null			;remove
		null			;reverse
		null			;select
		null			;sort
		null			;skip
		null			;swap
		null			;tail
		null			;tail?
		null			;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
	]
]

error: pathspec 'red/runtime/datatypes/function.reds' did not match any file(s) known to git


max-consecutive-sum

max-consecutive-sum

Red [
  problem: {
    Given array of integers, find the maximal possible sum of some of its k consecutive elements.

    Example

    For inputArray = [2, 3, 5, 1, 6] and k = 2,
    the output should be arrayMaxConsecutiveSum(inputArray, k) = 8.

    All possible sums of 2 consecutive elements are:
     2 + 3 = 5;
     3 + 5 = 8;
     5 + 1 = 6;
     1 + 6 = 7.
    Thus, the answer is 8.
    }
]

max-consecutive-sum: function [blk k] [
  i: 1
  sum: max-val: 0

  repeat i length? blk [
    either i <= k [
      sum: sum + blk/:i
    ][
      max-val: max sum max-val
      j: i - k
      sum: sum + blk/:i - blk/:j
    ]
  ]
  max sum max-val
]

print max-consecutive-sum [2 3 5 1 6] 2 ;= 8
print max-consecutive-sum [2 4 10 1] 2  ;= 14
print max-consecutive-sum [1 3 2 4] 3   ;= 9
print max-consecutive-sum [3 2 1 1] 1   ;= 3

error: pathspec 'src/codingpuzzle/array-max-consecutive-sum.red' did not match any file(s) known to git


FEAT: added little ASCII-art demo script.

Red [
	Title: "Red alpha simple ASCII art demo"
	Author: "Nenad Rakocevic"
	File: %demo.r
	Rights:  "Copyright (C) 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
	}
]

data: [
	[0 7 20]
	[2 2 6 7 20]
	[1 2 6 7 20]
	[0 2 6 7 10 14 17 20 20]
	[2 2 6 7 9 10 13 14 16 17 19]
	[1 7 9 10 13 14 16 17 20]
	[0 2 4 5 9 14 16 17 20]
	[2 2 5 6 9 10 16 17 20]
	[1 2 5 6 9 10 13 14 16 17 19]
	[0 2 6 7 10 14 17 20 20]
]

pattern: "Red"
prin newline

foreach line data [
	cursor: 1 + pick line 1
	line: next line
	gap-start: pick line 1
	gap-end: pick line 2
	prin tab
	prin tab

	repeat i 21 [
		prin either all [
			gap-start <= i
			i <= gap-end
		][
			#" "
		][
			pick pattern cursor
		]
		if i > gap-end [
			if not tail? line: skip line 2 [
				gap-start: pick line 1
				gap-end: pick line 2
			]
		]

		cursor: cursor + 1
		if cursor = 4 [cursor: 1]
	]
	prin newline
]

error: pathspec 'red/tests/demo.red' did not match any file(s) known to git


TESTS: conditional-test.red

TESTS: conditional-test.red

Red [
	Title:   "Red conditonal test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %conditional-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"
]

;; start of quick-test
;; counters
qt-run-tests: 0
qt-run-asserts: 0
qt-run-passes: 0
qt-run-failures: 0
qt-file-tests: 0
qt-file-asserts: 0
qt-file-passes: 0
qt-file-failures: 0

;; group switches
qt-group-name-not-printed: true
qt-group?: false

_qt-init-group: func [] [
  qt-group-name-not-printed: true
  qt-group?: false
  qt-group-name: ""
]

qt-init-run: func [] [
  qt-run-tests: 0
  qt-run-asserts: 0
  qt-run-passes: 0
  qt-run-failures: 0
  _qt-init-group
]

qt-init-file: func [] [
  qt-file-tests: 0
  qt-file-asserts: 0
  qt-file-passes: 0
  qt-file-failures: 0
  _qt-init-group
]

***start-run***: func[
    title [string!]
][
  qt-init-run
  qt-run-name: title
  prin "***Starting*** "
  print title
]

~~~start-file~~~: func [
  title [string!]
][
  qt-init-file
  prin "~~~started test~~~ "
  print title
  qt-file-name: title
  qt-group?: false
]

===start-group===: func [
  title [string!]
][
  qt-group-name: title
  qt-group?: true
]

--test--: func [
  title [string!]
][
  qt-test-name: title
  qt-file-tests: qt-file-tests + 1
]

--assert: func [
  assertion [logic!]
][

  qt-file-asserts: qt-file-asserts + 1

  either assertion [
     qt-file-passes: qt-file-passes + 1
  ][
    qt-file-failures: qt-file-failures + 1
    if qt-group? [
      if qt-group-name-not-printed [
        prin "===group=== "
        print qt-group-name
        qt-group-name-not-printed: false
      ]
    ]
    prin "--test-- "
    prin qt-test-name
    print " FAILED**************"
  ]
]

===end-group===: func [] [
  _qt-init-group
]

qt-print-totals: func [
  tests     [integer!]
  asserts   [integer!]
  passes    [integer!]
  failures  [integer!]
][
  prin  "  Number of Tests Performed:      "
  print tests
  prin  "  Number of Assertions Performed: "
  print asserts
  prin  "  Number of Assertions Passed:    "
  print passes
  prin  "  Number of Assertions Failed:    "
  print failures
  if failures <> 0 [
    print "****************TEST FAILURES****************"
  ]
]

~~~end-file~~~: func [] [
  print ""
  prin "~~~finished test~~~ "
  print qt-file-name
  qt-print-totals qt-file-tests qt-file-asserts qt-file-passes qt-file-failures
  print ""

  ;; update run totals
  qt-run-passes: qt-run-passes + qt-file-passes
  qt-run-asserts: qt-run-asserts + qt-file-asserts
  qt-run-failures: qt-run-failures + qt-file-failures
  qt-run-tests: qt-run-tests + qt-file-tests
]

***end-run***: func [][
  prin "***Finished*** "
  print qt-run-name
  qt-print-totals qt-run-tests
                  qt-run-asserts
                  qt-run-passes
                  qt-run-failures
]

;; end of quick test

~~~start-file~~~ "conditional"

  --test-- "nested ifs inside a function with many return points"
    niff: func [
      i       [integer!]
      return: [integer!]
    ][
      if i > 127 [
        if 192 = i [return i]
        if 193 = i [return i]
        if 244 < i [return i]
        if i < 224 [
          if i = 208 [return i]
        ]
      ]
      return -1
    ]
  --assert 208 = niff 208
  --assert -1 = niff 1
  --assert -1 = niff 224

  --test-- "simple if"
    i: 0
    if true [i: 1]
  --assert i = 1

  --test-- "nested if"
    i: 0
    if true [
      if true [
        i: 1
      ]
    ]
  --assert i = 1

  --test-- "double nested if"
    i: 0
    if true [
      if true [
        if true [
          i: 1
        ]
      ]
    ]
  --assert i = 1

  --test-- "triple nested if"
    i: 0
    if true [
      if true [
        if true [
          if true [
            i: 1
          ]
        ]
      ]
    ]
  --assert i = 1

  --test-- "either basic 1"
  --assert 1 = either true [1] [2]

  --test-- "either basic 2"
  --assert 2 = either false [1] [2]

  --test-- "either basic 3"
  --assert 1 = either 42 [1] [2]

~~~end-file~~~

error: pathspec 'red/tests/source/units/conditional-test.red' did not match any file(s) known to git