Skip to content

Commit

Permalink
Red language (red-lang.org)
Browse files Browse the repository at this point in the history
  • Loading branch information
@Oldes
Oldes committed Apr 29, 2014
1 parent e513ac6 commit a978c4e
Show file tree
Hide file tree
Showing 3 changed files with 389 additions and 0 deletions.
8 changes: 8 additions & 0 deletions lib/linguist/languages.yml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1655,6 +1655,14 @@ Rebol:
- .r3
- .rebol

Red language:
type: programming
lexer: Red
color: "#ee0000"
primary_extension: .red
extensions:
- .reds

Redcode:
primary_extension: .cw

Expand Down
257 changes: 257 additions & 0 deletions samples/Red/example.red
View file
Original file line number Diff line number Diff line change
@@ -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
124 changes: 124 additions & 0 deletions samples/Red/example.reds
View file
Original file line number Diff line number Diff line change
@@ -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

0 comments on commit a978c4e

Please sign in to comment.