variable_id

varid.e

include std/io.e
include std/error.e
include std/pretty.e
include std/types.e

constant NULL = 0

ifdef EUI then

	include euphoria/debug/debug.e
	include euphoria/symstruct.e

	-- Initialize the debugger.
	debug:initialize_debugger( machine_func(M_INIT_DEBUGGER,{}) )

	-- Convert a variable ID back to its symtab pointer.
	function get_symbol_pointer( integer id )

		atom symtab = get_symbol_table()
		atom symlen = peek_pointer( symtab )

		if id < 0 or symlen <= id then
			error:crash( "invalid variable id" )
		end if

		return symtab + (ST_ENTRY_SIZE * id)
	end function

	-- Turn off inlining, which can hide symbols.
	without inline

end ifdef

--**
-- Locate a variable starting from the current point in the program.
--
-- Parameters:
--   # ##name## : a **sequence**, the name of a variable in the calling scope.
--
-- Returns:
--   If the symbol identified by ##name## is a variable and that variable is in the calling scope,
--   the return value is the ID of the variable in the symbol table. If the symbol name does not
--   exist, is not a variable, or is not in the calling scope, the return value will be ##-1##.
--
-- Comments:
--   This function can only locate variables defined in the scope from which it was called.
--
-- Example 1:
-- <eucode>
-- sequence foo = {1,2,3,4}
-- ? variable_id("foo") -- prints an ID >= 0
-- ? variable_id("bar") -- prints -1 ("bar" does not exit)
-- </eucode>
--
public function variable_id( sequence name )

ifdef EUI then

	if not types:string( name ) then
		error:crash( "name must be a string" )
	end if

	-- We need to use debugger_call_stack() as it returns the required CS_GLINE and CS_PC values for
	-- symbol_lookup().
	sequence cs = debug:debugger_call_stack()

	-- Start at looking at level 2 because level 1 is the call to debugger_call_stack() itself.
	for i = 2 to length( cs ) do

		-- CS_GLINE is the global source line, which translates to the specific line number in the
		-- original source file.
		integer gline = cs[i][CS_GLINE]

		-- CS_PC is the program counter which is where we "are" in the program. This will translate
		-- to the routine at this point in the stack via Locate() function in be_symtab.c@L123.
		atom pc = cs[i][CS_PC]

		-- Lookup the symbol starting at this point in the stack.
		atom sym = debug:symbol_lookup( name, gline, pc )

		if sym and debug:is_variable( sym ) then

			-- Get the base address of the symbol table.
			atom symtab = get_symbol_table()

			-- Return the actual "ID" of the symbol, which is its 0-based index in the symbol table.
			return floor( (sym - symtab) / ST_ENTRY_SIZE )

		end if

	end for

end ifdef

	return -1
end function

--**
-- Determine if a variable has been assigned a value.
--
-- Parameters:
--   # ##sym## : an **integer**, an ID number returned from [[:variable_id]].
--
-- Returns:
--   If the symbol ID is a variable and it has value, the return value is ##TRUE## (1). Otherwise
--   the return value is ##FALSE## (0).
--
-- Example 1:
-- <eucode>
-- sequence foo = {1,2,3,4}
-- atom bar -- not assigned
-- ? has_value("foo") -- prints 1
-- ? has_value("bar") -- prints 0
-- ? has_value("baz") -- prints 0
-- </eucode>
--
public function has_value( integer id )

ifdef EUI then

	atom sym = get_symbol_pointer( id )

	if debug:is_variable( sym ) then
		return not debug:is_novalue( sym )
	end if

end ifdef

	return FALSE
end function

--**
-- Get the value of a variable in the symbol table.
--
-- Parameters:
--   # ##sym## : an **integer**, an ID number returned from [[:variable_id]].
--
-- Returns:
--   If the symbol ID is a variable and it has value, the return value is the value of the object
--   in the symbol table. Otherwise the application will crash with the relevant error message. Use
--   [[:has_value]] first to prevent a crash.
--
-- Example 1:
-- <eucode>
-- sequence foo = {1,2,3,4}
-- integer foo_id = variable_id("foo")
-- ? get_value(foo_id) -- prints {1,2,3,4}
-- integer bar_id = variable_id("bar")
-- ? get_value(bar_id) -- crashes with "invalid variable id"
-- </eucode>
--
public function get_value( integer id )

	object value

ifdef EUI then

	atom sym = get_symbol_pointer( id )

	-- The following error checks should not be necessary if you're using variable_id() first. But
	-- you could call get_value() with any other integer that could fall into the symtab range.

	if not debug:is_variable( sym ) then
		error:crash( "symbol is not a variable" )

	elsif debug:is_novalue( sym ) then
		error:crash( "symbol does not have a value" )

	end if

	value = debug:read_object( sym )

end ifdef

	return value
end function

--** An "inline" format for pretty_print()
public sequence PRETTY_INLINE = PRETTY_DEFAULT
PRETTY_INLINE[DISPLAY_ASCII] = 2 -- print strings
PRETTY_INLINE[LINE_BREAKS]   = 0 --no line breaks

--**
-- Pretty-print a variable to STDERR for debugging.
--
-- Parameters:
--   # ##name## : a **sequence**, the name of the variable to print.
--   # ##options## : the formatting options used by [[:pretty_print]].
--
-- Comments:
--   If a variable with ##name## is not found, ##"<not found>"## will be printed. If the variable
--   does not have a value, ##"<no value>"## will be printed. Otherwise, the value will be printed
--   using the specified ##options##. The default ##options## is will print values in an "inline"
--   format (without line breaks) and will attempt to print sequences as strings.
--
-- Example 1:
-- <eucode>
-- sequence foo = {1,2,3,4}
-- atom bar -- not assgined
-- print_var("foo") -- prints "foo = {1,2,3,4}\n"
-- print_var("bar") -- prints "bar = <no value>\n"
-- print_var("baz") -- prints "baz = <not found>\n"
-- </eucode>
--
public procedure print_var( sequence name, sequence options=PRETTY_INLINE )

ifdef EUI then

	integer id = variable_id( name )

	if id = -1 then
		printf( STDOUT, "%s = <not found>\n", {name} )

	elsif not has_value( id ) then
		printf( STDOUT, "%s = <no value>\n", {name} )

	else
		printf( STDOUT, "%s = ", {name} )
		pretty_print( STDOUT, get_value(id), options )
		puts( STDOUT, "\n" )

	end if

end ifdef

end procedure

vartest.ex

include varid.e

procedure main()

	integer one = 1
	atom two = 0.2
	sequence three = {one,two,"three"}
	object four

	print_var( "one" )   -- 1
	print_var( "two" )   -- 0.2
	print_var( "three" ) -- {1,0.2,"three"}
	print_var( "four" )  -- <no value>
	print_var( "five" )  -- <not found>

end procedure

main()