# A tool for source code written using Norman Ramsey's "noweb".
#
# (C) 2000 Lucent Technologies, Bell Laboratories
#
# Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
# Compiled by:
# src/app/makelib/tools/noweb/noweb-tool.libpackage noweb_tool {
#
stipulate
#
include tools;
tool = "Noweb";
ilk = "noweb";
std_cmd_path = "notangle";
kw_subdir = "subdir";
kw_witness = "witness";
kw_target = "target"; # "master" keyword
kw_name = "name"; # sub-keywords...
kw_root = "root";
kw_ilk = "ilk";
kw_options = "options";
kw_lineformat = "lineformat";
keywords = [kw_name, kw_root, kw_ilk, kw_options, kw_lineformat];
dfl_subdir = "NW";
fun err msg = raise exception TOOL_ERROR { tool, msg };
fun kwerr what kw = err (cat [what, " keyword `", kw, "'"]);
fun badkw kw = kwerr "unknown" kw;
fun misskw kw = kwerr "missing" kw;
fun badspec kw = kwerr "bad specification for " kw;
fun dup kw = kwerr "duplicate" kw;
package string_map
=
red_black_map_g( # red_black_map_g is from src/lib/src/red-black-map-g.pkg Key = String;
compare = string::compare;
);
lnr = REF (fold_left
string_map::set'
string_map::empty
[ ("sml", "/*#line %L \"%F\"*/"),
("cm", "#line %L %F%N")
]
);
fun rule { spec, context, native2pathmaker, default_ilk_of, sysinfo }
=
{ spec -> { name => str, make_path, tool_options => too, derived, ... } : Spec;
p = srcpath (make_path ());
sname = native_spec p;
my (sd, wn) # "wn" probably means "witness" (meaning "timestampFile") all through the following code.
= # "s" and "t" are generally "source" and "target" (filename)
case too
#
NULL => (NULL, NULL);
THE l
=>
loop (l, NULL, NULL)
where
fun loop ([], sd, wn)
=>
(sd, wn);
loop (STRING _ ! t, sd, wn)
=>
loop (t, sd, wn);
loop (SUBOPTS { name, tool_options => [STRING s] } ! t, sd, wn)
=>
if (name == kw_subdir)
#
case sd
#
NULL => loop (t, THE (s.make_path ()), wn);
#
THE _ => dup kw_subdir;
esac;
else
if (name == kw_witness)
#
case wn
#
NULL => loop (t, sd, THE (s.make_path ()));
#
THE _ => dup kw_witness;
esac;
else
loop (t, sd, wn);
fi;
fi;
loop (SUBOPTS { name, ... } ! t, sd, wn)
=>
if (name == kw_witness
or name == kw_subdir
)
badspec name;
else
loop (t, sd, wn);
fi;
end;
end;
esac;
subdir_pp
=
case sd
THE prettyprint => prettyprint;
NULL => native2pathmaker dfl_subdir ();
esac;
subdir = native_pre_spec subdir_pp;
fun in_subdir f
=
if (winix::path::is_relative f)
winix::path::cat (subdir, f);
else
f;
fi;
timestamp_file_name
=
null_or::map (in_subdir o native_spec o srcpath) wn;
my (cpif, outd, update_timestamp_file)
=
case timestamp_file_name
#
NULL => ( FALSE,
fn tname = outdated tool ([tname], sname),
fn () = ()
);
THE wn => ( TRUE,
fn tname = outdated' tool { source_file_name => sname,
target_file_name => tname,
timestamp_file_name => wn
},
fn () = file::close_output (open_text_output wn)
);
esac;
fun one_target (tname, tfns, rname, tilk, tool_options, lf)
=
{ tname = in_subdir tname;
fun runcmd ()
=
{ cmdname
=
resolve_command_path std_cmd_path;
fun number f
=
cat ["-L'", f, "' "];
nonumber = "";
fmtopt
=
case lf
#
NULL => { fun ilk_numbering c
=
case (string_map::get (*lnr, c))
NULL => nonumber;
THE f => number f;
esac;
case tilk
#
THE c => ilk_numbering c;
NULL =>
case (default_ilk_of tfns)
#
THE c => ilk_numbering c;
NULL => nonumber;
esac;
esac;
};
THE f => number f;
esac;
redirect = if cpif "| cpif "; else ">";fi;
cmd = cat [cmdname, " ", fmtopt, "-R'", rname, "' ", sname, " ", redirect, tname];
make_all_directories_on_path tname;
say .{ cat ["[", cmd, "]\n"]; };
if (winix::process::system cmd != winix::process::success)
#
err cmd;
fi;
};
if (outd tname)
#
runcmd ();
fi;
{ name => tname,
make_path => native2pathmaker tname,
#
ilk => tilk,
tool_options,
derived => TRUE
};
};
fun one_target' (tname, tfns)
=
one_target (tname, tfns, tname, NULL, NULL, NULL);
fun simple_target (tfns as { name, make_path } )
=
one_target' (native_spec (srcpath (make_path ())), tfns);
fun one_opt (STRING x, rest)
=>
simple_target x ! rest;
one_opt (SUBOPTS { name, tool_options }, rest)
=>
{
fun subopts [STRING x]
=>
simple_target x;
subopts tool_options
=>
{
my { matches, remaining_options }
=
parse_options { tool, keywords, tool_options };
fun fmatch kw
=
case (matches kw)
#
THE [STRING (fns as { name, make_path } )]
=>
(native_spec (srcpath (make_path ())), fns);
NULL => misskw kw;
_ => badspec kw;
esac;
fun smatch kw
=
case (matches kw)
#
THE [STRING { name, ... } ] => THE name;
NULL => NULL;
_ => badspec kw;
esac;
case remaining_options
#
[] =>
{ (fmatch kw_name) -> (tname, tfns);
#
rname = the_else (smatch kw_root, tname);
tilk = smatch kw_ilk;
tool_options = matches kw_options;
lf = smatch kw_lineformat;
one_target (tname, tfns, rname, tilk, tool_options, lf);
};
_ => err "unrecognized target option (s)";
esac;
};
end;
if (name == kw_target)
#
subopts tool_options ! rest;
else
if (name == kw_subdir
or name == kw_witness)
#
rest;
else
badkw name;
fi;
fi;
};
end;
fun rulefn ()
=
( { makelib_files => [],
source_files => [],
sources => [(p, { ilk, derived } )]
},
case too
#
THE opts => fold_right one_opt [] opts;
#
NULL
=>
{ my { base, ext }
=
winix::path::split_base_ext sname;
base
=
case ext
#
NULL => base;
#
THE e
=>
if (e == "nw") base;
else sname;
fi;
esac;
fun expression e
=
{ tname = winix::path::join_base_ext
{ base, ext => THE e };
tfns = { name => tname,
make_path => native2pathmaker tname
};
one_target' (tname, tfns);
};
[ expression "api",
expression "pkg"
];
};
esac
);
context rulefn
before
update_timestamp_file ();
};
fun suffix s
=
note_filename_classifier (standard_filename_suffix_classifier { suffix => s, ilk } );
herein
my _ = note_ilk (ilk, rule);
my _ = suffix "nw";
fun line_numbering ilk
=
{ fun get ()
=
string_map::get (*lnr, ilk);
fun set NULL
=>
(lnr := #1 (string_map::drop (*lnr, ilk)))
except
lib_base::NOT_FOUND = ();
set (THE f)
=>
lnr := string_map::set (*lnr, ilk, f);
end;
{ get,
set
};
};
end;
};