From a978c4eb34f81fde3fa7b4cf1e76e43c045b7f79 Mon Sep 17 00:00:00 2001 From: Oldes Date: Tue, 29 Apr 2014 23:04:53 +0200 Subject: [PATCH] Red language (red-lang.org) --- lib/linguist/languages.yml | 8 ++ samples/Red/example.red | 257 +++++++++++++++++++++++++++++++++++++ samples/Red/example.reds | 124 ++++++++++++++++++ 3 files changed, 389 insertions(+) create mode 100644 samples/Red/example.red create mode 100644 samples/Red/example.reds diff --git a/lib/linguist/languages.yml b/lib/linguist/languages.yml index 70302378..962d525c 100644 --- a/lib/linguist/languages.yml +++ b/lib/linguist/languages.yml @@ -1655,6 +1655,14 @@ Rebol: - .r3 - .rebol +Red language: + type: programming + lexer: Red + color: "#ee0000" + primary_extension: .red + extensions: + - .reds + Redcode: primary_extension: .cw diff --git a/samples/Red/example.red b/samples/Red/example.red new file mode 100644 index 00000000..66a5ada3 --- /dev/null +++ b/samples/Red/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/samples/Red/example.reds b/samples/Red/example.reds new file mode 100644 index 00000000..dd4ad0f9 --- /dev/null +++ b/samples/Red/example.reds @@ -0,0 +1,124 @@ +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 + + ;binary: + #{00FF0000} + #{00FF0000 FF000000} + #{00FF0000 FF000000} ;with tab instead of space + 2#{00001111} + 64#{/wAAAA==} + 64#{/wAAA A==} ;with space inside + 64#{/wAAA A==} ;with tab inside + + + ;string with char + {bla ^(ff) foo} + {bla ^(( foo} + ;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