=begin
	MetaRuby / LGRAM serialization software
	Copyright 2001 by Mathieu Bouchard

	lgram/Marshal.rb: Parser and Unparser

	$Id: Marshal.rb,v 1.7 2001/09/18 03:02:26 matju Exp $

	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 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 for more details.

	You should have received a copy of the GNU Lesser General Public
	License along with this library; if not, write to the Free Software
	Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
=end

begin
	require "ToSource"
rescue LoadError
	require "../ToSource"
end

class ParseError < StandardError; end

class LGReader
	attr_accessor :finished
	attr_reader :byte, :line, :col

# category: base

	def initialize
		@s = ""
		@lists = [[]]
		@line,@col,@byte = 0,0,0
		@state = :Element
	end

	def tell(show_data=false)
		s = "byte=#{byte} line=#{line} col=#{col}"
		s << "s[0,4]=#{(@s[0,4]||'').inspect}" if show_data
		s
	end

	def input_file(f,chunksize=:by_line)
		case chunksize
		when :by_line; f.each {|s| input_string s }
		when :by_byte # reads byte-by-byte (5x slower)
			f.each {|s| f.each_byte {|b| input_string b.chr }}
		when :by_file; input_string(f.readlines.join("\n"))
		end
		eof
		@lists[0]
	end

	def input_string(s)
		s.each_byte {|x|
			input_byte(x)
			@byte += 1
			@col += 1
			(@line += 1; @col = 0) if x==0x0A
		}
	end

# category: format description support

	def self.char(*ranges)
		s = "proc {|x| "+ranges.map{|a|"(#{a})===x"}.join(" || ")+" }"
		p = eval s
		def p.===(x); self[x]; end
		p
	end

# category: character subsets

# section 1.1
	Whitespace = char( 0x09..0x0D, 0x20 )
	Verbatim   = char( 0x20..0x21, 0x23..0x5B, 0x5D..0x7E )
	HDigit     = char( 0x30..0x39, 0x41..0x46, 0x61..0x66 )
	DDigit     = char( 0x30..0x39 )
	EscQuote   = char( 0x22, 0x5C, 0x6E )
	FutureUse  = char( 0x23, 0x7B, 0x7D )
	SymbolBody = char( 0x21, 0x24..0x27, 0x2A..0x5B, 0x5D..0x7A, 0x7C, 0x7E )
	SymbolHead = char( 0x21, 0x24..0x27, 0x2A..0x2D, 0x2F, 0x3A..0x5A,
		0x5D..0x7A, 0x7C, 0x7E )

# category: parsing

	def input_byte(x)
#		printf "depth=%d @state = :%-9s x = %3d = %s\n", @lists.length, @state, x, x.chr.inspect
		case @state
		when :List
			case x
			when Whitespace; #ok
			when ?(; @lists<<[]; @state=:Element
			else raise ParseError, tell
			end
		when :Element
			case x
			when Whitespace; #ok
			when 0x22; @state=:String; @s=""
			when ?(; @state=:List; input_byte x
			when DDigit;     @state=:Number; @s=""; input_byte x
			when SymbolHead; @state=:Symbol; @s=""; input_byte x
			when ?)
				l = @lists.pop
				@lists.last<<l
			else raise ParseError, tell
			end
		when :String
			case x
			when Verbatim; @s<<x
			when 0x5C; @state=:Esc
			when 0x22; @lists.last<<@s; @state=:Element
			else raise ParseError, tell
			end
		when :Esc
			case x
			when EscQuote; @s<<x; @state=:String
			when Whitespace; @state=:EscSpace
			when ?x; @e="";@state=:EscChar
			#...
			else raise ParseError, tell
			end
		when :EscSpace
			case x
			when Whitespace; #ok
			when 0x5C; @state=:String
			else raise ParseError, tell
			end
		when :EscChar
			case x
			when HDigit
				@e<<x
				if @e.length==2 then
					@s<<Integer("0x"+@e).chr
					@state=:String
				end
			when ?{
				if @e==""
					then @state=:EscChar2
					else raise ParseError, tell end
			else raise ParseError, tell
			end
		when :EscChar2 # not Unicode-compliant (8-bit only here)
			case x
			when HDigit; @e<<x
			when ?}; @s<<(Integer("0x"+@e) & 0xff).chr; @state=:String
			else raise ParseError, tell
			end
		when :Number
			case x
			when DDigit, ?+, ?-, ?e, ?E, ?.
				@s<<x
			when Whitespace, ?)
				@lists.last << (if @s["."] or @s["e"]
					then   Float(@s)
					else Integer(@s) end)
				@state=:Element; input_byte x
			else raise ParseError, tell
			end			
		when :Symbol
			case x
			when DDigit, ?.
				if @s.length==1 and (@s=="+" or @s=="-") then
					@state=:Number; return input_byte x
				else
					@s<<x
				end
			when SymbolBody; @s<<x
			when Whitespace, ?)
				@lists.last<<@s.intern
				@state=:Element
				input_byte x
			else raise ParseError, tell
			end
		else
			raise "big problem: @state=#{@state}"
		end
	end

	# call this when there are no more characters
	def eof
		if @lists.length>1 then
			raise ParseError, tell
		end
	end
end

class LGReaderToTree < LGReader
	#...
end

class LGWriter
	def initialize(output_stream=STDOUT)
		@output_stream = output_stream
		using =
		#	RubySourceWriter
			LispSourceWriter
		@tt = TreeTraversal.new(using.new(@output_stream))
	end
	def dump(data)
		@tt.write data
		@tt.writer.flush
		@output_stream
	end
end

if $0==__FILE__
	filename = "test1.lg"
	File.open(filename) {|f|
		lgr = LGReaderToTree.new
		data = lgr.input_file f
	exit
		puts "-"*72
		p data
		lgw = LGWriter.new(dumpling="")
		lgw.dump(data)
		lgr = LGReaderToTree.new
		data2 = lgr.input_file dumpling
		puts "-"*72
		p data2
		puts "-"*72
	}
end
