path: root/paradox.false

{
	variables:

	c: current_char
	q: state: 0=CONTINUE, 1=DONE, 2=ERROR

	f: fn_counter
	s: str_counter

	i: current_int

	l: line_number
	p: line_position

	t: stack_size
	u: buffer_size

	x: compile_fn
	r: read_char
	e: error
}

0  f: { fn_counter <- 0 }
0  s: { str_counter <- 0 }
1_ i: { current_int <- -1 }

1  l: { line_number <- 1 }
0  p: { line_position <- 0 }

8388608 t: { stack_size <- 8MiB }
8192    u: { buffer_size <- 8KiB }

{ read_char() }
[
	^ { input <- getchar() }
	{ if input = newline }
	$10=$[
		l; 1+ l: { increment line_number }
		0 p:     { reset line_position }
	]?
	{ else }
	~[
		p; 1+ p: { increment line_position }
	]?
]r:

{ error(condition, message) }
[
	{ if condition}
	\ [
		10,"%fatal FALSE syntax error at " { first part of error message }
		l;.":"p;.": "                      { print line_number and line_position }
		$! 10,                             { call message }
		2q:                                { state <- ERROR }
	]?
	% { pop message }
]e:

{ compile_fn() }
[
	f;      { push fn_counter }
	$ 1+ f: { increment fn_counter }

	"fun_" $. ":" 10, { emit label }

	{
		string stack layout, from top to bottom:

		repeat:
			id (if -1, we've reached the end)
			length
			last .. first char
	}
	1_ { string stack end }

	0  q: { state <- CONTINUE }
	1_ c: { current_char <- EOF }

	{ while state == CONTINUE }
	[q;0=][
		{ if current_char = EOF }
		c;1_=[
			r;! c: { current_char <- read_char() }
		]?

		{ if '0'-1 < c < '9'+1 }
		c;$ '0 1- > \ '9 1+ \ > & $[
			i;1_=[0 i:]?       { if current_int = -1: current_int <- 0 }
			i; 10* c; '0- + i: { current_int = current_int * 10 + current_char - '0' }
			1_ c:              { consume current_char }
		]?

		{ elseif current_int != -1 }
		i;1_=~ $[%~1_\]?[
			{ if current_char = S }
			c;'S= $[
				i; t: { stack_size <- current_int }
				1_ c: { consume current_char }
			]?
			{ elseif current_char = U }
			c;'U= $[%~1_\]?[
				i; u: { buffer_size <- current_int }
				1_ c: { consume current_char }
			]?
			{ else }
			~[
				{ emit push int }
				"sub r12, 8" 10,
				"mov qword[r12], " i;. 10,
			]?

			1_ i: { clear current_int }
		]?

		{ elseif a-1 < c < z+1 }
		c;$ 'a 1- > \ 'z 1+ \ > & $[%~1_\]?[
			{ emit push var ref }
			"sub r12, 8" 10,
			"mov qword[r12], var_" c;, 10,

			1_ c: { consume current_char }
		]?

		{ elseif c = ' }
		c;''= $[%~1_\]?[
			r;! { read character literal }
			$1_=["unterminated char literal"]e;! { check for EOF }
			{ if state != ERROR }
			q;2=~ [
				{ emit push char }
				"sub r12, 8" 10,
				"mov qword[r12], " . 10,

				1_ c: { consume current_char }
			]?
		]?

		{ elseif c = " }
		c;'"= $[%~1_\]?[
			% { drop true to manipulate stack below }
			0 { length <- 0 }

			{ while read_char() != " and state != ERROR }
			[
				r;!           { push read_char() }
				$1_=["unterminated string literal"]e;! { check for EOF }
				$'"=~ q;2=~ & { condition }
			][
				\  { swap length to top }
				1+ { increment length }
			]#
			% { drop " or EOF }

			{ if state != ERROR }
			q;2=~ [
				s;      { id <- str_counter }
				$ 1+ s: { increment str_counter }

				{ emit print string }
				"mov rsi, str_" 0 ø . 10,
				"mov rcx, "     1 ø . 10,
				"call write" 10,

				1_ c: { consume current_char }
			]?

			1_ { push true }
		]?

		{ elseif c = ` }
		c;'`= $[%~1_\]?[
			{ while read_char() != ` and state != ERROR }
			[
				r;!           { push read_char() }
				$1_=["unterminated inline assembly"]e;! { check for EOF }
				$'`=~ q;2=~ & { condition }
			][,]#
			% { drop ` or EOF }

			1_ c: { consume current_char }
		]?

		{ elseif c = (opening bracket) }
		c;91= $[%~1_\]?[
			f;                 { backup fn_id }
			"jmp end_" f;. 10, { skip generated code }
			x;!                { call compile_fn }

			{ if state = ERROR }
			q;2=[
				{ stack is corrupted now }
				1_ { push true to skip remaining elseif branches }
			]?

			q;2=~ c;93=~ & ["unterminated lambda"]e;! { ensure current_char was (closing bracket) }

			{ if state != ERROR }
			q;2=~ [
				{ emit push fn ref }
				{ fn_id is top }
				"sub r12, 8" 10,
				"mov qword[r12], fun_" . 10,

				0  q: { state <- CONTINUE }
				1_ c: { clear current_char }
			]?
		]?

		{ elseif c is whitespace }
		c;9= c;10= | c;32= | $[%~1_\]?[
			1_ c: { consume current_char }
		]?

		{ elseif c = EOF or c = (closing bracket) }
		c;1_= c;93= | $[%~1_\]?[
			1 q: { state <- DONE }
		]?

		{ elseif c is UTF-8 }
		c;195= $[%~1_\]?[
			r;! c: { c <- read_char() }

			c;184=         $[ 'O c:	]? { if c = ø then c <- O }
			c;159= $[%~1_\]?[ 'B c:	]? { if c = ß then c <- B }
			~["unknown UTF-8 character"]e;! { else error }
		]?

		{ elseif c = ø then c <- O }
		c;248= $[%~1_\]?[ 'O c: ]?

		{ elseif c = ß then c <- B }
		c;223= $[%~1_\]?[ 'B c: ]?

		{ elseif c = (opening brace) }
		c;123= $[%~1_\]?[
			[r;!125=~][]# { while read_char() != (closing brace) }
			1_ c:         { clear current_char }
		]?

		{ elseif c = $ }
		c;'$= $[%~1_\]?[
"mov rax, [r12]
sub r12, 8
mov [r12], rax
"
		1_ c:]?

		{ elseif c = % }
		c;'%= $[%~1_\]?[
"add r12, 8
"
		1_ c:]?

		{ elseif c = \ }
		c;'\= $[%~1_\]?[
"mov rax, [r12]
mov rbx, [r12+8]
mov [r12], rbx
mov [r12+8], rax
"
		1_ c:]?

		{ elseif c = @ }
		c;'@= $[%~1_\]?[
"mov rax, [r12]
mov rbx, [r12+8]
mov rcx, [r12+16]
mov [r12], rcx
mov [r12+8], rax
mov [r12+16], rbx
"
		1_ c:]?

		{ elseif c = O }
		c;'O= $[%~1_\]?[
"mov rax, [r12]
lea rax, [r12+8*rax]
mov rax, [rax+8]
mov [r12], rax
"
		1_ c:]?

		{ elseif c = + }
		c;'+= $[%~1_\]?[
"mov eax, [r12]
add r12, 8
add [r12], eax
"
		1_ c:]?

		{ elseif c = - }
		c;'-= $[%~1_\]?[
"mov eax, [r12]
add r12, 8
sub [r12], eax
"
		1_ c:]?

		{ elseif c = * }
		c;'*= $[%~1_\]?[
"mov eax, [r12+8]
imul dword[r12]
add r12, 8
mov [r12], eax
"
		1_ c:]?

		{ elseif c = / }
		c;'/= $[%~1_\]?[
"xor edx, edx
mov eax, [r12+8]
idiv dword[r12]
add r12, 8
mov [r12], eax
"
		1_ c:]?

		{ elseif c = _ }
		c;'_= $[%~1_\]?[
"neg dword[r12]
"
		1_ c:]?

		{ elseif c = & }
		c;'&= $[%~1_\]?[
"mov eax, [r12]
and eax, [r12+8]
add r12, 8
mov [r12], eax
"
		1_ c:]?

		{ elseif c = | }
		c;'|= $[%~1_\]?[
"mov eax, [r12]
or eax, [r12+8]
add r12, 8
mov [r12], eax
"
		1_ c:]?

		{ elseif c = ~ }
		c;'~= $[%~1_\]?[
"not dword[r12]
"
		1_ c:]?

		{ elseif c = > }
		c;'>= $[%~1_\]?[
"mov ebx, 0
mov ecx, -1
add r12, 8
mov eax, [r12]
cmp eax, [r12-8]
cmovg ebx, ecx
mov [r12], ebx
"
		1_ c:]?

		{ elseif c = '=' }
		c;'== $[%~1_\]?[
"mov ebx, 0
mov ecx, -1
add r12, 8
mov eax, [r12]
cmp eax, [r12-8]
cmove ebx, ecx
mov [r12], ebx
"
		1_ c:]?

		{ elseif c = ! }
		c;'!= $[%~1_\]?[
"add r12, 8
call [r12-8]
"
		1_ c:]?

		{ elseif c = ? }
		c;'?= $[%~1_\]?[
"call conditional
"
		1_ c:]?

		{ elseif c = # }
		c;'#= $[%~1_\]?[
"call loop
"
		1_ c:]?

		{ elseif c = : }
		c;':= $[%~1_\]?[
"add r12, 16
mov rax, [r12-16]
mov rbx, [r12-8]
mov [rax], rbx
"
		1_ c:]?

		{ elseif c = ; }
		c;';= $[%~1_\]?[
"mov rax, [r12]
mov rax, [rax]
mov [r12], rax
"
		1_ c:]?

		{ elseif c = , }
		c;',= $[%~1_\]?[
"mov rsi, r12
mov rcx, 1
call write
add r12, 8
"
		1_ c:]?

		{ elseif c = ^ }
		c;'^= $[%~1_\]?[
"call read
sub r12, 8
mov [r12], eax
"
		1_ c:]?

		{ elseif c = . }
		c;'.= $[%~1_\]?[
"call print_num
"
		1_ c:]?

		{ elseif c = B }
		c;'B= $[%~1_\]?[
"call flush
"
		1_ c:]?

		{ else error }
		~["unknown character: "c;,]e;!
	]#

	{ if state != ERROR }
	q;2=~[
		"ret" 10, { emit return to caller }

		"section .data" 10,

		{ string stack is top }
		{ while top != -1 }
		[$1_=~][
			{ id is top }
			"str_" . ": db " { emit label }

			{ length is top }
			$ { copy length }

			{ print string }
			{ while length > 0}
			[$ 0 >][
				$ 1+ ø .     { print nth item }
				1-           { decrement length }
				$ 0 > [","]? { if length > 0 emit , }
			]#
			% { drop 0 }

			{ remove string }
			{ while length > 0 }
			[$ 0 >][
				\  { swap last char with length }
				%  { drop last char }
				1- { decrement length }
			]#
			% { drop 0 }

			10, { newline }
		]#
		% { drop string stack end }

		"section .text" 10,

		{ function counter is top now }
		"end_" . ":" 10, { end label }
	]?
] x:

"section .text" 10,

x;! { call compile_fn }

{ if state != ERROR }
q;2=~[

{ emit constants }
"%define STKSIZ " t;. 10,
"%define BUFSIZ " u;. 10,

{ emit builtin functions }
"section .data
readbuf_len: dq 0
readbuf_cursor: dq 0
writebuf_len: dq 0
section .bss
readbuf: resb BUFSIZ
writebuf: resb BUFSIZ
section .text
read:
mov rax, [readbuf_cursor]
mov rbx, [readbuf_len]
cmp rax, rbx
jb .has
cmp rbx, BUFSIZ
jb .fill
xor rbx, rbx
mov [readbuf_len], rbx
mov [readbuf_cursor], rbx
.fill:
mov rax, 0
mov rdi, 0
lea rsi, [rbx+readbuf]
mov rdx, BUFSIZ
sub rdx, rbx
syscall
add [readbuf_len], rax
cmp rax, 0
jne .has
mov eax, -1
ret
.has:
mov rax, [readbuf_cursor]
movzx eax, byte[readbuf+rax]
inc qword[readbuf_cursor]
ret
write:
mov rdi, [writebuf_len]
mov rax, BUFSIZ
sub rax, rdi
add rdi, writebuf
mov rdx, rcx
sub rdx, rax
jna .simple
mov rcx, rax
rep movsb
push rsi
push rdx
mov qword[writebuf_len], BUFSIZ
call flush
pop rdx
pop rsi
cmp rdx, BUFSIZ
ja .direct
mov rcx, rdx
mov rdi, writebuf
.simple:
add [writebuf_len], rcx
rep movsb
ret
.direct:
mov rax, 1
mov rdi, 1
syscall
ret
flush:
mov rdx, [writebuf_len]
cmp rdx, 0
je .return
mov rax, 1
mov rdi, 1
mov rsi, writebuf
syscall
mov qword[writebuf_len], 0
.return:
ret
conditional:
add r12, 16
mov eax, [r12-8]
cmp eax, 0
je .return
call [r12-16]
.return:
ret
loop:
add r12, 16
sub rsp, 16
mov rax, [r12-8]
mov [rsp], rax
mov rax, [r12-16]
mov [rsp+8], rax
.loop:
call [rsp]
add r12, 8
mov eax, [r12-8]
cmp eax, 0
je .return
call [rsp+8]
jmp .loop
.return:
add rsp, 16
ret
print_num:
mov rcx, rsp
sub rsp, 16
mov eax, dword[r12]
add r12, 8
mov ebx, eax
neg ebx
cmp eax, 0
cmovl eax, ebx
mov edi, 10
.loop:
dec rcx
xor edx, edx
idiv edi
add dl, '0'
mov byte[rcx], dl
cmp eax, 0
jne .loop
cmp ebx, 0
jle .print
dec rcx
mov byte[rcx], '-'
.print:
mov rsi, rcx
lea rcx, [rsp+16]
sub rcx, rsi
call write
add rsp, 16
ret
global _start
_start:
lea r12, [data_stack+STKSIZ]
lea rsp, [call_stack+STKSIZ]
call fun_0
call flush
mov rax, 60
mov rdi, 0
syscall
section .bss
data_stack: resq STKSIZ
call_stack: resq STKSIZ
"

{ emit variables }

"section .data" 10,

'a { iter <- a}
{ while iter != z+1}
[$ 'z1+ =~][
	"var_" $, ": dq 0" 10, { emit allocation }
	1+                     { increment iter }
]#
% { drop iter }

]?

ß