/src/tools/liberty_universe.e
http://github.com/tybor/Liberty · Specman e · 1353 lines · 1207 code · 126 blank · 20 comment · 46 complexity · ff46476357431ba4f89d4e8e520646dd MD5 · raw file
- -- This file is part of Liberty Eiffel.
- --
- -- Liberty Eiffel is free software: you can redistribute it and/or modify
- -- it under the terms of the GNU General Public License as published by
- -- the Free Software Foundation, version 3 of the License.
- --
- -- Liberty Eiffel 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 General Public License for more details.
- --
- -- You should have received a copy of the GNU General Public License
- -- along with Liberty Eiffel. If not, see <http://www.gnu.org/licenses/>.
- --
- class LIBERTY_UNIVERSE
- insert
- LIBERTY_ERROR_LEVELS
- undefine is_equal
- end
- LIBERTY_AST_HANDLER
- undefine is_equal
- end
- LIBERTY_ERROR_LEVELS
- undefine is_equal
- end
- SINGLETON
- LOGGING
- undefine is_equal
- end
- create {ANY}
- make
- feature {ANY}
- get_type (cluster: LIBERTY_CLUSTER; position: LIBERTY_POSITION; class_name: FIXED_STRING; effective_type_parameters: TRAVERSABLE[LIBERTY_ACTUAL_TYPE]): LIBERTY_ACTUAL_TYPE is
- require
- position /= Void
- do
- Result := do_get_type(cluster, position, class_name, effective_type_parameters)
- ensure
- Result.name.is_equal(class_name)
- same_parameters(Result.parameters, effective_type_parameters)
- end
- parse_expression (a_expression: STRING; when_error: PROCEDURE[TUPLE[PARSE_ERROR]]): LIBERTY_AST_EXPRESSION is
- require
- a_expression /= Void
- when_error /= Void
- do
- Result ::= partial_parse(a_expression, once "Expression", when_error)
- end
- parse_instruction (a_instruction: STRING; when_error: PROCEDURE[TUPLE[PARSE_ERROR]]): LIBERTY_AST_INSTRUCTION is
- require
- a_instruction /= Void
- when_error /= Void
- do
- Result ::= partial_parse(a_instruction, once "Instruction", when_error)
- end
- build_types (root_type: LIBERTY_ACTUAL_TYPE; root_feature_name: LIBERTY_FEATURE_NAME; target_type: LIBERTY_ACTUAL_TYPE) is
- require
- target_type /= Void
- local
- flame: LIBERTY_FLAME
- incubator: like types_incubator
- do
- if not target_type.is_built then
- create incubator.with_capacity(1024, 0) --|TODO optim: replace by an attribute
- from
- until
- types_incubator.is_empty or else target_type.is_built
- loop
- flame := torch.flame
- build_to_incubator(incubator, target_type)
- mark_reachable_code(root_type, root_feature_name)
- resolve_delayed_types
- if types_incubator.is_empty then
- incubator := check_flame_and_swap_incubator(flame, incubator)
- end
- end
- if not incubator.is_empty then
- -- don't lose work
- types_incubator.append_traversable(incubator)
- end
- debug ("type.building")
- debug_types(types_incubator)
- if target_type.is_built then
- log.trace.put_string(once "Type is ready: ")
- log.trace.put_line(target_type.full_name)
- else
- log.trace.put_string(once "Type is NOT READY: ")
- log.trace.put_line(target_type.full_name)
- breakpoint
- end
- end
- end
- ensure
- target_type.is_built
- end
- feature {ANY} -- Kernel types
- type_any: LIBERTY_ACTUAL_TYPE is
- require
- not errors.has_error
- once
- Result := kernel_type("ANY".intern, visit_type_any)
- end
- type_arguments: LIBERTY_ACTUAL_TYPE is
- require
- not errors.has_error
- once
- Result := kernel_type("ARGUMENTS".intern, visit_type_arguments)
- end
- type_platform: LIBERTY_ACTUAL_TYPE is
- require
- not errors.has_error
- once
- Result := kernel_type("PLATFORM".intern, visit_type_platform)
- end
- type_pointer: LIBERTY_ACTUAL_TYPE is
- require
- not errors.has_error
- once
- Result := kernel_type("POINTER".intern, visit_type_pointer)
- end
- type_integer_64: LIBERTY_ACTUAL_TYPE is
- require
- not errors.has_error
- once
- Result := kernel_type("INTEGER_64".intern, visit_type_integer_64)
- Result.add_converter(type_real_128, convert_integer_64_real_128)
- Result.add_converter(type_real_80, convert_integer_64_real_80)
- Result.set_may_promote_current
- end
- type_integer, type_integer_32: LIBERTY_ACTUAL_TYPE is
- require
- not errors.has_error
- once
- Result := kernel_type("INTEGER_32".intern, visit_type_integer_32)
- Result.add_converter(type_integer_64, convert_integer_32_64)
- Result.add_converter(type_real_128, convert_integer_32_real_128)
- Result.add_converter(type_real_80, convert_integer_32_real_80)
- Result.add_converter(type_real_64, convert_integer_32_real_64)
- Result.set_may_promote_current
- end
- type_integer_16: LIBERTY_ACTUAL_TYPE is
- require
- not errors.has_error
- once
- Result := kernel_type("INTEGER_16".intern, visit_type_integer_16)
- Result.add_converter(type_integer_32, convert_integer_16_32)
- Result.add_converter(type_integer_64, convert_integer_16_64)
- Result.add_converter(type_real_128, convert_integer_16_real_128)
- Result.add_converter(type_real_80, convert_integer_16_real_80)
- Result.add_converter(type_real_64, convert_integer_16_real_64)
- Result.add_converter(type_real_32, convert_integer_16_real_32)
- Result.set_may_promote_current
- end
- type_integer_8: LIBERTY_ACTUAL_TYPE is
- require
- not errors.has_error
- once
- Result := kernel_type("INTEGER_8".intern, visit_type_integer_8)
- Result.add_converter(type_integer_16, convert_integer_8_16)
- Result.add_converter(type_integer_32, convert_integer_8_32)
- Result.add_converter(type_integer_64, convert_integer_8_64)
- Result.add_converter(type_real_128, convert_integer_8_real_128)
- Result.add_converter(type_real_80, convert_integer_8_real_80)
- Result.add_converter(type_real_64, convert_integer_8_real_64)
- Result.add_converter(type_real_32, convert_integer_8_real_32)
- Result.set_may_promote_current
- end
- type_real_128: LIBERTY_ACTUAL_TYPE is
- require
- not errors.has_error
- once
- Result := kernel_type("REAL_128".intern, visit_type_real_128)
- Result.set_may_promote_current
- end
- type_real_80: LIBERTY_ACTUAL_TYPE is
- require
- not errors.has_error
- once
- Result := kernel_type("REAL_80".intern, visit_type_real_80)
- Result.add_converter(type_real_128, convert_real_80_128)
- Result.set_may_promote_current
- end
- type_real, type_real_64: LIBERTY_ACTUAL_TYPE is
- require
- not errors.has_error
- once
- Result := kernel_type("REAL_64".intern, visit_type_real_64)
- Result.add_converter(type_real_80, convert_real_64_80)
- Result.add_converter(type_real_128, convert_real_64_128)
- Result.set_may_promote_current
- end
- type_real_32: LIBERTY_ACTUAL_TYPE is
- require
- not errors.has_error
- once
- Result := kernel_type("REAL_32".intern, visit_type_real_32)
- Result.add_converter(type_real_64, convert_real_32_64)
- Result.add_converter(type_real_80, convert_real_32_80)
- Result.add_converter(type_real_128, convert_real_32_128)
- Result.set_may_promote_current
- end
- type_character: LIBERTY_ACTUAL_TYPE is
- require
- not errors.has_error
- once
- Result := kernel_type("CHARACTER".intern, visit_type_character)
- end
- type_string: LIBERTY_ACTUAL_TYPE is
- require
- not errors.has_error
- once
- Result := kernel_type("STRING".intern, visit_type_string)
- end
- type_boolean: LIBERTY_ACTUAL_TYPE is
- require
- not errors.has_error
- once
- Result := kernel_type("BOOLEAN".intern, visit_type_boolean)
- end
- type_native_array (effective_generics: TRAVERSABLE[LIBERTY_TYPE]; position: LIBERTY_POSITION): LIBERTY_ACTUAL_TYPE is
- require
- not errors.has_error
- local
- td: LIBERTY_TYPE_DESCRIPTOR
- ast: LIBERTY_AST_ONE_CLASS
- do
- create td.make(native_array_class_descriptor, effective_generics)
- Result := types.reference_at(td)
- if Result = Void then
- ast := parse_class(td.cluster, td.name, Void)
- create Result.make(td, standard_generics_checker, ast, visit_type_native_array)
- start_to_build_type(Result)
- end
- ensure
- Result /= Void
- end
- type_tuple (effective_generics: TRAVERSABLE[LIBERTY_TYPE]; position: LIBERTY_POSITION): LIBERTY_ACTUAL_TYPE is
- require
- effective_generics /= Void
- not errors.has_error
- local
- td: LIBERTY_TYPE_DESCRIPTOR
- tuple_ast: LIBERTY_AST_CLASSES
- ast: LIBERTY_AST_ONE_CLASS
- tuple_count: INTEGER
- do
- tuple_count := effective_generics.count
- create td.make(tuple_class_descriptor, effective_generics)
- Result := types.reference_at(td)
- if Result = Void then
- tuple_ast := parse_tuple_classes(Void)
- check tuple_ast.classes.lower = 0 end
- if tuple_count > tuple_ast.classes.upper then
- errors.add_position(position)
- errors.set(level_fatal_error, "TUPLE does not support more than " + tuple_ast.classes.upper.out
- + " generic parameters.%NYou might want a named class with named attributes instead.")
- end
- ast ::= tuple_ast.classes.item(tuple_count)
- create Result.make(td, tuple_generics_checker, ast, visit_type_tuple)
- start_to_build_type(Result)
- end
- ensure
- Result /= Void
- end
- type_routine (effective_generics: TRAVERSABLE[LIBERTY_TYPE]; position: LIBERTY_POSITION): LIBERTY_ACTUAL_TYPE is
- require
- effective_generics /= Void
- do
- Result := agent_type(routine_class_descriptor, {FAST_ARRAY[LIBERTY_TYPE] << type_tuple(effective_generics, position) >> }, position, visit_type_routine)
- end
- type_procedure (effective_generics: TRAVERSABLE[LIBERTY_TYPE]; position: LIBERTY_POSITION): LIBERTY_ACTUAL_TYPE is
- require
- effective_generics /= Void
- do
- Result := agent_type(procedure_class_descriptor, {FAST_ARRAY[LIBERTY_TYPE] << type_tuple(effective_generics, position) >> }, position, visit_type_procedure)
- end
- type_function (effective_generics: TRAVERSABLE[LIBERTY_TYPE]; result_type: LIBERTY_TYPE; position: LIBERTY_POSITION): LIBERTY_ACTUAL_TYPE is
- require
- effective_generics /= Void
- result_type /= Void
- do
- Result := agent_type(function_class_descriptor, {FAST_ARRAY[LIBERTY_TYPE] << type_tuple(effective_generics, position), result_type >> }, position, visit_type_function)
- end
- type_predicate (effective_generics: TRAVERSABLE[LIBERTY_TYPE]; position: LIBERTY_POSITION): LIBERTY_ACTUAL_TYPE is
- require
- effective_generics /= Void
- do
- Result := agent_type(predicate_class_descriptor, {FAST_ARRAY[LIBERTY_TYPE] << type_tuple(effective_generics, position) >> }, position, visit_type_predicate)
- end
- feature {} -- Partial parsing of command-line buffer (for the debugger and REPL)
- partial_parse (a_entry, a_root_atom_name: STRING; when_error: PROCEDURE[TUPLE[PARSE_ERROR]]): LIBERTY_AST_NON_TERMINAL_NODE is
- require
- a_entry /= Void
- when_error /= Void
- local
- evaled: BOOLEAN
- do
- parser_buffer.initialize_with(a_entry)
- eiffel.reset
- evaled := parser.eval(parser_buffer, eiffel.table, a_root_atom_name)
- if evaled then
- if parser.error /= Void then
- when_error.call([parser.error])
- else
- Result ::= eiffel.root_node
- end
- end
- end
- feature {}
- reachable_counter: COUNTER is
- once
- create Result
- end
- mark_reachable_code (root_type: LIBERTY_ACTUAL_TYPE; root_feature_name: LIBERTY_FEATURE_NAME) is
- local
- root_feature: LIBERTY_FEATURE_DEFINITION
- do
- reachable_counter.increment
- root_type.set_reachable(reachable_counter.value)
- if root_type.has_loaded_features then
- if not root_type.has_feature(root_feature_name) then
- errors.set(level_fatal_error,
- "Am I blind or what? I cannot find any method '" + root_feature_name.name
- + "' feature in the type " + root_type.full_name + "!")
- die_with_code(1)
- end
- root_feature := root_type.feature_definition(root_feature_name)
- reachable_counter.increment
- debug ("mark.reachable")
- log.trace.put_string(once " +++ Marking reachable code (")
- log.trace.put_integer(reachable_counter.value)
- log.trace.put_line(once ")...")
- end
- root_feature.set_reachable(reachable_counter.value)
- debug ("mark.reachable")
- log.trace.put_line(once " Reachable code marked.")
- end
- end
- end
- resolve_delayed_types is
- local
- delayed_types: COLLECTION[LIBERTY_DELAYED_TYPE]
- delayed_type: LIBERTY_DELAYED_TYPE
- i, n: INTEGER; more: BOOLEAN
- do
- delayed_types := type_lookup.resolver.delayed_types
- from
- more := True
- until
- not more or else delayed_types.is_empty
- loop
- more := False
- from
- n := delayed_types.count
- until
- n = 0
- loop
- delayed_type := delayed_types.first
- delayed_types.remove_first
- check
- not delayed_type.is_known
- end
- if delayed_type.can_resolve then
- delayed_type.resolve
- debug ("type.resolution")
- log.trace.put_string(once " ===> resolved ")
- log.trace.put_line(delayed_type.out)
- end
- more := True
- else
- delayed_types.add_last(delayed_type)
- end
- n := n - 1
- end
- end
- debug ("type.resolution")
- log.trace.put_line(once "======================================================================")
- from
- i := delayed_types.lower
- until
- i > delayed_types.upper
- loop
- log.trace.put_line(delayed_types.item(i).out)
- i := i + 1
- end
- log.trace.put_string(once " === ")
- log.trace.put_integer(delayed_types.count)
- if delayed_types.count = 1 then
- log.trace.put_line(once " delayed type yet to be resolved.")
- else
- log.trace.put_line(once " delayed types yet to be resolved.")
- end
- end
- end
- build_to_incubator (incubator: like types_incubator; target_type: LIBERTY_ACTUAL_TYPE) is
- require
- not types_incubator.is_empty
- not target_type.is_built
- local
- type: LIBERTY_ACTUAL_TYPE
- do
- from
- until
- types_incubator.is_empty or else target_type.is_built
- loop
- target_type.build_more
- type := types_incubator.first
- types_incubator.remove_first
- if not type.is_built then
- type.build_more
- if not type.is_built then
- incubator.add_last(type)
- end
- end
- end
- end
- check_flame_and_swap_incubator (flame: LIBERTY_FLAME; incubator: like types_incubator): like types_incubator is
- require
- types_incubator.is_empty
- do
- if not torch.still_burns(flame) then
- clean_unreachable_types(incubator)
- if not incubator.is_empty then
- debug ("error")
- debug_types(incubator)
- end
- errors.set(level_system_error, once "It looks like I miss some data but the hell if I know what.")
- check
- dead: False
- end
- end
- end
- Result := types_incubator
- types_incubator := incubator
- debug
- log.trace.put_line(once "Swapped incubator")
- end
- ensure
- types_incubator = incubator
- Result = old types_incubator
- end
- clean_unreachable_types (incubator: like types_incubator) is
- local
- i: INTEGER
- do
- clean_unreachable_types_from_incubator(incubator)
- from
- i := types.lower
- until
- i > types.upper
- loop
- if not types.item(i).is_reachable then
- types.fast_remove(types.key(i))
- else
- i := i + 1
- end
- end
- end
- clean_unreachable_types_from_incubator (incubator: like types_incubator) is
- local
- i: INTEGER
- do
- from
- i := incubator.lower
- until
- i > incubator.upper
- loop
- if not incubator.item(i).is_reachable then
- debug
- log.trace.put_string(once "Removing ")
- log.trace.put_string(incubator.item(i).full_name)
- log.trace.put_line(once ": not reachable")
- end
- incubator.remove(i)
- else
- i := i + 1
- end
- end
- end
- feature {} -- debug
- debug_types (incubator: like types_incubator) is
- local
- i: INTEGER
- all_types: FAST_ARRAY[LIBERTY_ACTUAL_TYPE]
- c: COMPARATOR_COLLECTION_SORTER[LIBERTY_ACTUAL_TYPE]
- do
- from
- create all_types.with_capacity(types.count)
- c.set_comparator(agent debug_compare_type_names)
- i := types.lower
- until
- i > types.upper
- loop
- c.add(all_types, types.item(i))
- i := i + 1
- end
- check
- all_types.count = types.count
- end
- log.trace.put_line(once "--8<--------")
- from
- i := all_types.lower
- until
- i > all_types.upper
- loop
- log.trace.put_integer(i - all_types.lower + 1)
- log.trace.put_string(once ": ")
- all_types.item(i).debug_display(log.trace, False)
- i := i + 1
- end
- log.trace.put_line(once "-------->8--")
- if incubator.is_empty then
- log.trace.put_integer(all_types.count)
- log.trace.put_line(once " types (total), incubator is empty")
- else
- log.trace.put_integer(all_types.count)
- log.trace.put_string(once " types (total), including ")
- log.trace.put_integer(incubator.count)
- log.trace.put_line(once " types in incubator:")
- log.trace.put_line(once "--8<--------")
- from
- i := incubator.lower
- until
- i > incubator.upper
- loop
- log.trace.put_integer(i - incubator.lower + 1)
- log.trace.put_string(once ": ")
- incubator.item(i).debug_display(log.trace, False)
- i := i + 1
- end
- log.trace.put_line(once "-------->8--")
- end
- end
- debug_compare_type_names (t1, t2: LIBERTY_ACTUAL_TYPE): BOOLEAN is
- do
- Result := t1.full_name < t2.full_name
- end
- feature {}
- start_to_build_type (type: LIBERTY_ACTUAL_TYPE) is
- require
- not types.has(type.descriptor)
- do
- types.add(type, type.descriptor)
- type.start_build(Current)
- if not type.is_built then
- types_incubator.add_last(type)
- end
- torch.burn
- end
- native_array_class_descriptor: LIBERTY_CLASS_DESCRIPTOR is
- local
- cluster: LIBERTY_CLUSTER
- once
- cluster := root.find("NATIVE_ARRAY".intern)
- create Result.make(cluster, "NATIVE_ARRAY".intern, Void)
- end
- tuple_class_descriptor: LIBERTY_CLASS_DESCRIPTOR is
- local
- cluster: LIBERTY_CLUSTER
- once
- cluster := root.find("TUPLE".intern)
- create Result.make(cluster, "TUPLE".intern, Void)
- end
- routine_class_descriptor: LIBERTY_CLASS_DESCRIPTOR is
- local
- cluster: LIBERTY_CLUSTER
- once
- cluster := root.find("ROUTINE".intern)
- create Result.make(cluster, "ROUTINE".intern, Void)
- end
- procedure_class_descriptor: LIBERTY_CLASS_DESCRIPTOR is
- local
- cluster: LIBERTY_CLUSTER
- once
- cluster := root.find("PROCEDURE".intern)
- create Result.make(cluster, "PROCEDURE".intern, Void)
- end
- function_class_descriptor: LIBERTY_CLASS_DESCRIPTOR is
- local
- cluster: LIBERTY_CLUSTER
- once
- cluster := root.find("FUNCTION".intern)
- create Result.make(cluster, "FUNCTION".intern, Void)
- end
- predicate_class_descriptor: LIBERTY_CLASS_DESCRIPTOR is
- local
- cluster: LIBERTY_CLUSTER
- once
- cluster := root.find("PREDICATE".intern)
- create Result.make(cluster, "PREDICATE".intern, Void)
- end
- kernel_type (class_name: FIXED_STRING; visit: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]]): LIBERTY_ACTUAL_TYPE is
- -- Called only once per kernel type
- require
- not errors.has_error
- local
- cd: LIBERTY_CLASS_DESCRIPTOR; td: LIBERTY_TYPE_DESCRIPTOR
- ast: LIBERTY_AST_ONE_CLASS
- cluster: LIBERTY_CLUSTER
- do
- cluster := root.find(class_name)
- if cluster = Void then
- errors.set(level_fatal_error, "What's that installation of yours? I cannot even find the kernel class " + class_name + "!")
- end
- create cd.make(cluster, class_name.intern, Void)
- create td.make(cd, no_parameters)
- Result := types.reference_at(td)
- if Result = Void then
- ast := parse_class(cluster, class_name, Void)
- create Result.make(td, standard_generics_checker, ast, visit)
- start_to_build_type(Result)
- end
- ensure
- Result /= Void
- end
- agent_type (class_descriptor: LIBERTY_CLASS_DESCRIPTOR; agent_generics: TRAVERSABLE[LIBERTY_TYPE]; position: LIBERTY_POSITION;
- visit: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]]): LIBERTY_ACTUAL_TYPE is
- require
- class_descriptor /= Void
- agent_generics /= Void
- local
- td: LIBERTY_TYPE_DESCRIPTOR
- ast: LIBERTY_AST_ONE_CLASS
- do
- create td.make(class_descriptor, agent_generics)
- Result := types.reference_at(td)
- if Result = Void then
- ast := parse_class(td.cluster, td.name, position)
- create Result.make(td, agent_generics_checker, ast, visit)
- start_to_build_type(Result)
- end
- end
- feature {LIBERTY_TYPE_RESOLVER}
- get_type_from_descriptor (descriptor: LIBERTY_TYPE_DESCRIPTOR): LIBERTY_ACTUAL_TYPE is
- require
- not errors.has_error
- do
- Result := do_get_type_from_descriptor(descriptor)
- ensure
- Result.cluster.is_equal(descriptor.cluster)
- Result.name.is_equal(descriptor.name)
- same_parameters(Result.parameters, descriptor.parameters)
- end
- get_type_from_type_definition (type_definition: LIBERTY_AST_TYPE_DEFINITION; cluster: LIBERTY_CLUSTER): LIBERTY_ACTUAL_TYPE is
- require
- not type_definition.is_anchor
- not errors.has_error
- local
- class_name: STRING
- parameters: TRAVERSABLE[LIBERTY_TYPE]
- do
- class_name := type_definition.type_name.image.image
- inspect
- class_name
- when "INTEGER" then
- Result := type_integer
- when "INTEGER_64" then
- Result := type_integer_64
- when "INTEGER_32" then
- Result := type_integer_32
- when "INTEGER_16" then
- Result := type_integer_16
- when "INTEGER_8" then
- Result := type_integer_8
- when "ANY" then
- Result := type_any
- when "ARGUMENTS" then
- Result := type_arguments
- when "PLATFORM" then
- Result := type_platform
- when "REAL" then
- Result := type_real
- when "REAL_32" then
- Result := type_real_32
- when "REAL_64" then
- Result := type_real_64
- when "REAL_80" then
- Result := type_real_80
- when "REAL_128" then
- Result := type_real_128
- when "POINTER" then
- Result := type_pointer
- when "CHARACTER" then
- Result := type_character
- when "STRING" then
- Result := type_string
- when "BOOLEAN" then
- Result := type_boolean
- when "NATIVE_ARRAY" then
- parameters := get_parameters(type_definition.type_parameters)
- Result := type_native_array(parameters, type_lookup.resolver.position(type_definition))
- when "TUPLE" then
- parameters := get_parameters(type_definition.type_parameters)
- Result := type_tuple(parameters, type_lookup.resolver.position(type_definition))
- when "ROUTINE" then
- parameters := get_parameters(type_definition.type_parameters)
- check
- parameters.count = 1
- parameters.first.is_known
- end
- Result := type_routine(parameters.first.known_type.parameters, type_lookup.resolver.position(type_definition))
- when "PROCEDURE" then
- parameters := get_parameters(type_definition.type_parameters)
- check
- parameters.count = 1
- parameters.first.is_known
- end
- Result := type_procedure(parameters.first.known_type.parameters, type_lookup.resolver.position(type_definition))
- when "PREDICATE" then
- parameters := get_parameters(type_definition.type_parameters)
- check
- parameters.count = 1
- parameters.first.is_known
- end
- Result := type_predicate(parameters.first.known_type.parameters, type_lookup.resolver.position(type_definition))
- when "FUNCTION" then
- parameters := get_parameters(type_definition.type_parameters)
- check
- parameters.count = 2
- parameters.first.is_known
- end
- Result := type_function(parameters.first.known_type.parameters, parameters.last, type_lookup.resolver.position(type_definition))
- else
- parameters := get_parameters(type_definition.type_parameters)
- Result := do_get_type(cluster, type_lookup.resolver.position(type_definition), class_name.intern, parameters)
- end
- end
- feature {}
- do_get_type (cluster: LIBERTY_CLUSTER; position: LIBERTY_POSITION; class_name: FIXED_STRING; effective_type_parameters: TRAVERSABLE[LIBERTY_TYPE]): LIBERTY_ACTUAL_TYPE is
- require
- position /= Void
- local
- descriptor: LIBERTY_TYPE_DESCRIPTOR
- c: like cluster
- do
- if cluster = Void then
- c := root.find(class_name)
- else
- c := cluster.find(class_name)
- end
- if c = Void then
- errors.add_position(position)
- errors.set(level_fatal_error, "Looks like some configuration is missing, or you mistyped something. Anyway I cannot find the class named " + class_name + ".")
- end
- create descriptor.make(create {LIBERTY_CLASS_DESCRIPTOR}.make(c, class_name.intern, position), effective_type_parameters)
- Result := do_get_type_from_descriptor(descriptor)
- ensure
- Result.name.is_equal(class_name)
- same_parameters(Result.parameters, effective_type_parameters)
- end
- do_get_type_from_descriptor (descriptor: LIBERTY_TYPE_DESCRIPTOR): LIBERTY_ACTUAL_TYPE is
- require
- not errors.has_error
- local
- ast: LIBERTY_AST_ONE_CLASS
- do
- Result := types.reference_at(descriptor)
- if Result = Void then
- ast := parse_class(descriptor.cluster, descriptor.name, descriptor.position)
- create Result.make(descriptor, standard_generics_checker, ast, visit_user_type)
- start_to_build_type(Result)
- end
- ensure
- Result.cluster.is_equal(descriptor.cluster)
- Result.name.is_equal(descriptor.name)
- same_parameters(Result.parameters, descriptor.parameters)
- end
- feature {}
- same_parameters (params1, params2: TRAVERSABLE[LIBERTY_TYPE]): BOOLEAN is
- -- Simply doing "params1.is_equal(params2)" does not always work because one or both may actually be
- -- a TRAVERSABLE[LIBERTY_ACTUAL_TYPE] - and is_equal has a postcondition that requires the same
- -- actual runtime type for both the target and the parameter.
- require
- params1 /= Void
- params2 /= Void
- local
- i: INTEGER
- do
- if params1.count = params2.count then
- check
- params1.lower = params2.lower
- end
- from
- Result := True
- i := params1.lower
- until
- not Result or else i > params1.upper
- loop
- if params1.item(i) /= params2.item(i) then
- Result := params1.item(i).is_known and then params2.item(i).is_known
- and then params1.item(i).known_type = params2.item(i).known_type
- end
- i := i + 1
- end
- end
- end
- feature {} -- Type parameters fetching
- get_parameters (type_parameters: LIBERTY_AST_EFFECTIVE_TYPE_PARAMETERS): COLLECTION[LIBERTY_TYPE] is
- local
- type_parameter: LIBERTY_AST_EFFECTIVE_TYPE_PARAMETER
- type_definition: LIBERTY_AST_TYPE_DEFINITION
- type: LIBERTY_TYPE
- i: INTEGER
- do
- if type_parameters.list_is_empty then
- Result := no_parameters
- else
- create {FAST_ARRAY[LIBERTY_TYPE]} Result.with_capacity(type_parameters.list_count)
- from
- i := type_parameters.list_lower
- until
- i > type_parameters.list_upper
- loop
- type_parameter := type_parameters.list_item(i)
- type_definition := type_parameter.type_definition
- type := type_lookup.resolver.type(type_definition)
- Result.add_last(type)
- i := i + 1
- end
- end
- end
- no_parameters: COLLECTION[LIBERTY_TYPE] is
- once
- create {FAST_ARRAY[LIBERTY_TYPE]} Result.with_capacity(0)
- end
- feature {LIBERTY_TYPE_RESOLVER_IN_TYPE}
- parse_class (cluster: LIBERTY_CLUSTER; class_name: FIXED_STRING; pos: LIBERTY_POSITION): LIBERTY_AST_ONE_CLASS is
- require
- cluster /= Void
- class_name /= Void
- local
- code: STRING; class_descriptor: LIBERTY_CLASS_DESCRIPTOR
- ast: LIBERTY_AST_CLASS; actual_cluster: LIBERTY_CLUSTER
- evaled: BOOLEAN
- do
- actual_cluster := cluster.find(class_name)
- if actual_cluster = Void then
- errors.set(level_fatal_error,
- "Looks like some configuration is missing, or you mistyped something. Anyway I cannot find the class named " + class_name + ".")
- check
- dead: False
- end
- end
- create class_descriptor.make(actual_cluster, class_name, pos)
- Result := classes.reference_at(class_descriptor)
- if Result = Void then
- log.info.put_string(once "Parsing ")
- log.info.put_string(cluster.name)
- log.info.put_character('.')
- log.info.put_line(class_name)
- code := once ""
- code.clear_count
- read_file_in(class_descriptor, code)
- parser_buffer.initialize_with(code)
- eiffel.reset
- evaled := parser.eval(parser_buffer, eiffel.table, once "Class")
- if not evaled then
- errors.add_position(errors.syntax_position(code.upper, code, class_descriptor.file.intern))
- errors.set(level_fatal_error,
- "I'm afraid you need to use a bit more those fingers of yours. The code of the class " + class_name
- +" is incomplete.")
- errors.emit
- check
- dead: False
- end
- end
- if parser.error /= Void then
- errors.emit_syntax_error(parser.error, code, class_descriptor.file.intern)
- die_with_code(1)
- end
- ast ::= eiffel.root_node
- Result := ast.one_class
- classes.put(Result, class_descriptor)
- log.trace.put_string(cluster.name)
- log.trace.put_character('.')
- log.trace.put_string(class_name)
- log.trace.put_line(once " parsed.")
- end
- ensure
- Result /= Void
- end
- feature {} -- AST building
- read_file_in (descriptor: LIBERTY_CLASS_DESCRIPTOR; code: STRING) is
- require
- descriptor /= Void
- code.is_empty
- local
- file: FIXED_STRING
- do
- file := descriptor.file
- parser_file.connect_to(file)
- if not parser_file.is_connected then
- std_error.put_string(" *** Could not read file " + file)
- die_with_code(1)
- end
- from
- parser_file.read_line
- until
- parser_file.end_of_input
- loop
- code.append(parser_file.last_string)
- code.extend('%N')
- parser_file.read_line
- end
- code.append(parser_file.last_string)
- parser_file.disconnect
- end
- parse_tuple_classes (pos: LIBERTY_POSITION): LIBERTY_AST_CLASSES is
- local
- code: STRING; class_descriptor: LIBERTY_CLASS_DESCRIPTOR
- tuple_cluster: LIBERTY_CLUSTER
- i: INTEGER; file: FIXED_STRING
- one_class: LIBERTY_AST_ONE_CLASS
- evaled: BOOLEAN
- once
- log.info.put_line(once "Parsing TUPLE")
- tuple_cluster := root.find("TUPLE".intern)
- if tuple_cluster = Void then
- errors.set(level_fatal_error, "What's that installation of yours? I cannot even find the kernel class TUPLE!")
- end
- create class_descriptor.make(tuple_cluster, "TUPLE".intern, pos)
- code := once ""
- code.clear_count
- read_file_in(class_descriptor, code)
- parser_buffer.initialize_with(code)
- eiffel.reset
- evaled := parser.eval(parser_buffer, eiffel.table, once "Classes")
- if not evaled then
- errors.add_position(errors.syntax_position(code.upper, code, class_descriptor.file.intern))
- errors.set(level_fatal_error,
- "The code of the class TUPLE is incomplete. Maybe you could try installing Liberty again?")
- errors.emit
- check
- dead: False
- end
- end
- if parser.error /= Void then
- errors.emit_syntax_error(parser.error, code, class_descriptor.file.intern)
- die_with_code(1)
- end
- Result ::= eiffel.root_node
- file := class_descriptor.file.intern
- from
- i := Result.classes.lower
- check i = 0 end
- until
- i > Result.classes.upper
- loop
- one_class ::= Result.classes.item(i)
- check_tuple_class(one_class, i, Result, file)
- i := i + 1
- end
- log.trace.put_line(once "TUPLE parsed.")
- ensure
- Result /= Void
- end
- check_tuple_class (a_tuple_class: LIBERTY_AST_ONE_CLASS; generics_count: INTEGER; ast: LIBERTY_AST_CLASSES; file: FIXED_STRING) is
- -- minimal integrity check
- local
- classname: STRING
- gencount: INTEGER
- do
- classname := a_tuple_class.class_header.class_name.image.image
- if not classname.is_equal(once "TUPLE") then
- errors.add_position(errors.semantics_position(a_tuple_class.class_header.class_name.image.index, ast, file))
- errors.set(level_fatal_error, "Invalid TUPLE class text: strangely enough it does not contain TUPLE. Maybe you could try installing Liberty again?")
- end
- gencount := a_tuple_class.class_header.type_parameters.list_count
- if gencount /= generics_count then
- errors.add_position(errors.semantics_position(a_tuple_class.class_header.class_name.image.index, ast, file))
- if generics_count = 1 then
- errors.set(level_fatal_error,
- "Invalid TUPLE class text: expected 1 generic parameter but got " + gencount.out
- + ". Maybe you could try installing Liberty again?")
- else
- errors.set(level_fatal_error,
- "Invalid TUPLE class text: expected " + generics_count.out + " generic parameters but got " + gencount.out
- + ". Maybe you could try installing Liberty again)?")
- end
- end
- ensure
- not errors.has_error
- end
- parser_file: TEXT_FILE_READ is
- once
- create Result.make
- end
- parser_buffer: MINI_PARSER_BUFFER is
- once
- create Result
- end
- parser: DESCENDING_PARSER is
- once
- create Result.make
- end
- eiffel: EIFFEL_GRAMMAR is
- once
- create Result.make(create {LIBERTY_NODE_FACTORY}.make)
- end
- feature {}
- default_type_capacity: INTEGER is 4096
- make is
- local
- tr: LIBERTY_TYPE_RESOLVER_IN_UNIVERSE
- do
- type_lookup.set_universe(Current)
- create root.make_root
- create {HASHED_DICTIONARY[LIBERTY_AST_ONE_CLASS, LIBERTY_CLASS_DESCRIPTOR]} classes.with_capacity(default_type_capacity)
- create {HASHED_DICTIONARY[LIBERTY_ACTUAL_TYPE, LIBERTY_TYPE_DESCRIPTOR]} types.with_capacity(default_type_capacity)
- create types_incubator.with_capacity(default_type_capacity, 0)
- create tr.make(Current)
- type_lookup.push(tr)
- end
- root: LIBERTY_CLUSTER
- classes: DICTIONARY[LIBERTY_AST_ONE_CLASS, LIBERTY_CLASS_DESCRIPTOR]
- types: DICTIONARY[LIBERTY_ACTUAL_TYPE, LIBERTY_TYPE_DESCRIPTOR]
- types_incubator: RING_ARRAY[LIBERTY_ACTUAL_TYPE]
- errors: LIBERTY_ERRORS
- torch: LIBERTY_ENLIGHTENING_THE_WORLD
- type_lookup: LIBERTY_TYPE_LOOKUP
- standard_generics_checker: LIBERTY_GENERICS_CONFORMANCE_CHECKER is
- once
- create {LIBERTY_STANDARD_GENERICS_CONFORMANCE_CHECKER} Result.make
- end
- tuple_generics_checker: LIBERTY_GENERICS_CONFORMANCE_CHECKER is
- once
- create {LIBERTY_TUPLE_CONFORMANCE_CHECKER} Result.make
- end
- agent_generics_checker: LIBERTY_GENERICS_CONFORMANCE_CHECKER is
- once
- create {LIBERTY_AGENT_CONFORMANCE_CHECKER} Result.make
- end
- feature {}
- visit_type_any: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]] is
- once
- Result := agent {LIBERTY_TYPE_VISITOR}.visit_type_any
- end
- visit_type_arguments: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]] is
- once
- Result := agent {LIBERTY_TYPE_VISITOR}.visit_type_arguments
- end
- visit_type_platform: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]] is
- once
- Result := agent {LIBERTY_TYPE_VISITOR}.visit_type_platform
- end
- visit_type_pointer: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]] is
- once
- Result := agent {LIBERTY_TYPE_VISITOR}.visit_type_pointer
- end
- visit_type_integer_64: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]] is
- once
- Result := agent {LIBERTY_TYPE_VISITOR}.visit_type_integer_64
- end
- visit_type_integer_32: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]] is
- once
- Result := agent {LIBERTY_TYPE_VISITOR}.visit_type_integer_32
- end
- visit_type_integer_16: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]] is
- once
- Result := agent {LIBERTY_TYPE_VISITOR}.visit_type_integer_16
- end
- visit_type_integer_8: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]] is
- once
- Result := agent {LIBERTY_TYPE_VISITOR}.visit_type_integer_8
- end
- visit_type_real_64: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]] is
- once
- Result := agent {LIBERTY_TYPE_VISITOR}.visit_type_real_64
- end
- visit_type_real_32: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]] is
- once
- Result := agent {LIBERTY_TYPE_VISITOR}.visit_type_real_32
- end
- visit_type_real_80: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]] is
- once
- Result := agent {LIBERTY_TYPE_VISITOR}.visit_type_real_80
- end
- visit_type_real_128: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]] is
- once
- Result := agent {LIBERTY_TYPE_VISITOR}.visit_type_real_128
- end
- visit_type_character: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]] is
- once
- Result := agent {LIBERTY_TYPE_VISITOR}.visit_type_character
- end
- visit_type_string: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]] is
- once
- Result := agent {LIBERTY_TYPE_VISITOR}.visit_type_string
- end
- visit_type_boolean: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]] is
- once
- Result := agent {LIBERTY_TYPE_VISITOR}.visit_type_boolean
- end
- visit_type_native_array: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]] is
- once
- Result := agent {LIBERTY_TYPE_VISITOR}.visit_type_native_array
- end
- visit_type_tuple: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]] is
- once
- Result := agent {LIBERTY_TYPE_VISITOR}.visit_type_tuple
- end
- visit_type_routine: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]] is
- once
- Result := agent {LIBERTY_TYPE_VISITOR}.visit_type_routine
- end
- visit_type_procedure: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]] is
- once
- Result := agent {LIBERTY_TYPE_VISITOR}.visit_type_procedure
- end
- visit_type_function: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]] is
- once
- Result := agent {LIBERTY_TYPE_VISITOR}.visit_type_function
- end
- visit_type_predicate: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]] is
- once
- Result := agent {LIBERTY_TYPE_VISITOR}.visit_type_predicate
- end
- visit_user_type: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]] is
- once
- Result := agent {LIBERTY_TYPE_VISITOR}.visit_user_type
- end
- feature {}
- convert_integer_8_16: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_integer_8_16
- end
- convert_integer_8_32: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_integer_8_32
- end
- convert_integer_8_64: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_integer_8_64
- end
- convert_integer_16_32: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_integer_16_32
- end
- convert_integer_16_64: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_integer_16_64
- end
- convert_integer_32_64: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_integer_32_64
- end
- convert_real_32_64: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_real_32_64
- end
- convert_real_32_80: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_real_32_80
- end
- convert_real_32_128: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_real_32_128
- end
- convert_real_64_80: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_real_64_80
- end
- convert_real_64_128: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_real_64_128
- end
- convert_real_80_128: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_real_80_128
- end
- convert_integer_64_real_128: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_integer_64_real_128
- end
- convert_integer_64_real_80: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_integer_64_real_80
- end
- convert_integer_32_real_128: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_integer_32_real_128
- end
- convert_integer_32_real_80: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_integer_32_real_80
- end
- convert_integer_32_real_64: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_integer_32_real_64
- end
- convert_integer_16_real_128: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_integer_16_real_128
- end
- convert_integer_16_real_80: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_integer_16_real_80
- end
- convert_integer_16_real_64: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_integer_16_real_64
- end
- convert_integer_16_real_32: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_integer_16_real_32
- end
- convert_integer_8_real_128: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_integer_8_real_128
- end
- convert_integer_8_real_80: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_integer_8_real_80
- end
- convert_integer_8_real_64: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_integer_8_real_64
- end
- convert_integer_8_real_32: PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
- once
- Result := agent {LIBERTY_TYPE_CONVERTER}.convert_integer_8_real_32
- end
- invariant
- types /= Void
- classes /= Void
- types_incubator /= Void
- end