Initial version of Red-language lexer

2 files changed, 368 insertions, 0 deletions

diff --git a/tests/examplefiles/example.red b/tests/examplefiles/example.red
new file mode 100644
index 00000000..37c17ef8
--- /dev/null
+++ b/tests/examplefiles/example.red
@@ -0,0 +1,257 @@
+Red [

+    Title:  "Red console"

+    Author: ["Nenad Rakocevic" "Kaj de Vos"]

+    File:   %console.red

+    Tabs:   4

+    Rights: "Copyright (C) 2012-2013 Nenad Rakocevic. All rights reserved."

+    License: {

+        Distributed under the Boost Software License, Version 1.0.

+        See https://github.com/dockimbel/Red/blob/master/BSL-License.txt

+    }

+    Purpose:    "Just some code for testing Pygments colorizer"

+    Language:   http://www.red-lang.org/

+]

+

+#system-global [

+    #either OS = 'Windows [

+        #import [

+            "kernel32.dll" stdcall [

+                AttachConsole:   "AttachConsole" [

+                    processID       [integer!]

+                    return:         [integer!]

+                ]

+                SetConsoleTitle: "SetConsoleTitleA" [

+                    title           [c-string!]

+                    return:         [integer!]

+                ]

+                ReadConsole:     "ReadConsoleA" [

+                    consoleInput    [integer!]

+                    buffer          [byte-ptr!]

+                    charsToRead     [integer!]

+                    numberOfChars   [int-ptr!]

+                    inputControl    [int-ptr!]

+                    return:         [integer!]

+                ]

+            ]

+        ]

+        line-buffer-size: 16 * 1024

+        line-buffer: allocate line-buffer-size

+    ][

+        #switch OS [

+            MacOSX [

+                #define ReadLine-library "libreadline.dylib"

+            ]

+            #default [

+                #define ReadLine-library "libreadline.so.6"

+                #define History-library  "libhistory.so.6"

+            ]

+        ]

+        #import [

+            ReadLine-library cdecl [

+                read-line: "readline" [  ; Read a line from the console.

+                    prompt          [c-string!]

+                    return:         [c-string!]

+                ]

+                rl-bind-key: "rl_bind_key" [

+                    key             [integer!]

+                    command         [integer!]

+                    return:         [integer!]

+                ]

+                rl-insert:   "rl_insert" [

+                    count           [integer!]

+                    key             [integer!]

+                    return:         [integer!]

+                ]

+            ]

+            #if OS <> 'MacOSX [

+                History-library cdecl [

+                    add-history: "add_history" [  ; Add line to the history.

+                        line        [c-string!]

+                    ]

+                ]

+            ]

+        ]

+

+        rl-insert-wrapper: func [

+            [cdecl]

+            count   [integer!]

+            key     [integer!]

+            return: [integer!]

+        ][

+            rl-insert count key

+        ]

+        

+    ]

+]

+

+Windows?: system/platform = 'Windows

+

+read-argument: routine [

+    /local

+        args [str-array!]

+        str  [red-string!]

+][

+    if system/args-count <> 2 [

+        SET_RETURN(none-value)

+        exit

+    ]

+    args: system/args-list + 1                          ;-- skip binary filename

+    str: simple-io/read-txt args/item

+    SET_RETURN(str)

+]

+

+init-console: routine [

+    str [string!]

+    /local

+        ret

+][

+    #either OS = 'Windows [

+        ;ret: AttachConsole -1

+        ;if zero? ret [print-line "ReadConsole failed!" halt]

+        

+        ret: SetConsoleTitle as c-string! string/rs-head str

+        if zero? ret [print-line "SetConsoleTitle failed!" halt]

+    ][

+        rl-bind-key as-integer tab as-integer :rl-insert-wrapper

+    ]

+]

+

+input: routine [

+    prompt [string!]

+    /local

+        len ret str buffer line

+][

+    #either OS = 'Windows [

+        len: 0

+        print as c-string! string/rs-head prompt

+        ret: ReadConsole stdin line-buffer line-buffer-size :len null

+        if zero? ret [print-line "ReadConsole failed!" halt]

+        len: len + 1

+        line-buffer/len: null-byte

+        str: string/load as c-string! line-buffer len

+    ][

+        line: read-line as c-string! string/rs-head prompt

+        if line = null [halt]  ; EOF

+

+         #if OS <> 'MacOSX [add-history line]

+

+        str: string/load line  1 + length? line

+;       free as byte-ptr! line

+    ]

+    SET_RETURN(str)

+]

+

+count-delimiters: function [

+    buffer  [string!]

+    return: [block!]

+][

+    list: copy [0 0]

+    c: none

+    

+    foreach c buffer [

+        case [

+            escaped? [

+                escaped?: no

+            ]

+            in-comment? [

+                switch c [

+                    #"^/" [in-comment?: no]

+                ]

+            ]

+            'else [

+                switch c [

+                    #"^^" [escaped?: yes]

+                    #";"  [if zero? list/2 [in-comment?: yes]]

+                    #"["  [list/1: list/1 + 1]

+                    #"]"  [list/1: list/1 - 1]

+                    #"{"  [list/2: list/2 + 1]

+                    #"}"  [list/2: list/2 - 1]

+                ]

+            ]

+        ]

+    ]

+    list

+]

+

