mirror of
https://github.com/KevinMidboe/linguist.git
synced 2025-10-28 17:20:22 +00:00
Red language (red-lang.org)
This commit is contained in:
Oldes
@@ -1655,6 +1655,14 @@ Rebol:
|
||||
- .r3
|
||||
- .rebol
|
||||
|
||||
Red language:
|
||||
type: programming
|
||||
lexer: Red
|
||||
color: "#ee0000"
|
||||
primary_extension: .red
|
||||
extensions:
|
||||
- .reds
|
||||
|
||||
Redcode:
|
||||
primary_extension: .cw
|
||||
|
||||
|
||||
257
samples/Red/example.red
Normal file
257
samples/Red/example.red
Normal file
@@ -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
samples/Red/example.reds
Normal file
124
samples/Red/example.reds
Normal file
@@ -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
|
||||
Reference in New Issue
Block a user