SNOBOL4 program to compile arithmetic expressions to Brainfuck/Ook!

exp2ook.sc

# Snocone version (obscure C-like SNOBOL preprocessor)

stack = array(10); sp = 0

procedure push()
{
	nreturn .stack[sp = sp + 1]
}

procedure pop()
{
	pop = stack[sp]
	sp = sp - 1
}

procedure printstack() i
{
	for (i = sp, i > 0, i = i - 1)
		output = stack[i]
}

struct op {r, type, l}

procedure binop() new
{
	new = op(pop(), pop(), pop())
	push() = new
}

space = span(" ") | ""
pre = space && "(" && *exp && space && ")" | space && span("0123456789") $ *push()
post = space && any("+-") $ *push() && *exp && *binop() |
       space && any("*/") $ *push() && pre && *binop() && *post | ""
exp = pre && post

&anchor = 1

for (i = host(3), host(2, i) ? "-", i = i + 1) {}
if (~host(2, i)) {
	terminal = "No expression specified!"
	go to end
}

if (~(trim(host(2, i)) ? exp && rpos(0))) {
	terminal = "Invalid expression!"
	go to end
}

procedure eval(node) left, right
{
	if (datatype(node) :!=: .op)
		return convert(node, "integer")

	left = eval(l(node))
	right = eval(r(node))

	type(node) ? "+" && *?(eval = left + right) |
		     "-" && *?(eval = left - right) |
		     "*" && *?(eval = left * right) |
		     "/" && *?(eval = left / right)
}

#output = eval(stack[1])

procedure compile(node) o
{
	if (datatype(node) :!=: .op)
		return dupl("+", node)

	compile = compile(l(node)) && ">" && compile(r(node))

	type(node) ? any("+-") $ o && *?(compile = compile && "[<" && o && ">-]<") | # a0 += a1 | a0 -= a1
		     "*" && *?(compile = ">>" && compile && "[<[<+<+>>-]<[>+<-]>>-]<[-]<<") | # a0 *= a1
		     "/" && *?(compile = ">" && compile && "<[->->+>>+<<<[>>+>[-]<<<-]>>[<<+>>-]>[-<<[<+>-]<<<+>>>>>]<<<<]>[-]>[-]<<<") # a0 /= a1
}

src = compile(stack[1]) &&
     "[>++++++++++<[->->+>>+<<<[>>+>[-]<<<-]>>[<<+>>-]>[-<<[<+>-]>>>+<]<<<<]>>>>>[<<<<<+>>>>>-]>[>]" &&
     dupl("+", 48) && "[<]<<<[>>>>[>]<+[<]<<<-]<[-]<]>>>>>>[>]<[.<]"

if (host(2, host(3)) :==: "-bf") {
	output = src
} else {
	output(.term, 6, "t")

	src ? arbno("+" && *?(term = "Ook. Ook. ") |
		    "-" && *?(term = "Ook! Ook! ") |
		    ">" && *?(term = "Ook. Ook? ") |
		    "<" && *?(term = "Ook? Ook. ") |
		    "[" && *?(term = "Ook! Ook? ") |
		    "]" && *?(term = "Ook? Ook! ") |
		    "." && *?(term = "Ook! Ook. ") |
		    len(1)) && rpos(0)
}

exp2ook.sno

#!/usr/local/bin/snobol4 -b

*	Arithmetic expression to Brainfuck/Ook! compiler
*	./exp2ook.sno [-bf] "expression"
*	Compiles "expression" and prints Ook! source to stdout
*	"-bf" prints the Brainfuck source only
*	The compiled programs calculate the result and display it (ASCII letters)

EXP2OOK	CODE('EXP2OOK')
	DEFINE('PUSH()')
	DEFINE('POP()')
	DEFINE('BINOP()NEW')
	DEFINE('COMPILE(NODE)O')

	DATA('OP(R,TYPE,L)')

	&ANCHOR = 1
	&FULLSCAN = 1

	SPACE = SPAN(" ") | ""
	PRE = SPACE ("(" *EXP SPACE ")" | SPAN("0123456789") $ *PUSH())
	POST = SPACE (ANY("+-") $ *PUSH() *EXP *BINOP() |
+		      ANY("*/") $ *PUSH() PRE *BINOP() *POST) | ""
	EXP = PRE POST

	I = HOST(3)
L.3	HOST(2, I) "-" :F(L.4)
	I = I + 1 :(L.3)
L.4	HOST(2, I) :S(L.5)
	TERMINAL = "No expression specified!" :(END)

L.5	STACK = ARRAY(10)
	SP = 0

	TRIM(HOST(2, I)) EXP RPOS(0) :S(L.6)
	TERMINAL = "Invalid expression!" :(END)

L.6	SRC = COMPILE(STACK<1>)
+	      "[>++++++++++<[->->+>>+<<<[>>+>[-]<<<-]>>[<<+>>-]"
+	      ">[-<<[<+>-]>>>+<]<<<<]>>>>>[<<<<<+>>>>>-]>[>]" DUPL("+",ORD("0"))
+	      "[<]<<<[>>>>[>]<+[<]<<<-]<[-]<]>>>>>>[>]<[.<]"

	LEQ(HOST(2, HOST(3)), "-bf") :F(L.9)
	OUTPUT = SRC :(END)

L.9	OUTPUT(.TERM, 6, "T")
	SRC ARBNO("+" *?(TERM = "Ook. Ook. ") |
+		  "-" *?(TERM = "Ook! Ook! ") |
+		  ">" *?(TERM = "Ook. Ook? ") |
+		  "<" *?(TERM = "Ook? Ook. ") |
+		  "[" *?(TERM = "Ook! Ook? ") |
+		  "]" *?(TERM = "Ook? Ook! ") |
+		  "." *?(TERM = "Ook! Ook. ") | LEN(1)) RPOS(0) :(END)

*	PROCEDURES

PUSH	PUSH = .STACK<SP = SP + 1> :(NRETURN)
POP	POP = STACK<SP>
	SP = SP - 1 :(RETURN)

BINOP	NEW = OP(POP(), POP(), POP())
	PUSH() = NEW :(RETURN)

COMPILE	LEQ(DATATYPE(NODE), .OP) :S(L.8)
	COMPILE = DUPL("+", NODE) :(RETURN)
L.8	COMPILE = COMPILE(L(NODE)) ">" COMPILE(R(NODE))
	TYPE(NODE) ANY("+-") $ O *?(COMPILE = COMPILE "[<" O ">-]<") |
+		   "*" *?(COMPILE = ">>" COMPILE "[<[<+<+>>-]<[>+<-]>>-]<[-]<<") |
+		   "/" *?(COMPILE = ">" COMPILE "<[->->+>>+<<<[>>+>[-]<<<-]>>"
+			  "[<<+>>-]>[-<<[<+>-]<<<+>>>>>]<<<<]>[-]>[-]<<<") :(RETURN)

END	EXP2OOK