## expand-oop-syntax-junk.pkg
# Compiled by:
# src/lib/compiler/front/typer/typer.sublibpackage expand_oop_syntax_junk {
debugging = typer_control::expand_oop_syntax_debugging; # eval: set_control "typechecker::expand_oop_syntax_debugging" "TRUE";
package lu = find_in_symbolmapstack; # find_in_symbolmapstack is from src/lib/compiler/front/typer-stuff/symbolmapstack/find-in-symbolmapstack.pkg package raw = raw_syntax; # raw_syntax is from src/lib/compiler/front/parser/raw-syntax/raw-syntax.pkg fun path_to_string path
=
string::join "::" (map symbol::name path);
#
fun path_for_parent_class
(superclass: raw::Named_Package)
=
case superclass
(raw::NAMED_PACKAGE { name_symbol, definition, constraint, kind })
=>
case definition
((raw::PACKAGE_BY_NAME path) | (raw::SOURCE_CODE_REGION_FOR_PACKAGE (raw::PACKAGE_BY_NAME path,_)))
=>
path;
_ => raise exception DIE "superclass must be specified by path (name)";
esac;
_ => raise exception DIE "superclass must be specified by path (name)";
esac;
#
fun path_to_package (symbolmapstack, path)
=
{ sink = error_message::error_no_source (error_message::default_plaint_sink (), REF FALSE) "";
if *debugging printf "src/lib/compiler/front/typer/main/expand-oop-syntax.pkg: Checking to see if package '%s' exists.\n" (path_to_string path); fi;
pkg = lu::find_package_via_symbol_path'( symbolmapstack, symbol_path::SYMBOL_PATH path, sink);
if *debugging printf "src/lib/compiler/front/typer/main/expand-oop-syntax.pkg: Package '%s' DOES exist.\n" (path_to_string path); fi;
THE pkg;
}
except
_ = { if *debugging printf "src/lib/compiler/front/typer/main/expand-oop-syntax.pkg: Package '%s' does NOT exist.\n" (path_to_string path); fi;
NULL;
};
#
fun package_exists (symbolmapstack, path)
=
case (path_to_package (symbolmapstack, path))
THE pkg => TRUE;
NULL => FALSE;
esac;
#
fun compute_superclass_chain_length
( symbolmapstack: symbolmapstack::Symbolmapstack,
root_path: List( symbol::Symbol )
)
: Int
=
{
super_symbol = symbol::make_package_symbol "super";
loop (root_path, 0)
where
fun loop (this_path, superclass_chain_length)
=
if (not (package_exists (symbolmapstack, this_path)))
superclass_chain_length;
else
loop ( this_path @ [ super_symbol ], # Change 'foo::super' to 'foo::super::super' or such.
superclass_chain_length + 1
);
fi;
end;
};
#
fun package_defines_type (path, symbol, symbolmapstack)
=
{ full_path = path @ [ symbol ];
sink = error_message::error_no_source (error_message::default_plaint_sink (), REF FALSE) "";
if *debugging printf "src/lib/compiler/front/typer/main/expand-oop-syntax.pkg: Checking to see if '%s' exists.\n" (path_to_string full_path); fi;
{
lu::find_type_via_symbol_path( symbolmapstack, symbol_path::SYMBOL_PATH full_path, sink);
if *debugging printf "src/lib/compiler/front/typer/main/expand-oop-syntax.pkg: '%s' DOES exist.\n" (path_to_string full_path); fi;
TRUE;
}
except
_ = { if *debugging printf "src/lib/compiler/front/typer/main/expand-oop-syntax.pkg: '%s' does NOT exist.\n" (path_to_string full_path); fi;
FALSE;
};
};
#
fun null_or_value_in_package (path, symbol, symbolmapstack)
=
{ full_path = path @ [ symbol ];
sink = error_message::error_no_source (error_message::default_plaint_sink (), REF FALSE) "";
if *debugging printf "src/lib/compiler/front/typer/main/expand-oop-syntax.pkg: Checking to see if '%s' exists.\n" (path_to_string full_path); fi;
{
value = lu::find_value_via_symbol_path'( symbolmapstack, symbol_path::SYMBOL_PATH full_path, sink);
if *debugging printf "src/lib/compiler/front/typer/main/expand-oop-syntax.pkg: '%s' DOES exist.\n" (path_to_string full_path); fi;
THE value;
}
except
_ = { if *debugging printf "src/lib/compiler/front/typer/main/expand-oop-syntax.pkg: '%s' does NOT exist.\n" (path_to_string full_path); fi;
NULL;
};
};
#
fun package_defines_value (path, symbol, symbolmapstack)
=
case (null_or_value_in_package (path, symbol, symbolmapstack))
THE value => TRUE;
NULL => FALSE;
esac;
#
fun find_path_defining_method
( symbolmapstack: symbolmapstack::Symbolmapstack,
root_path: List( symbol::Symbol ),
method_name: String
)
: Null_Or( List( symbol::Symbol ) )
=
{
super_symbol = symbol::make_package_symbol "super";
method_symbol = symbol::make_value_symbol method_name;
loop (root_path, method_symbol)
where
fun loop (path, method_symbol)
=
if (not (package_exists (symbolmapstack, path))) NULL;
elif (package_defines_value(path, method_symbol, symbolmapstack)) THE path;
else
loop ( path @ [ super_symbol ],
method_symbol
);
fi;
end;
};
};
# Code attic:
# 2009-08-10 CrT:
# The following debug code was in fun compute_superclass_chain_length
# right before 'fun package_exists'. If it doesn't get used in the
# next few months it should probably be deleted to reduce clutter.
#
# { path = [ symbol::make_package_symbol "oop" ];
# {
# printf "compute_superclass_chain_length Checking to see if package '%s' exists. src/lib/compiler/front/typer/main/expand-oop-syntax.pkg:\n" (path_to_string path);
# lu::find_package_via_symbol_path'( symbolmapstack, symbol_path::SYMBOL_PATH path, sink);
# printf "src/lib/compiler/front/typer/main/expand-oop-syntax.pkg: Package '%s' DOES exist.\n" (path_to_string path);
# TRUE;
# }
# except
# _ = { printf "src/lib/compiler/front/typer/main/expand-oop-syntax.pkg: Package '%s' does NOT exist.\n" (path_to_string path);
# FALSE;
# };
# };
# { path = [ symbol::make_package_symbol "object" ];
# {
# printf "compute_superclass_chain_length Checking to see if package '%s' exists. src/lib/compiler/front/typer/main/expand-oop-syntax.pkg:\n" (path_to_string path);
# lu::find_package_via_symbol_path'( symbolmapstack, symbol_path::SYMBOL_PATH path, sink);
# printf "src/lib/compiler/front/typer/main/expand-oop-syntax.pkg: Package '%s' DOES exist.\n" (path_to_string path);
# TRUE;
# }
# except
# _ = { printf "src/lib/compiler/front/typer/main/expand-oop-syntax.pkg: Package '%s' does NOT exist.\n" (path_to_string path);
# FALSE;
# };
# };
# { path = [ symbol::make_package_symbol "root_object" ];
# {
# printf "compute_superclass_chain_length Checking to see if package '%s' exists. src/lib/compiler/front/typer/main/expand-oop-syntax.pkg:\n" (path_to_string path);
# lu::find_package_via_symbol_path'( symbolmapstack, symbol_path::SYMBOL_PATH path, sink);
# printf "src/lib/compiler/front/typer/main/expand-oop-syntax.pkg: Package '%s' DOES exist.\n" (path_to_string path);
# TRUE;
# }
# except
# _ = { printf "src/lib/compiler/front/typer/main/expand-oop-syntax.pkg: Package '%s' does NOT exist.\n" (path_to_string path);
# FALSE;
# };
# };
# { print "\ncompute_superclass_chain_length listing known packages:\n";
# fun show title_string filter_fn
# =
# { symbols = symbolmapstack::symbols ( symbolmapstack );
# symbols = list::filter filter_fn symbols;
#
# names = map
# symbol::name
# symbols;
#
# sorted_names
# =
# list_mergesort::sort
# string::(>)
# names;
#
# #
# fun pr s
# =
# file::say [s, " "];
#
# file::say ["\nsymbol table ", title_string, " definitions:\n"];
# apply pr sorted_names;
# file::say ["\n"];
# };
# fun show_pkgs () = show "pkg" (\\ symbol = (symbol::name_space symbol == symbol::PACKAGE_NAMESPACE));
# show_pkgs();
# print "\ncompute_superclass_chain_length done listing known packages.\n";
# };
#