+do-console: function [][

+    buffer: make string! 10000

+    prompt: red-prompt: "red>> "

+    mode:  'mono

+    

+    switch-mode: [

+        mode: case [

+            cnt/1 > 0 ['block]

+            cnt/2 > 0 ['string]

+            'else     [

+                prompt: red-prompt

+                do eval

+                'mono

+            ]

+        ]

+        prompt: switch mode [

+            block  ["[^-"]

+            string ["{^-"]

+            mono   [red-prompt]

+        ]

+    ]

+    

+    eval: [

+        code: load/all buffer

+        

+        unless tail? code [

+            set/any 'result do code

+            

+            unless unset? :result [

+                if 67 = length? result: mold/part :result 67 [  ;-- optimized for width = 72

+                    clear back tail result

+                    append result "..."

+                ]

+                print ["==" result]

+            ]

+        ]

+        clear buffer

+    ]

+

+    while [true][

+        unless tail? line: input prompt [

+            append buffer line

+            cnt: count-delimiters buffer

+

+            either Windows? [

+                remove skip tail buffer -2          ;-- clear extra CR (Windows)

+            ][

+                append buffer lf                    ;-- Unix

+            ]

+            

+            switch mode [

+                block  [if cnt/1 <= 0 [do switch-mode]]

+                string [if cnt/2 <= 0 [do switch-mode]]

+                mono   [do either any [cnt/1 > 0 cnt/2 > 0][switch-mode][eval]]

+            ]

+        ]

+    ]

+]

+

+q: :quit

+

+if script: read-argument [

+    script: load script

+    either any [

+        script/1 <> 'Red

+        not block? script/2 

+    ][

+        print "*** Error: not a Red program!"

+    ][

+        do skip script 2

+    ]

+    quit

+]

+

+init-console "Red Console"

+

+print {

+-=== Red Console alpha version ===-

+(only ASCII input supported)

+}

+

+do-console
\ No newline at end of file
diff --git a/tests/examplefiles/example.reds b/tests/examplefiles/example.reds
new file mode 100644
index 00000000..8c1c0c03
--- /dev/null
+++ b/tests/examplefiles/example.reds
@@ -0,0 +1,111 @@
+Red/System [
+    Title:      "Red/System example file"
+    Purpose:    "Just some code for testing Pygments colorizer"
+    Language:   http://www.red-lang.org/
+]
+
+#include %../common/FPU-configuration.reds
+
+; C types
+
+#define time!                   long!
+#define clock!                  long!
+
+date!: alias struct! [
+    second                      [integer!]  ; 0-61 (60?)
+    minute                      [integer!]  ; 0-59
+    hour                        [integer!]  ; 0-23
+
+    day                         [integer!]  ; 1-31
+    month                       [integer!]  ; 0-11
+    year                        [integer!]  ; Since 1900
+
+    weekday                     [integer!]  ; 0-6 since Sunday
+    yearday                     [integer!]  ; 0-365
+    daylight-saving-time?       [integer!]  ; Negative: unknown
+]
+
+#either OS = 'Windows [
+    #define clocks-per-second   1000
+][
+    ; CLOCKS_PER_SEC value for Syllable, Linux (XSI-conformant systems)
+    ; TODO: check for other systems
+    #define clocks-per-second   1000'000
+] 
+
+#import [LIBC-file cdecl [
+
+    ; Error handling
+
+    form-error: "strerror" [  ; Return error description.
+        code            [integer!]
+        return:         [c-string!]
+    ]
+    print-error: "perror" [  ; Print error to standard error output.
+        string          [c-string!]
+    ]
+
+
+    ; Memory management
+
+    make: "calloc" [  ; Allocate zero-filled memory.
+        chunks          [size!]
+        size            [size!]
+        return:         [binary!]
+    ]
+    resize: "realloc" [  ; Resize memory allocation.
+        memory          [binary!]
+        size            [size!]
+        return:         [binary!]
+    ]
+ ]
+ 
+ JVM!: alias struct! [
+    reserved0                   [int-ptr!]
+    reserved1                   [int-ptr!]
+    reserved2                   [int-ptr!]
+    
+    DestroyJavaVM               [function! [[JNICALL] vm [JVM-ptr!] return: [jint!]]]
+    AttachCurrentThread         [function! [[JNICALL] vm [JVM-ptr!] penv [struct! [p [int-ptr!]]] args [byte-ptr!] return: [jint!]]]
+    DetachCurrentThread         [function! [[JNICALL] vm [JVM-ptr!] return: [jint!]]]
+    GetEnv                      [function! [[JNICALL] vm [JVM-ptr!] penv [struct! [p [int-ptr!]]] version [integer!] return: [jint!]]]
+    AttachCurrentThreadAsDaemon [function! [[JNICALL] vm [JVM-ptr!] penv [struct! [p [int-ptr!]]] args [byte-ptr!] return: [jint!]]]
+]
+
+ ;just some datatypes for testing:
+ 
+ #some-hash
+ 10-1-2013
+ quit
+ 
+ ;some numbers:
+ 12
+ 1'000
+ 1.2
+ FF00FF00h
+ 
+ ;some tests of hexa number notation with not common ending
+ [ff00h ff00h] ff00h{} FFh"foo" 00h(1 + 2) (AEh)
+
+;normal words:
+foo char
+
+;get-word
+:foo
+ 
+;lit-word:
+'foo 'foo
+
+to-integer foo
+foo/(a + 1)/b
+
+call/output reform ['which interpreter] path: copy ""
+
+ version-1.1:   00010001h
+ 
+ #if type = 'exe [
+    push system/stack/frame                 ;-- save previous frame pointer
+    system/stack/frame: system/stack/top    ;-- @@ reposition frame pointer just after the catch flag
+]
+push CATCH_ALL                              ;-- exceptions root barrier
+push 0                                      ;-- keep stack aligned on 64-bit
\ No newline at end of file