/*
 *  Neko Compiler
 *  Copyright (c)2005-2007 Motion-Twin
 *
 *  This library is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU Lesser General Public
 *  License as published by the Free Software Foundation; either
 *  version 2.1 of the License, or (at your option) any later version.
 *
 *  This library is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 *  Lesser General Public License or the LICENSE file for more details.
 */
open Lexer;
open Neko.Ast;

type context {
	ch : IO.input;
	strings : string array;
	mutable pos : Lexer.pos;
}

var parse_from_string : (string -> pos -> expr) ref = &(function(_,_) { assert() });

var header = "NBA\001";

function parse_string(ctx) {
	var index = IO.read_byte ctx.ch;
	if index == 0 then {
		var size = IO.read_ui16 ctx.ch;
		var str = IO.read ctx.ch size;
		Array.add ctx.strings str;
		str
	} else
		Array.get ctx.strings (Array.length ctx.strings - index)
}

function rec parse_list(ctx,f,n) {
	if n == 0 then
		[]
	else {
		var x = f ctx;
		x :: parse_list ctx f (n - 1);
	}
}

function parse_constant(ctx) {
	match IO.read_byte ctx.ch {
	| 0 -> True
	| 1 -> False
	| 2 -> Null
	| 3 -> This
	| 4 -> Int (IO.read_byte ctx.ch)
	| 5 -> Int (IO.read_i32 ctx.ch)
	| 6 -> Float (parse_string ctx)
	| 7 -> String (parse_string ctx)
	| 8 -> Builtin (parse_string ctx)
	| 9 -> Ident (parse_string ctx)
	| n -> error ("Invalid const tag : " + n)
	}
}

function parse_op(ctx) {
	match IO.read_byte ctx.ch {
	| 0 -> "+"
	| 1 -> "-"
	| 2 -> "/"
	| 3 -> "*"
	| 4 -> "%"
	| 5 -> "<<"
	| 6 -> ">>"
	| 7 -> ">>>"
	| 8 -> "|"
	| 9 -> "&"
	| 10 -> "^"
	| 11 -> "=="
	| 12 -> "!="
	| 13 -> ">"
	| 14 -> ">="
	| 15 -> "<"
	| 16 -> "<="
	| 17 -> "="
	| 18 -> "&&"
	| 19 -> "||"
	| 20 -> "++="
	| 21 -> "--="
	| 22 -> "+="
	| 23 -> "-="
	| 24 -> "/="
	| 25 -> "*="
	| 26 -> "%="
	| 27 -> "<<="
	| 28 -> ">>="
	| 29 -> ">>>="
	| 30 -> "|="
	| 31 -> "&="
	| 32 -> "^="
	| n -> error ("Invalid op tag "+n)
	}
}

function rec parse_field(ctx) {
	var name = parse_string ctx;
	(name,parse_expr ctx)
}

function rec parse_switch(ctx,n) {
	var e = parse_expr ctx;
	var l = parse_list ctx (function(ctx) {
		var e1 = parse_expr ctx;
		var e2 = parse_expr ctx;
		(e1,e2)
	}) n;
	var eo = parse_expr_opt ctx;
	ESwitch e l eo
}

function rec parse_expr_opt(ctx) {
	if IO.read_byte ctx.ch == 0 then
		None
	else
		Some (parse_expr ctx)
}

function rec parse_expr(ctx) {
	var n = IO.read_byte ctx.ch;
	if n < 2 then {
		var file = if n == 1 then ctx.pos.psource else parse_string ctx;
		var line = IO.read_ui24 ctx.ch;
		ctx.pos := { psource = file; pline = line; pmin = 0; pmax = 0; };
		parse_expr(ctx);
	} else {
		var pos = ctx.pos;
		(match n {
		| 2 ->
			EConst (parse_constant ctx)
		| 3 ->
			EBlock (parse_list ctx parse_expr (IO.read_byte ctx.ch))
		| 4 ->
			EBlock (parse_list ctx parse_expr (IO.read_ui24 ctx.ch))
		| 5 ->
			EParenthesis (parse_expr ctx)
		| 6 ->
			var e = parse_expr ctx;
			EField e (parse_string ctx)
		| 7 ->
			var e = parse_expr ctx;
			ECall e (parse_list ctx parse_expr (IO.read_byte ctx.ch))
		| 8 ->
			var e = parse_expr ctx;
			EArray e (parse_expr ctx)
		| 9 ->
			function parse_var(_) {
				var v = parse_string ctx;
				var e = parse_expr_opt ctx;
				(v,e);
			}
			EVars (parse_list ctx parse_var (IO.read_byte ctx.ch))
		| 10 ->
			var e1 = parse_expr ctx;
			var e2 = parse_expr ctx;
			EWhile e1 e2 NormalWhile
		| 11 ->
			var e1 = parse_expr ctx;
			var e2 = parse_expr ctx;
			EWhile e1 e2 DoWhile
		| 12 ->
			var e1 = parse_expr ctx;
			var e2 = parse_expr ctx;
			EIf e1 e2 (parse_expr_opt ctx)
		| 13 ->
			var e1 = parse_expr ctx;
			var str = parse_string ctx;
			ETry e1 str (parse_expr ctx)
		| 14 ->
			var vars = parse_list ctx parse_string (IO.read_byte ctx.ch);
			EFunction vars (parse_expr ctx)
		| 15 ->
			var op = parse_op ctx;
			var e1 = parse_expr ctx;
			var e2 = parse_expr ctx;
			EBinop op e1 e2
		| 16 ->
			EReturn None
		| 17 ->
			EReturn Some(parse_expr ctx)
		| 18 ->
			EBreak None
		| 19 ->
			EBreak Some(parse_expr ctx)
		| 20 ->
			EContinue
		| 21 ->
			var e1 = parse_expr ctx;
			var e2 = parse_expr ctx;
			ENext e1 e2
		| 22 ->
			EObject (parse_list ctx parse_field (IO.read_byte ctx.ch))
		| 23 ->
			EObject (parse_list ctx parse_field (IO.read_ui24 ctx.ch))
		| 24 ->
			ELabel (parse_string ctx)
		| 25 ->
			parse_switch ctx (IO.read_byte ctx.ch)
		| 26 ->
			parse_switch ctx (IO.read_ui24 ctx.ch)
		| 27 ->
			var str = IO.read ctx.ch (IO.read_ui24 ctx.ch);
			fst (*parse_from_string)(str,pos)
		| 28 ->
			var e = parse_expr ctx;
			ECall e (parse_list ctx parse_expr (IO.read_ui24 ctx.ch))
		| n ->
			error ("Invalid expr tag : " + n)
		},pos)
	}
}

function parse(ch,pos) {
	var ctx = {
		ch = ch;
		strings = Array.create();
		pos = pos;
	};
	if IO.read ctx.ch 4 != header then error "Invalid binast header";
	parse_expr(ctx);
}
