## compiler-mapstack-set.pkg
# Compiled by:
# src/lib/compiler/core.sublib# Here we implement the second level of
# the datastructures used to track state
# during a makelib compile or interactive # makelib_g is from src/app/makelib/main/makelib-g.pkg# session.
#
# The top level, above us, is implemented in
#
# src/lib/compiler/toplevel/interact/compiler-state.pkg#
# in terms of the facilities we implement here.
#
# The state we track is composed of three principal parts:
#
# A symbol table holding per-symbol type information etc.
# A linking table tracking exports from loaded libraries.
# An inlining table tracking cross-module function inlining info.
#
# The detailed implementations of each of these
# three components is done elsewhere: Our task
# here is just to glue those parts together into
# a coherent whole.
#
# In practice, our state is not a single tripartite record,
# but rather a stack of them which we push and pop as we
# enter and leave syntactic scopes such as packages and
# functions.
### "If you have ten thousand regulations,
### you destroy all respect for the law."
###
### -- Winston Churchill
stipulate
package mld = module_level_declarations; # module_level_declarations is from src/lib/compiler/front/typer-stuff/modules/module-level-declarations.pkg package im = inlining_mapstack; # inlining_mapstack is from src/lib/compiler/toplevel/compiler-state/inlining-mapstack.pkg package lt = linking_mapstack; # linking_mapstack is from src/lib/compiler/execution/linking-mapstack/linking-mapstack.pkg package pp = standard_prettyprinter; # standard_prettyprinter is from src/lib/prettyprint/big/src/standard-prettyprinter.pkg package syx = symbolmapstack; # symbolmapstack is from src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack.pkg package sxe = symbolmapstack_entry; # symbolmapstack_entry is from src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack-entry.pkg package sy = symbol; # symbol is from src/lib/compiler/front/basics/map/symbol.pkg package tdt = type_declaration_types; # type_declaration_types is from src/lib/compiler/front/typer-stuff/types/type-declaration-types.pkg package vac = variables_and_constructors; # variables_and_constructors is from src/lib/compiler/front/typer-stuff/deep-syntax/variables-and-constructors.pkg package vh = varhome; # varhome is from src/lib/compiler/front/typer-stuff/basics/varhome.pkgherein
package compiler_mapstack_set
: (weak) Compiler_Mapstack_Set # Compiler_Mapstack_Set is from src/lib/compiler/toplevel/compiler-state/compiler-mapstack-set.api {
Symbol = sy::Symbol;
# Symbolmapstack = syx::Symbolmapstack;
Linking_Mapstack = lt::Picklehash_To_Heapchunk_Mapstack;
Inlining_Mapstack = im::Picklehash_To_Anormcode_Mapstack;
Compiler_Mapstack_Set
=
{ symbolmapstack: syx::Symbolmapstack, # This is the compile-time symbol table mapping symbols to types (etc).
linking_mapstack: Linking_Mapstack, # This is the link-time datastructure recording what live values are in memory, used to satisfy the external-symbol dependencies of packages that we are loading into memory.
inlining_mapstack: Inlining_Mapstack # This is a special symbol table intended to support cross-package function inlining. I don't think it is currently actually used for anything. -- 2015-09-04 CrT
};
fun bug msg
=
error_message::impossible("compiler_mapstack_set: " + msg);
fun symbolmapstack_part (e: Compiler_Mapstack_Set) = e.symbolmapstack;
fun linking_part (e: Compiler_Mapstack_Set) = e.linking_mapstack;
fun inlining_part (e: Compiler_Mapstack_Set) = e.inlining_mapstack;
fun make_compiler_mapstack_set (e as { symbolmapstack, linking_mapstack, inlining_mapstack } )
=
e;
null_compiler_mapstack_set
=
{ symbolmapstack => syx::empty,
linking_mapstack => lt::empty,
inlining_mapstack => im::empty
};
fun layer_compiler_mapstack_sets
( { symbolmapstack, linking_mapstack, inlining_mapstack },
{ symbolmapstack=>symbolmapstack', linking_mapstack=>linking_mapstack', inlining_mapstack=>inlining_mapstack' }
)
=
{ symbolmapstack => syx::atop (symbolmapstack, symbolmapstack' ),
linking_mapstack => lt::atop (linking_mapstack, linking_mapstack' ),
inlining_mapstack => im::atop (inlining_mapstack, inlining_mapstack')
};
layer_symbolmapstack = syx::atop;
layer_inlining_mapstack = im::atop;
fun consolidate_compiler_mapstack_set ( { symbolmapstack, linking_mapstack, inlining_mapstack } )
=
{ symbolmapstack => syx::consolidate symbolmapstack,
linking_mapstack => lt::consolidate linking_mapstack,
inlining_mapstack => im::consolidate inlining_mapstack
};
consolidate_symbolmapstack = syx::consolidate;
consolidate_inlining_mapstack = im::consolidate;
fun root (vh::EXTERN pid) => THE pid;
root (vh::PATH (p, i)) => root p;
root _ => NULL;
end;
# Getting the stamp from a naming:
#
fun stamp_of (sxe::NAMED_VARIABLE (vac::PLAIN_VARIABLE { varhome, ... } )) => root varhome;
stamp_of (sxe::NAMED_CONSTRUCTOR (tdt::VALCON { form=>vh::EXCEPTION a, ... } )) => root a;
stamp_of (sxe::NAMED_PACKAGE (mld::A_PACKAGE { varhome, ... } )) => root varhome;
stamp_of (sxe::NAMED_GENERIC (mld::GENERIC { varhome, ... } )) => root varhome;
stamp_of _ => NULL;
end;
# Functions to collect stale linking pids
# for unnaming in concatenate_compiler_mapstack_sets
# stalePids: Takes a new dictionary and a base dictionary to which
# it is to be added and returns a list of pids that are unreachable
# when the new dictionary is added to the base dictionary
#
# What we do instead:
#
# - Count the number of occurrences for each pid in base_dictionary namings
# that is going to be shadowed by symbolmapstack_additions
#
# - Count the total number of total occurrences for each such
# pids in base_dictionary
#
# - The ones where the counts coincide are stale
#
# This code is ok, because symbolmapstack_additions is the output of `export'.
# `export' calls consolidateSymbolmapstack, therefore we don't have
# duplicate namings of the same symbol.
fun stale_pids (symbolmapstack_additions, base_dictionary)
=
{ anyrebound = REF FALSE; # Any renamings?
my count_m # Counting map.
=
REF (picklehash_map::empty: picklehash_map::Map( Ref( Int ) ));
# picklehash_map is from src/lib/compiler/front/basics/map/picklehash-map.pkg fun get s
=
picklehash_map::get (*count_m, s);
# Initialize the counter map:
# for each new naming with stamp
# check if the same symbol was bound in the old dictionary
# and enter the old stamp into the map:
fun init_one s
=
case (get s )
NULL => count_m := picklehash_map::set (*count_m, s, REF (-1));
THE r => r := *r - 1;
esac;
fun init_c (symbol, _)
=
case (stamp_of (syx::get (base_dictionary, symbol)))
NULL => ();
THE s => { init_one s; anyrebound := TRUE; };
esac
except
syx::UNBOUND = ();
# Increment counter for a given stamp
#
fun incr NULL => ();
#
incr (THE s) => case (get s )
NULL => ();
THE r => r := *r + 1;
esac;
end;
fun inc_c (_, b)
=
incr (stamp_of b);
# Select the 0s
fun sel_zero ((s, REF 0), zeros) => s ! zeros;
sel_zero (_, zeros) => zeros;
end;
syx::apply init_c symbolmapstack_additions; # Init counter map
if (not *anyrebound)
#
[]; # Shortcut if no renamings
else
# Count the pids:
syx::apply inc_c base_dictionary;
# Pick out the stale ones:
stalepids
=
fold_forward sel_zero [] (picklehash_map::keyvals_list *count_m);
stalepids;
fi;
}; # fun stale_pids
fun concatenate_compiler_mapstack_sets (
{ symbolmapstack => newstat, linking_mapstack => newdyn, inlining_mapstack => newsym },
{ symbolmapstack => oldstat, linking_mapstack => olddyn, inlining_mapstack => oldsym }
)
=
{ hidden_pids = stale_pids (newstat, oldstat);
slimdyn = lt::remove (hidden_pids, olddyn);
slimsym = im::remove (hidden_pids, oldsym);
{ symbolmapstack => syx::consolidate_lazy (syx::atop (newstat, oldstat)),
linking_mapstack => lt::atop( newdyn, slimdyn ),
inlining_mapstack => im::atop( newsym, slimsym )
};
};
fun getnamings ( symbolmapstack: syx::Symbolmapstack,
symbols: List( sy::Symbol )
)
: List( (sy::Symbol, sxe::Symbolmapstack_Entry) )
=
{ fun loop ([], namings)
=>
namings;
loop (s ! rest, namings)
=>
{ namings'
=
(s, syx::get (symbolmapstack, s)) ! namings
except
syx::UNBOUND = namings;
loop (rest, namings');
};
end;
loop( symbols, [] );
};
fun copystat ( [], symbolmapstack) => symbolmapstack;
copystat ((s, b) ! l, symbolmapstack) => copystat (l, syx::bind (s, b, symbolmapstack));
end;
# fun filterSymbolmapstack (symbolmapstack: syx::Symbolmapstack, symbols: List( sy::symbol ))
# :
# syx::Symbolmapstack
# =
# copystat (getnamings (symbolmapstack, symbols), syx::empty)
stipulate
fun copydynsym (namings, linking_mapstack, inlining_mapstack)
=
loop (namings, lt::empty, im::empty)
where
fun loop ([], denv, syenv)
=>
(denv, syenv);
loop ((_, b) ! l, denv, syenv)
=>
case (stamp_of b)
#
NULL => loop (l, denv, syenv);
THE pid
=>
{ dy = the (lt::get linking_mapstack pid);
denv = lt::bind (pid, dy, denv);
symbol = im::get inlining_mapstack pid;
syenv = case symbol
#
THE symbol => im::bind (pid, symbol, syenv);
NULL => syenv;
esac;
loop (l, denv, syenv);
};
esac;
end;
end;
herein
fun filter_compiler_mapstack_set (
{ symbolmapstack, linking_mapstack, inlining_mapstack }: Compiler_Mapstack_Set,
symbols
)
=
{ snamings = getnamings (symbolmapstack, symbols);
symbolmapstack = copystat (snamings, syx::empty);
my (denv, syenv)
=
copydynsym (snamings, linking_mapstack, inlining_mapstack);
{ symbolmapstack, linking_mapstack => denv, inlining_mapstack => syenv };
};
fun trim_compiler_mapstack_set { symbolmapstack, linking_mapstack, inlining_mapstack }
=
{ symbols = browse_symbolmapstack::catalog symbolmapstack;
my (linking_mapstack, inlining_mapstack)
=
copydynsym (getnamings (symbolmapstack, symbols), linking_mapstack, inlining_mapstack);
{ symbolmapstack,
linking_mapstack,
inlining_mapstack
};
};
end;
fun describe symbolmapstack (s: Symbol) : Void
=
{ pp::with_standard_prettyprinter
#
(error_message::default_plaint_sink()) [] # error_message is from src/lib/compiler/front/basics/errormsg/error-message.pkg #
(\\ pp: pp::Prettyprinter
=
{ pp.box {. pp.rulename "cms1";
#
unparse_package_language::unparse_naming
pp
(s, syx::get (symbolmapstack, s), symbolmapstack, *global_controls::print::print_depth);
# unparse_package_language is from src/lib/compiler/front/typer/print/unparse-package-language.pkg # global_controls is from src/lib/compiler/toplevel/main/global-controls.pkg pp.newline();
};
}
);
}
except
syx::UNBOUND = print (sy::name s + " not found\n");
base_types_and_ops_symbolmapstack
=
base_types_and_ops::base_types_and_ops_symbolmapstack;
}; # package compiler_mapstack_set
end; # stipulate