## Convert RAW_SYNTAX_TREEs to makelib's trimmed version thereof ("module_dependencies_summarys").
# Compiled by:
# src/app/makelib/makelib.sublib# The ideas here are based on those found in the original SC and
# also in an older version of makelib (before 1999). However, nearly
# all aspects have been changed radically, and the code has been
# re-written from scratch.
#
# The module_dependencies_summarys generated by this module are typically smaller
# than the "decl"s in SC or old versions of makelib. This should
# make dependency analysis somewhat faster (but is probably not
# very noticeable).
stipulate
package err = error_message; # error_message is from src/lib/compiler/front/basics/errormsg/error-message.pkg package raw = raw_syntax; # raw_syntax is from src/lib/compiler/front/parser/raw-syntax/raw-syntax.pkg package sy = symbol; # symbol is from src/lib/compiler/front/basics/map/symbol.pkg package syp = symbol_path; # symbol_path is from src/lib/compiler/front/typer-stuff/basics/symbol-path.pkg package sys = symbol_set; # symbol_set is from src/app/makelib/stuff/symbol-set.pkgherein
package raw_syntax_to_module_dependencies_summary
: Raw_Syntax_To_Module_Dependencies_Summary # Raw_Syntax_To_Module_Dependencies_Summary is from src/app/makelib/compilable/raw-syntax-to-module-dependencies-summary.api {
# include package raw_syntax;
include package module_dependencies_summary;
Symbol = sy::Symbol;
Path = List( Symbol );
# The main idea is to collect lists of decl ("dl"s).
# Normally, a dl will eventually become an argument to seq or par.
# As an important optimization, we always try to keep any "Ref s"
# at the front (but we don't try too hard and only do it where
# it is reasonably convenient).
# Function composition suitable for fold[lr]-arguments
#
infix my o' ;
#
fun (f o' g) (x, y)
=
f (g x, y);
# Add the head of a symbol path to a given set:
#
fun s_add_p ([], set)
=>
set;
s_add_p (head ! _, set)
=>
sys::add (set, head);
end;
# Same as s_addP except we ignore paths of length 1
# because they do not involve module access:
#
fun s_add_mp ([], set) => set; # Can this happen at all? XXX BUGGO FIXME
s_add_mp ([only], set) => set; # no module name here
s_add_mp (head ! _, set) => sys::add (set, head);
end;
# Add a reference to a symbol to a dl:
#
fun dl_add_sym (symbol, []) => [REF (sys::singleton symbol)];
dl_add_sym (symbol, REF s ! dl) => REF (sys::add (s, symbol)) ! dl;
dl_add_sym (symbol, dl) => REF (sys::singleton symbol) ! dl;
end;
# Add the first element of a path to a dl:
#
fun dl_add_p ([], d)
=>
d;
dl_add_p (head ! _, d)
=>
dl_add_sym (head, d);
end;
# Add the first element of a path to a dl
# -- except if that element is the only
# one on the path:
fun dl_add_mp ([], dl) => dl;
dl_add_mp ([only], dl) => dl;
dl_add_mp (head ! _, dl) => dl_add_sym (head, dl);
end;
# Given a set of module references, add it to a decl list:
#
fun dl_add_s (s, dl)
=
if (sys::is_empty s)
#
dl;
else
case dl
#
[] => [REF s];
REF s' ! dl' => REF (sys::union (s, s')) ! dl';
_ => REF s ! dl;
esac;
fi;
# Make a SEQ node when necessary:
#
fun seq [] => REF sys::empty;
seq [only] => only;
seq l => SEQ l;
end;
# Make a PAR node when necessary and stick it in front of a given dl:
fun parcons ([], d) => d;
parcons ([only], d) => only ! d;
parcons (l, d) => PAR l ! d;
end;
# Given a "bind list", stick a parallel BIND in front of a given dl.
# While doing so, if a REF occured at the front of the dl, move it
# past the bind list (shrinking it appropriately).
fun parbindcons (bl, REF s ! d)
=>
{ bs = sys::add_list (sys::empty, map #1 bl);
dl_add_s (sys::difference (s, bs), parcons (map BIND bl, d));
};
parbindcons (bl, d)
=>
parcons (map BIND bl, d);
end;
# Split initial ref set from a decl list:
fun split_dl [] => (sys::empty, []);
split_dl (REF s ! d) => (s, d);
split_dl d => (sys::empty, d);
end;
# Join two definition sequences:
fun join_dl ([], d) => d;
join_dl ([REF s], d) => dl_add_s (s, d);
join_dl (h ! t, d) => h ! join_dl (t, d);
end;
# Local definitions:
fun local_dl ([], b, d) => join_dl (b, d);
local_dl (REF s ! t, b, d) => dl_add_s (s, local_dl (t, b, d));
local_dl (l, b, d) => LOCAL (seq l, seq b) ! d;
end;
# Build a 'let' expression:
fun letexp (dl, (s, e))
=
case (split_dl dl)
#
(s', [])
=>
(sys::union (s', s), e);
#
(s', dl')
=>
{ dl'' = if (sys::is_empty s) dl';
else reverse (dl_add_s (s, reverse dl'));
fi;
(s', LET (dl'', e));
};
esac;
# Make an IGN1 if necessary:
#
fun ign ( p1, NULL) => p1;
ign ((s1, e1), THE (s2, e2)) => (sys::union (s1, s2), IGN1 (e1, e2));
end;
# Open cancels Decl:
#
fun use (DECL dl, dl') => join_dl (dl, dl');
use (e, dl) => OPEN e ! dl;
end;
# Generate a set of "parallel" namings
#
fun parbind f l d
=
{ my (s, bl) = fold_forward f (sys::empty, []) l;
dl_add_s (s, parbindcons (bl, d));
};
# Get the ref set from a type:
#
fun ty_s (raw::TYPEVAR_TYPE _, set) => set;
ty_s (raw::TYPE_TYPE (cn, l), set) => s_add_mp (cn, fold_forward ty_s set l);
#
ty_s (raw::RECORD_TYPE l, set) => fold_forward (ty_s o' #2) set l;
ty_s (raw::TUPLE_TYPE l, set) => fold_forward ty_s set l;
#
ty_s (raw::SOURCE_CODE_REGION_FOR_TYPE (arg, _), set) => ty_s (arg, set);
end;
# Get the ref set from a type option:
#
fun tyopt_s (NULL, set) => set;
tyopt_s (THE t, set) => ty_s (t, set);
end;
# Get the ref set from a pattern:
#
fun pat_s (raw::VARIABLE_IN_PATTERN p, set)
=>
s_add_mp (p, set);
pat_s (raw::RECORD_PATTERN { definition, ... }, set)
=>
fold_forward (pat_s o' #2) set definition;
pat_s ( ( raw::LIST_PATTERN l
| raw::TUPLE_PATTERN l
| raw::VECTOR_PATTERN l
| raw::OR_PATTERN l
),
set
)
=>
fold_forward pat_s set l;
pat_s (raw::PRE_FIXITY_PATTERN l, set)
=>
fold_forward (pat_s o' .item) set l;
pat_s (raw::APPLY_PATTERN { constructor, argument }, set)
=>
pat_s (constructor, pat_s (argument, set));
pat_s (raw::TYPE_CONSTRAINT_PATTERN { pattern, type_constraint }, set)
=>
pat_s (pattern, ty_s (type_constraint, set));
pat_s (raw::AS_PATTERN { variable_pattern, expression_pattern }, set)
=>
pat_s (variable_pattern, pat_s (expression_pattern, set));
pat_s (raw::SOURCE_CODE_REGION_FOR_PATTERN (arg, _), set)
=>
pat_s (arg, set);
pat_s (( raw::WILDCARD_PATTERN
| raw::INT_CONSTANT_IN_PATTERN _
| raw::UNT_CONSTANT_IN_PATTERN _
| raw::STRING_CONSTANT_IN_PATTERN _
| raw::CHAR_CONSTANT_IN_PATTERN _
), set)
=>
set;
end;
# Get the ref set from an exception naming:
fun eb_s (raw::NAMED_EXCEPTION { exception_symbol=>exn, exception_type=>etype }, set) => tyopt_s (etype, set);
eb_s (raw::DUPLICATE_NAMED_EXCEPTION { exception_symbol=>exn, equal_to=>edef }, set) => s_add_mp (edef, set);
eb_s (raw::SOURCE_CODE_REGION_FOR_NAMED_EXCEPTION (arg, _), set) => eb_s (arg, set);
end;
# ...
fun dbrhs_s (raw::VALCONS l, set)
=>
fold_forward (tyopt_s o' #2) set l;
dbrhs_s (raw::REPLICAS cn, set)
=>
s_add_mp (cn, set);
end;
fun db_s (raw::SUM_TYPE { right_hand_side, ... }, set)
=>
dbrhs_s (right_hand_side, set);
db_s (raw::SOURCE_CODE_REGION_FOR_UNION_TYPE (arg, _), set)
=>
db_s (arg, set);
end;
fun tb_s (raw::NAMED_TYPE { definition, ... }, set)
=>
ty_s (definition, set);
tb_s (raw::SOURCE_CODE_REGION_FOR_NAMED_TYPE (arg, _), set)
=>
tb_s (arg, set);
end;
# Get a dl from an expression:
#
fun exp_dl (raw::VARIABLE_IN_EXPRESSION p, d)
=>
dl_add_mp (p, d);
exp_dl (raw::IMPLICIT_THUNK_PARAMETER p, d) # These should have been expanded to VARIABLE_IN_EXPRESSION by now.
=>
raise exception DIE "Are you using #foo outside of {. ... } ?";
exp_dl (raw::FN_EXPRESSION rl, d)
=>
fold_backward rule_dl d rl;
exp_dl (raw::PRE_FIXITY_EXPRESSION l, d)
=>
fold_backward (exp_dl o' .item) d l;
exp_dl (raw::APPLY_EXPRESSION { function, argument }, d)
=>
exp_dl (function, exp_dl (argument, d));
exp_dl (raw::OBJECT_FIELD_EXPRESSION { object, field }, d)
=>
exp_dl (object, d);
exp_dl (raw::CASE_EXPRESSION { expression, rules }, d)
=>
exp_dl (expression, fold_backward rule_dl d rules);
exp_dl (raw::LET_EXPRESSION { declaration, expression }, d)
=>
local_dl (dec_dl (declaration, []), exp_dl (expression, []), d);
exp_dl ( ( raw::SEQUENCE_EXPRESSION l
| raw::LIST_EXPRESSION l
| raw::TUPLE_EXPRESSION l
| raw::VECTOR_IN_EXPRESSION l
),
d
)
=>
fold_forward exp_dl d l;
exp_dl (raw::RECORD_IN_EXPRESSION l, d)
=>
fold_forward (exp_dl o' #2) d l;
exp_dl (raw::RECORD_SELECTOR_EXPRESSION _, d)
=>
d;
exp_dl (raw::TYPE_CONSTRAINT_EXPRESSION { expression, constraint }, d)
=>
dl_add_s (ty_s (constraint, sys::empty), exp_dl (expression, d));
exp_dl (raw::EXCEPT_EXPRESSION { expression, rules }, d)
=>
exp_dl (expression, fold_forward rule_dl d rules);
exp_dl (raw::RAISE_EXPRESSION e, d)
=>
exp_dl (e, d);
exp_dl (raw::IF_EXPRESSION { test_case, then_case, else_case }, d)
=>
exp_dl (test_case, exp_dl (then_case, exp_dl (else_case, d)));
exp_dl ( ( raw::AND_EXPRESSION (e1, e2)
| raw::OR_EXPRESSION (e1, e2)
),
d
)
=>
exp_dl (e1, exp_dl (e2, d));
exp_dl (raw::WHILE_EXPRESSION { test, expression }, d)
=>
exp_dl (test, exp_dl (expression, d));
exp_dl (raw::SOURCE_CODE_REGION_FOR_EXPRESSION (arg, _), d)
=>
exp_dl (arg, d);
exp_dl ( ( raw::INT_CONSTANT_IN_EXPRESSION _
| raw::UNT_CONSTANT_IN_EXPRESSION _
| raw::FLOAT_CONSTANT_IN_EXPRESSION _
| raw::STRING_CONSTANT_IN_EXPRESSION _
| raw::CHAR_CONSTANT_IN_EXPRESSION _
),
d
)
=>
d;
end
also
fun rule_dl (raw::CASE_RULE { pattern, expression }, d)
=
dl_add_s (pat_s (pattern, sys::empty), exp_dl (expression, d))
also
fun pattern_clause_dl (raw::PATTERN_CLAUSE { patterns => p, result_type => t, expression => e }, d)
=
dl_add_s (fold_forward (pat_s o' .item) (tyopt_s (t, sys::empty)) p,
exp_dl (e, d))
also
fun named_function_dl (raw::NAMED_FUNCTION { pattern_clauses, is_lazy, kind, null_or_type }, d)
=>
case null_or_type
#
THE type => dl_add_s (ty_s (type, sys::empty), fold_backward pattern_clause_dl d pattern_clauses);
NULL => fold_backward pattern_clause_dl d pattern_clauses ;
esac;
named_function_dl (raw::SOURCE_CODE_REGION_FOR_NAMED_FUNCTION (arg, _), d)
=>
named_function_dl (arg, d);
end
also
fun lib7_pattern_clause_dl (raw::NADA_PATTERN_CLAUSE { pattern => p, result_type => t, expression => e }, d)
=
dl_add_s ( fold_forward
pat_s (tyopt_s (t, sys::empty)) [p], # XXX BUGGO FIXME Since [p] is (obviously!) always a length-1 list, the logic can probably be simplified here.
exp_dl (e, d)
)
also
fun lib7_named_function_dl (raw::NADA_NAMED_FUNCTION (l, _), d)
=>
fold_backward lib7_pattern_clause_dl d l;
lib7_named_function_dl (raw::SOURCE_CODE_REGION_FOR_NADA_NAMED_FUNCTION (arg, _), d)
=>
lib7_named_function_dl (arg, d);
end
also
fun vb_dl (raw::NAMED_VALUE { pattern, expression, is_lazy }, d)
=>
dl_add_s (pat_s (pattern, sys::empty), exp_dl (expression, d));
vb_dl (raw::SOURCE_CODE_REGION_FOR_NAMED_VALUE (arg, _), d)
=>
vb_dl (arg, d);
end
also
fun field_dl (raw::NAMED_FIELD symbol, d)
=>
d; # 2009-02-23 CrT: Quick hack so it will compile. Might even be correct.
field_dl (raw::SOURCE_CODE_REGION_FOR_NAMED_FIELD (arg, _), d)
=>
field_dl (arg, d);
end
also
fun rvb_dl (raw::NAMED_RECURSIVE_VALUE { variable_symbol, expression, null_or_type, ... }, d)
=>
dl_add_s (tyopt_s (null_or_type, sys::empty), exp_dl (expression, d));
rvb_dl (raw::SOURCE_CODE_REGION_FOR_RECURSIVELY_NAMED_VALUE (arg, _), d)
=>
rvb_dl (arg, d);
end
also
fun spec_dl (raw::SOURCE_CODE_REGION_FOR_API_ELEMENT (arg, _), d)
=>
spec_dl (arg, d);
spec_dl (raw::PACKAGES_IN_API l, d)
=>
{ # strange case - optional: package, mandatory: api
fun one ((n, g, c), (s, bl))
=
{ my (s', e) = sigexp_p g;
s'' = sys::union (s, s');
case c NULL => (s'', (n, e) ! bl);
THE p => (s'', (n, IGN1 (VARIABLE (syp::SYMBOL_PATH p), e)) ! bl);
esac;
};
my (s, bl)
=
fold_backward one (sys::empty, []) l;
dl_add_s (s, parbindcons (bl, d));
};
spec_dl (raw::TYPES_IN_API (l, _), d)
=>
dl_add_s (fold_forward one_s sys::empty l, d)
where
fun one_s ((_, _, THE t), s) => ty_s (t, s);
one_s (_, s) => s;
end;
end;
spec_dl (raw::GENERICS_IN_API l, d)
=>
{ fun one ((n, g), (s, bl))
=
{ my (s', e) = generic_api_expression_p g;
(sys::union (s, s'), (n, e) ! bl);
};
my (s, bl) = fold_backward one (sys::empty, []) l;
dl_add_s (s, parbindcons (bl, d));
};
spec_dl (raw::VALUES_IN_API l, d)
=>
dl_add_s (fold_forward (ty_s o' #2) sys::empty l, d);
spec_dl (raw::VALCONS_IN_API { sumtypes, with_types }, d)
=>
dl_add_s (fold_forward db_s (fold_forward tb_s sys::empty with_types) sumtypes, d);
spec_dl (raw::EXCEPTIONS_IN_API l, d)
=>
dl_add_s (fold_forward (tyopt_s o' #2) sys::empty l, d);
spec_dl (raw::PACKAGE_SHARING_IN_API l, d)
=>
fold_forward dl_add_p d l;
spec_dl (raw::TYPE_SHARING_IN_API l, d)
=>
dl_add_s (fold_forward s_add_mp sys::empty l, d);
spec_dl (raw::IMPORT_IN_API g, d)
=>
{ my (s, e) = sigexp_p g;
#
dl_add_s (s, use (e, d));
};
end
also
fun sigexp_p (raw::API_BY_NAME s)
=>
(sys::empty, VARIABLE (syp::SYMBOL_PATH [s]));
sigexp_p (raw::API_WITH_WHERE_SPECS (g, whspecs))
=>
{ fun one_s (raw::WHERE_TYPE (_, _, type), s) => ty_s (type, s);
one_s (raw::WHERE_PACKAGE (_, p), s) => s_add_p (p, s);
end;
(sigexp_p g) -> (s, e);
(fold_forward one_s s whspecs, e);
};
sigexp_p (raw::API_DEFINITION l)
=>
{ (split_dl (fold_backward spec_dl [] l))
->
(s, d);
(s, DECL d);
};
sigexp_p (raw::SOURCE_CODE_REGION_FOR_API (arg, _))
=>
sigexp_p arg;
end
also
fun generic_api_expression_p (raw::GENERIC_API_BY_NAME s)
=>
(sys::empty, VARIABLE (syp::SYMBOL_PATH [s]));
generic_api_expression_p (raw::GENERIC_API_DEFINITION { parameter, result } )
=>
letexp (fold_backward fparam_d [] parameter, sigexp_p result);
generic_api_expression_p (raw::SOURCE_CODE_REGION_FOR_GENERIC_API (arg, _))
=>
generic_api_expression_p arg;
end
also
fun fparam_d ((nopt, g), d)
=
{ my (s, e) = sigexp_p g;
case nopt
#
NULL => dl_add_s (s, use (e, d));
THE n => dl_add_s (s, BIND (n, e) ! d);
esac;
}
also
fun sigexpc_p raw::NO_PACKAGE_CAST
=>
NULL;
sigexpc_p ( raw::WEAK_PACKAGE_CAST g
| raw::PARTIAL_PACKAGE_CAST g
| raw::STRONG_PACKAGE_CAST g
)
=>
THE (sigexp_p g);
end
also
fun generic_api_expressionc_p raw::NO_PACKAGE_CAST
=>
NULL;
generic_api_expressionc_p ( raw::WEAK_PACKAGE_CAST fg
| raw::PARTIAL_PACKAGE_CAST fg
| raw::STRONG_PACKAGE_CAST fg
)
=>
THE (generic_api_expression_p fg);
end
also
fun fctexp_p (raw::GENERIC_BY_NAME (p, c))
=>
ign ((sys::empty, VARIABLE (syp::SYMBOL_PATH p)), generic_api_expressionc_p c);
fctexp_p (raw::GENERIC_DEFINITION { parameters, body, constraint } )
=>
letexp (fold_backward fparam_d [] parameters,
ign (pkgexp_p body, sigexpc_p constraint));
fctexp_p (raw::CONSTRAINED_CALL_OF_GENERIC (p, l, c))
=>
{ fun one ((str, _), (s, el))
=
{ my (s', e) = pkgexp_p str;
#
(sys::union (s, s'), e ! el);
};
my (s, el)
=
fold_forward one (sys::empty, []) l;
my (s', e)
=
ign ((sys::empty, VARIABLE (syp::SYMBOL_PATH p)), generic_api_expressionc_p c);
(sys::union (s, s'), fold_forward IGN1 e el);
};
fctexp_p (raw::LET_IN_GENERIC (bdg, b))
=>
letexp (dec_dl (bdg, []), fctexp_p b);
fctexp_p (raw::SOURCE_CODE_REGION_FOR_GENERIC (arg, _))
=>
fctexp_p arg;
end
also
fun pkgexp_p (raw::PACKAGE_BY_NAME p)
=>
(sys::empty, VARIABLE (syp::SYMBOL_PATH p));
pkgexp_p (raw::PACKAGE_DEFINITION declaration)
=>
{ my (s, dl)
=
split_dl (dec_dl (declaration, []));
(s, DECL dl);
};
pkgexp_p (raw::PACKAGE_CAST (s, c))
=>
ign (pkgexp_p s, sigexpc_p c);
pkgexp_p ( raw::CALL_OF_GENERIC (p, l)
| raw::INTERNAL_CALL_OF_GENERIC (p, l)
)
=>
{ fun one ((str, _), (s, el))
=
{ my (s', e) = pkgexp_p str;
#
(sys::union (s, s'), e ! el);
};
my (s, el) = fold_forward one (sys::empty, []) l;
(s, fold_forward IGN1 (VARIABLE (syp::SYMBOL_PATH p)) el);
};
pkgexp_p (raw::LET_IN_PACKAGE (bdg, b))
=>
letexp (dec_dl (bdg, []), pkgexp_p b);
pkgexp_p (raw::SOURCE_CODE_REGION_FOR_PACKAGE (s, _))
=>
pkgexp_p s;
end
also
fun dec_dl (raw::VALUE_DECLARATIONS (l, _), d) => fold_forward vb_dl d l;
dec_dl (raw::FIELD_DECLARATIONS (l, _), d) => fold_forward field_dl d l;
dec_dl (raw::RECURSIVE_VALUE_DECLARATIONS (l, _), d) => fold_forward rvb_dl d l;
dec_dl (raw::FUNCTION_DECLARATIONS (l, _), d) => fold_forward named_function_dl d l;
dec_dl (raw::NADA_FUNCTION_DECLARATIONS (l, _), d) => fold_forward lib7_named_function_dl d l;
dec_dl (raw::TYPE_DECLARATIONS l, d) => dl_add_s (fold_forward tb_s sys::empty l, d);
dec_dl (raw::SUMTYPE_DECLARATIONS { sumtypes, with_types }, d)
=>
dl_add_s (fold_forward db_s (fold_forward tb_s sys::empty with_types) sumtypes, d);
dec_dl (raw::EXCEPTION_DECLARATIONS l, d)
=>
dl_add_s (fold_forward eb_s sys::empty l, d);
dec_dl (raw::PACKAGE_DECLARATIONS l, d)
=>
parbind one l d
where
fun one (raw::SOURCE_CODE_REGION_FOR_NAMED_PACKAGE (arg, _), x)
=>
one (arg, x);
one (raw::NAMED_PACKAGE { name_symbol=>name, definition=>def, constraint, kind }, (s, bl))
=>
{ my (s', e) = ign (pkgexp_p def, sigexpc_p constraint);
(sys::union (s, s'), (name, e) ! bl);
};
end;
end;
dec_dl (raw::GENERIC_DECLARATIONS l, d)
=>
{ fun one (raw::SOURCE_CODE_REGION_FOR_NAMED_GENERIC (arg, _), x)
=>
one (arg, x);
one (raw::NAMED_GENERIC { name_symbol=>name, definition=>def }, (s, bl))
=>
{ (fctexp_p def)
->
(s', e);
(sys::union (s, s'), (name, e) ! bl);
};
end;
parbind one l d;
};
dec_dl (raw::API_DECLARATIONS l, d)
=>
{ fun one (raw::SOURCE_CODE_REGION_FOR_NAMED_API (arg, _), x)
=>
one (arg, x);
one (raw::NAMED_API { name_symbol=>name, definition=>def }, (s, bl))
=>
{ (sigexp_p def)
->
(s', e);
(sys::union (s, s'), (name, e) ! bl);
};
end;
parbind one l d;
};
dec_dl (raw::GENERIC_API_DECLARATIONS l, d)
=>
{ fun one (raw::SOURCE_REGION_FOR_NAMED_GENERIC_API (arg, _), x)
=>
one (arg, x);
one (raw::NAMED_GENERIC_API { name_symbol=>name, definition=>def }, (s, bl))
=>
{ (generic_api_expression_p def)
->
(s', e);
(sys::union (s, s'), (name, e) ! bl);
};
end;
parbind one l d;
};
dec_dl (raw::LOCAL_DECLARATIONS (bdg, body), d)
=>
local_dl (dec_dl (bdg, []), dec_dl (body, []), d);
dec_dl (raw::SEQUENTIAL_DECLARATIONS l, d)
=>
fold_backward dec_dl d l;
dec_dl (raw::INCLUDE_DECLARATIONS l, d)
=>
parcons (map (OPEN o VARIABLE o syp::SYMBOL_PATH) l, d);
dec_dl (raw::OVERLOADED_VARIABLE_DECLARATION (_, t, l, x), d)
=>
dl_add_s (ty_s (t, sys::empty), fold_forward exp_dl d l);
dec_dl (raw::FIXITY_DECLARATIONS _, d)
=>
d;
dec_dl (raw::SOURCE_CODE_REGION_FOR_DECLARATION (arg, _), d)
=>
dec_dl (arg, d);
dec_dl (raw::PRE_COMPILE_CODE string, d)
=>
d;
end;
fun c_dec d
=
seq (dec_dl (d, []));
fun convert { tree, err }
=
{ # Build a function that will complain (once you call it)
# about any existing restriction violations
#
fun complain_cm region
=
{ fun same_reg (raw::LOCAL_DECLARATIONS (_, body), k)
=>
same_reg (body, k);
same_reg (raw::SEQUENTIAL_DECLARATIONS l, k)
=>
fold_forward same_reg k l;
same_reg (raw::INCLUDE_DECLARATIONS _, k)
=>
(\\ ()
=
{ k ();
err err::ERROR region "toplevel use";
}
);
same_reg (raw::SOURCE_CODE_REGION_FOR_DECLARATION (arg, region), k)
=>
complain_cm region (arg, k);
same_reg ( ( raw::PACKAGE_DECLARATIONS _
| raw::GENERIC_DECLARATIONS _
| raw::API_DECLARATIONS _
| raw::GENERIC_API_DECLARATIONS _
| raw::PRE_COMPILE_CODE _
),
k
)
=>
k;
same_reg (_, k)
=>
(\\ ()
=
{ k ();
err err::WARNING region "definition not tracked by makelib";
}
);
end;
same_reg;
};
fun warn0 ()
=
();
complain = complain_cm (0, 0) (tree, warn0);
{ complain,
module_dependencies_summary => c_dec tree
};
};
};
end;
## author: Matthias Blume (blume@cs.princeton.edu)
## The copyright notices of the earlier versions are:
## Copyright (c) 1995 by AT&T Bell Laboratories
## Copyright (c) 1993 by Carnegie Mellon University,
## School of Computer Science
## contact: Gene Rollins (rollins+@cs.cmu.edu)
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.