;
; A brainf* interpreter in LITTLE.
; It is not THAT short, and not THAT performant, but hey ...!
; It proves LITTLE's Turing completeness, and that IS something,
; isn't it?
;
(package bf)

(using
	little.lang.Array
	little.lang.Char
	little.lang.Exception
	little.lang.InstantiableObject
	little.lang.Object
	little.lang.System
	little.lang.container.LinkedList
	little.io.File
	little.io.TextInputStream
	little.io.TextOutputStream)

;
; A BRAINF* instruction. It consists of an action to perform,
; and a specification how to continue the program.
;
(class Instruction (InstantiableObject) :abstract

	(attribute
		i:static ;last instruction index
		i	 ;instruction index in code stream
		next     ;next instruction in stream
		)

	(method i (i) :static
		(set self:i i))

	(method i () :static
		(set self:i (self:i:succ)))

	(method init ()
		(set self:i (Instruction:i))
		self)

	(method init (next)
		(set self:i (Instruction:i))
		(set self:next next)
		self)

	(method exec () :abstract)
	(method next () self:next)
	(method next (ins)
		(set self:next ins))
	(method continuation ()
		(self:next))
	(method serial ()
		self:i)

	(method print ()
		((TextOutputStream:out):println (self:serial) (self:memnonic)))

)

;
; The pointer increment instruction.
;
(class PInc (Instruction)
	(method exec ()
		(Engine:pinc))
	(method memnonic () ">")
)

;
; The pointer decrement instruction.
;
(class PDec (Instruction)
	(method exec ()
		(Engine:pdec))
	(method memnonic () "<")
)

;
; The value-at-pointer increment instruction.
;
(class Inc (Instruction)
	(method exec ()
		(Engine:inc))
	(method memnonic () "+")
)

;
; The value-at-pointer decrement instruction.
;
(class Dec (Instruction)
	(method exec ()
		(Engine:dec))
	(method memnonic () "-")
)

;
; The input instruction.
;
(class In (Instruction)
	(method exec ()
		(Engine:in))
	(method memnonic () ",")
)

;
; The output instruction.
;
(class Out (Instruction)
	(method exec ()
		(Engine:out))
	(method memnonic () ".")
)

;
; The jump-if-zero instruction.
;
(class JZ (Instruction)
	(attribute branch)
	(method continuation ()
		(if (Engine:v)
			(self:next)
			(self:branch)))
	(method branch ()
		self:branch)
	(method branch (ins)
		(set self:branch ins))
	(method exec () nil)
	(method memnonic () "[")
	(method print ()
		((TextOutputStream:out):println (self:serial) (self:memnonic) ((self:branch):serial)))
		
)

;
; The jump-if-not-zero instruction.
;
(class JNZ (Instruction)
	(attribute branch)
	(method continuation ()
		(if (Engine:v)
			(self:branch)
			(self:next)))
	(method branch ()
		self:branch)
	(method branch (ins)
		(set self:branch ins))
	(method exec () nil)
	(method memnonic () "]")
	(method print ()
		((TextOutputStream:out):println (self:serial) (self:memnonic) ((self:branch):serial)))
)
			
;
; The interpreter execution engine.
;
(class Engine (Object)

	(attribute
		cs:static ; Code segment
		cp:static ; pointer to last instruction - used by method compile()
		ds:static ; data array
		p:static  ; pointer into data array
		in:static ; input stream
		out:static; output stream
		)

	(method init ():static
		(set self:ds (Array:new 30000))
		(self:reset)
		(set self:in (TextInputStream:in))
		(set self:out (TextOutputStream:out))
		self)

	;
	; Increments the pointer.
	;
	(method pinc () :static
		;(*test.Debug:printsym 'pinc)
		(set self:p (self:p:succ)))
	;
	; Decrements the pointer.
	;
	(method pdec () :static
		;(*test.Debug:printsym 'pdec)
		(set self:p (self:p:pred)))
	;
	; Increments the value at pointer.
	;
	(method inc () :static
		;(*test.Debug:printsym 'inc)
		(let ((i (self:ds:get self:p)))
			(self:ds:put self:p (i:succ))))
	;
	; Decrements the value at pointer.
	;
	(method dec () :static
		;(*test.Debug:printsym 'dec)
		(let ((i (self:ds:get self:p)))
			(self:ds:put self:p (i:pred))))
	;
	; Inputs a value to the cell below pointer.
	;
	(method in () :static
		;(*test.Debug:printsym 'in)
		(let ((c (self:in:readChar)))
			(if c
				(self:ds:put self:p (c:getcode))
				(self:ds:put self:p 0))))
	;
	; Outputs the value at pointer.
	;
	(method out () :static
		;(*test.Debug:printsym 'out)
		(self:out:printChar (Char:from (self:ds:get self:p))))
	;
	; Returns the value at pointer.
	;
	(method v () :static
		(self:ds:get self:p))
	;
	; Adds an instruction to the code segment.
	;
	(method add (ins) :static
		(if self:cp
			(prog
				(self:cp:next ins)
				(set self:cp ins))
			(set self:cs (set self:cp ins)))
		ins)
	;
	; Compiles a source file into internal representation (a sequence
	; of instructions, represented by instances of class Instruction's descendants)
	;
	(method compile (file label) :static
		(let ((c nil))
			(while (set c (file:readChar))
				(cond
					((c:equals ">"c)
						(self:add (PInc:new)))
					((c:equals "<"c)
						(self:add (PDec:new)))
					((c:equals "+"c)
						(self:add (Inc:new)))
					((c:equals "-"c)
						(self:add (Dec:new)))
					((c:equals "."c)
						(self:add (Out:new)))
					((c:equals ","c)
						(self:add (In:new)))
					((c:equals "["c)
						(let ((ins (JZ:new)))
							(self:add ins)
							(self:compile file ins)
							(ins:branch self:cp)))
					((c:equals "]"c)
						(if label
							(let ((ins (JNZ:new)))
								(ins:branch label)
								(self:add ins)
								(return nil))
							((Exception:new 'MissingLoopStart):throw)))
					((c:isspace)
						nil)
					(true
						nil)))))
						;((Exception:new 'IllegalBrainfuckOp):throw))))))
	;
	; Resets the engine, ie. erases the program, and resets the data segment.
	;
	(method reset () :static
		(let ((i 0))
			(while (i:lt 30000)
				(self:ds:put i 0)
				(set i (i:succ))))
		(set self:cs nil)
		(set self:cp nil)
		(set self:p 0)
		(Instruction:i 0))
	;
	; Runs the current code snippet.
	;
	(method run () :static
		(let ((ins self:cs))
			(while ins
				(ins:exec)
				(set ins (ins:continuation)))))

	;
	; Runs a Brainfuck file.
	;
	(method run (file) :static
		(self:reset)
		(self:compile file nil)
		(self:run))
	;
	; The entry point.
	;
	(method main () :static
		(let ((arguments (System:arguments))  (file nil))
			(while (arguments:hasMoreElements)
				(try
					(set file (TextInputStream:new (File:new (arguments:nextElement))))
					(self:run file)
				 catch (e)
					(self:out:println "Error:" e)))))

)