summaryrefslogtreecommitdiff
path: root/web/glasgow/lit2x-0.16/literate/lit2pgm.BOOT
diff options
context:
space:
mode:
Diffstat (limited to 'web/glasgow/lit2x-0.16/literate/lit2pgm.BOOT')
-rw-r--r--web/glasgow/lit2x-0.16/literate/lit2pgm.BOOT385
1 files changed, 385 insertions, 0 deletions
diff --git a/web/glasgow/lit2x-0.16/literate/lit2pgm.BOOT b/web/glasgow/lit2x-0.16/literate/lit2pgm.BOOT
new file mode 100644
index 0000000000..b2dea81d65
--- /dev/null
+++ b/web/glasgow/lit2x-0.16/literate/lit2pgm.BOOT
@@ -0,0 +1,385 @@
+eval "exec perl -S $0 $*"
+ if $running_under_some_random_shell;
+#
+#############
+# magic version for booting...
+###########
+# line 27 "lit2stuff.lprl"
+$Pgm = $0; $Pgm =~ s/.*\/([^\/]+)$/\1/;
+
+# an initial -A<name> option overrides the name
+if ($#ARGV >= 0 && $ARGV[0] =~ /^-A(lit2)(pgm|texi|latex)$/) {
+ $Pgm = $1.$2;
+ shift(@ARGV);
+}
+$Lit2pgm = ($Pgm eq 'lit2pgm') ? 1 : 0;
+$Lit2latex = ($Pgm eq 'lit2latex') ? 1 : 0;
+$Lit2texi = ($Pgm eq 'lit2texi') ? 1 : 0;
+$Lit2depend = ($Pgm eq 'mkdependlit') ? 1 : 0;
+$Lit2changelog = ($Pgm eq 'lit2changelog') ? 1 : 0;
+die "$Pgm: must be invoked as lit2pgm, lit2texi, lit2latex, mkdependlit, or lit2changelog (or use -A<name>)\n"
+ if (!($Lit2pgm || $Lit2latex || $Lit2texi || $Lit2depend || $Lit2changelog));
+
+# $Lit2what will be set after we know $Quick_lit2pgm
+
+$Status = 0; # just used for exit() status
+# line 53 "lit2stuff.lprl"
+do 'getopts.pl' || die "Giant error 'do'ing getopts.pl: $@";
+$Usage = "usage: $Pgm ".
+ '[-i input-file] '.
+ '[-I LITINPUTS-path-additions] '.
+ '[-o output-file] ';
+$Usage .= '[-cdnqv] '.
+ '[-r ribbons] '.
+ "[input-file]\n" if $Lit2pgm;
+$Usage .= '[-cdLnOSv] '.
+ '[-N infofilename] '.
+ '[-[lx] language] '.
+ '[-s stop-list-file] '.
+ "[input-file]\n" if $Lit2texi;
+$Usage .= '[-cdnOSv] '.
+ '[-g node-name] '.
+ '[-[lptx] language] '.
+ '[-s stop-list-file] '.
+ "[input-file]\n" if $Lit2latex;
+$Usage .= '[-dv] '.
+ "[input-file]\n" if $Lit2depend;
+$Usage .= '[-dnv] '.
+ "[input-file]\n" if $Lit2changelog;
+
+if ( ($Lit2pgm && ! &Getopts('cdH:I:i:no:qr:v'))
+ || ($Lit2texi && ! &Getopts('cdH:I:i:Ll:nN:Oo:Ss:vx:'))
+ || ($Lit2latex && ! &Getopts('cdg:H:I:i:l:no:Op:Ss:t:vx:'))
+ || ($Lit2depend && ! &Getopts('dH:I:i:o:v'))
+ || ($Lit2changelog && ! &Getopts('dH:I:i:no:v'))) {
+ print STDERR $Usage;
+ exit 1;
+} elsif ($#ARGV > 0) {
+ print STDERR "$Pgm: cannot have more than one input file: @ARGV \n";
+ print STDERR $Usage;
+ exit 1;
+}
+# SHARED OPTIONS
+$Debugging = ($opt_d) ? 1 : 0;
+$Verbose = ($Debugging | $opt_v) ? 1 : 0;
+$Input_file = ($opt_i) ? $opt_i : '';
+# -o <output file> handled after deciding if linking
+
+$Litinputs = '.';
+$Litinputs_adds = ($opt_I) ? $opt_I : '';
+$Litinputs = "$Litinputs_adds:$Litinputs" if $Litinputs && $Litinputs_adds;
+
+# where all the assisting code is found (HARDWIRED)
+if ($opt_H) {
+ # no error checking; you get what you deserve
+ ($LIB_ARCH_DIR,$LIB_DIR) = split(/:/,$opt_H);
+} else {
+# boot changes...
+ $LIB_ARCH_DIR = '.';
+ $LIB_DIR = '.';
+}
+unshift(@INC, $LIB_DIR); # adding to; for .prl libraries sucked in at runtime
+#
+# now the (derived) names of all the helpers
+$Lit_inputter = "$LIB_DIR/lit-inputter";
+$Lit_deatify = "$LIB_ARCH_DIR/lit-deatify";
+$Lit_verb2latex = "$LIB_ARCH_DIR/lit-verb2latex";
+
+# finish knowing myself; must agree with lit-deatify.llex
+# boot change
+$Quick_lit2pgm = 1; # ($opt_q) ? 1 : 0;
+$Lit2what = 1; # if $Quick_lit2pgm;
+
+# LESS SHARED OPTIONS
+$Grab_node = ($opt_g) ? $opt_g : 'Top';
+$Infofilename = ($opt_N) ? $opt_N : ''; # see do_setfilename
+$Follow_inputs = ($opt_n) ? 1 : 0;
+$Show_node_owner= ($opt_O) ? 1 : 0;
+$Opt_node_links = ($opt_L) ? 1 : 0;
+$Standalone_doc = ($opt_S) ? 1 : 0;
+
+$Stoplist_file = ($opt_s) ? $opt_s : '';
+# for now, stop lists are simply words to be ignored
+if ($Stoplist_file) {
+ if ( ! -f $Stoplist_file) {
+ &not_OK('','',"stop-list file does not exist: $Stoplist_file\n");
+ } else {
+ open(STOPF,"<$Stoplist_file") || die "Can't open file: $Stoplist_file\n";
+ while (<STOPF>) {
+ chop;
+ $IGNORE_WD{$_} = 1; # no questions asked...
+ }
+ close(STOPF);
+ }
+}
+
+$Ribbons_to_get = ($opt_r) ? $opt_r : 'main';
+$Ribbons_to_get =~ s/\s*,\s*/,/g; # remove spaces around commas
+
+# figure out what we're doing and the input and output files...
+if ( ! $Input_file ) {
+ if ($#ARGV == 0) {
+ $Input_file = $ARGV[0];
+ } else {
+ $Input_file = '-'; # stdin; hmm...
+ }
+}
+
+($Inputfile_root,$Inputfile_suff) = &root_and_suffix($Input_file);
+
+# are we "processing" and/or "linking" ?
+if ( ! ($Lit2texi || $Lit2latex)) { # that's easy...
+ $Processing = 1;
+ $Linking = 0;
+} else {
+ $Processing = 1 if $Inputfile_suff !~ /^(itxi|itex|texi|tex)$/;
+ $Linking = ($opt_c) ? 0 : 1;
+}
+
+# table of input-suffixes -> output-suffixes (for "processing");
+# cf. tables in &check_language_stuff
+$ISUFF2OSUFF{'lit'} = '';
+$ISUFF2OSUFF{'lhs'} = 'hs';
+$ISUFF2OSUFF{'lit.hs'} = 'hs';
+$ISUFF2OSUFF{'lprl'} = 'prl';
+$ISUFF2OSUFF{'llex'} = 'lex';
+
+# guess the output filenames (for "processing" and "linking")
+if ( $opt_o ) {
+ if ( $Linking ) {
+ $Link_outfile = $opt_o;
+ } else {
+ $Proc_outfile = $opt_o;
+ }
+}
+if ( !defined($Proc_outfile) ) {
+ if ($Linking) { # got to put it _somewhere_
+ $Proc_outfile = "/usr/tmp/lit2stuff-po.$$";
+
+ } elsif ($Lit2pgm) { # try to be clever
+ if (defined($ISUFF2OSUFF{$Inputfile_suff})) {
+ $Proc_outfile = $Inputfile_root;
+ $Proc_outfile .= '.'.$ISUFF2OSUFF{$Inputfile_suff}
+ if $ISUFF2OSUFF{$Inputfile_suff};
+ } else {
+ print STDERR "$Pgm: don't know the file suffix: $Inputfile_suff\n";
+ $Proc_outfile = '-'; # stdout will do
+ }
+
+ } elsif ($Lit2texi) {
+ $Proc_outfile = $Inputfile_root . '.itxi';
+
+ } elsif ($Lit2latex) {
+ $Proc_outfile = $Inputfile_root . '.itex';
+
+ } else {
+ $Proc_outfile = '-'; # stdout
+ }
+}
+# messing with Link_outfile deferred to later...
+
+&check_language_stuff();
+exit $Status if $Status; # don't proceed if errors
+
+print STDERR "Language info: code=$Code_lang, xref=$Lang_xref, ",
+ "typeset=$Lang_typeset, pagebreak=$Lang_pagebreak\n"
+ if $Verbose;
+
+# now we know the program, the options, and the language info, we load
+# the other (non-language-related) pieces of perl code (roll-your-own
+# dynamic linking...)
+# if ( ! $Quick_lit2pgm) {
+# do 'lit-globals.prl' || die "Giant error 'do'ing lit-globals.prl: $@";
+# do 'lit-reader.prl' || die "Giant error 'do'ing lit-reader.prl: $@";
+#}
+#if ($Lit2pgm) {
+# if (! $Quick_lit2pgm) { # i.e., the slow one
+# do 'lit-2pgm.prl' || die "Giant error 'do'ing lit-2pgm.prl: $@";
+# }
+# boot changes
+# # we _always_ need something for line directives
+# do "lit-2pgm-$Code_lang.prl"
+# || die "Giant error 'do'ing lit-2pgm-$Code_lang.prl: $@";
+#
+#} else {
+# die "can't use lit2pgm.BOOT except for lit2pgm'ming"
+#}
+
+# NOW WE START DRIVING...
+
+# first: we handle "quick" lit2pgm
+if ($Quick_lit2pgm) {
+
+ # check that no incompatible lit2pgm options were used
+ die "Can only get ribbon 'main' with lit2pgm -q option\n"
+ if ($Ribbons_to_get ne 'main');
+ die "Can't follow \\input{}s with lit2pgm -q option\n"
+ if ($Follow_inputs);
+
+ $pipe_string = "$Lit_deatify $Verbose 0 $Lit2what $Input_file | expand";
+ print STDERR "QUICK LIT2PGM:in=$pipe_string\n" if $Verbose;
+ print STDERR " out=$Proc_outfile\n" if $Verbose;
+ &do_std_opens($pipe_string,$Proc_outfile);
+
+ # this "quick" loop does as little as possible
+ while (<INPIPE>) {
+ if ( /^srcfile!_!(.*)!_!(.*)!_!/) {
+# boot change:
+# print &mk_line_directive($1,$2);
+;
+ } else {
+ print $_ ;
+ }
+ }
+ &do_std_closes();
+ exit $Status;
+}
+
+# continue with various kinds of "processing" ...
+
+if ($Lit2pgm) {
+ print STDERR "LIT2PGM:out=$Proc_outfile\n" if $Verbose;
+ &spit_out_ribbons_code(split(/,/, $Ribbons_to_get));
+ &do_std_closes();
+ exit $Status;
+}
+
+# line 418 "lit2stuff.lprl"
+sub check_language_stuff {
+
+ # fixed tables of "language"-related info
+
+ $ISUFF2LANG{'lit'} = 'none';
+ $ISUFF2LANG{'lc'} = 'c';
+ $ISUFF2LANG{'lhs'} = 'hs';
+ $ISUFF2LANG{'lit.hs'}='hs';
+ $ISUFF2LANG{'lprl'} = 'prl';
+ $ISUFF2LANG{'llex'} = 'lex';
+
+ $STD_LANGS = 'none,c,hs,prl,lex'; # fully supported (?)
+
+ $XREF_HINTS = ''; # could have more...
+ $PAGEBREAK_HINTS = '';
+ $TYPESET_HINTS = '';
+
+ $Code_lang =
+ ($opt_l) ? $opt_l
+ : (defined($ISUFF2LANG{$Inputfile_suff})) ? $ISUFF2LANG{$Inputfile_suff}
+ : 'none';
+ $Lang_pagebreak = ($opt_p) ? $opt_p : '';
+ $Lang_typeset = ($opt_t) ? $opt_t : '';
+ $Lang_xref = ($opt_x) ? $opt_x : '';
+
+ &not_OK("","","xref hints unknown: $Lang_xref\n")
+ if $Lang_xref && index( $XREF_HINTS, $Lang_xref ) < 0;
+ &not_OK("","","pagebreak hints unknown: $Lang_pagebreak\n")
+ if $Lang_pagebreak && index( $PAGEBREAK_HINTS, $Lang_pagebreak ) < 0;
+ &not_OK("","","typeset hints unknown: $Lang_typeset\n")
+ if $Lang_typeset && index( $TYPESET_HINTS, $Lang_typeset ) < 0;
+}
+# line 472 "lit2stuff.lprl"
+sub do_std_opens { # opens INPIPE, and OUTF; selects the latter
+
+ local($pipe_string,$output_file) = @_;
+
+ # check it output is to a pipe
+ $output_file = ">$output_file" if $output_file !~ /^\|/;
+
+ open(INPIPE, "$pipe_string |")
+ || die "$Pgm: can't start prefilter pipe: $pipe_string\n";
+ open(OUTF, "$output_file")
+ || die "$Pgm: can't open output file: $output_file\n";
+ select(OUTF);
+}
+
+sub do_std_closes { # closes INPIPE and OUTF; re-selects STDOUT
+
+ close(INPIPE);
+ # most regrettably, this only tells if the _last_ thing
+ # in the pipeline croaked...
+ if ($? >> 8) {
+ print STDERR "$Pgm: error(s) from prefilter pipe\n";
+ unlink("/usr/tmp/lit2stuff-po.$$"); # this might exist...
+ exit 1;
+ }
+ close(OUTF);
+ if ($? >> 8) {
+ print STDERR "$Pgm: error in closing output file: $?\n";
+ unlink("/usr/tmp/lit2stuff-po.$$"); # this might exist...
+ exit 1;
+ }
+ select(STDOUT);
+}
+
+sub not_OK { # report error, increment $Status, but keep going
+ local($srcfilename, $srclineno, $msg) = @_;
+ if ($srcfilename) { # not always there
+ print STDERR "$srcfilename:$srclineno: $msg";
+ } else {
+ print STDERR "$Pgm: $msg";
+ }
+ $Status++;
+}
+
+sub filter_string {
+ local($filter, $string) = @_;
+
+ open(FILT, "| $filter > /tmp/lit$$") || die "Can't open in filter_string\n";
+ print FILT $string;
+ close(FILT);
+ if ($? >> 8) { # something went wrong in the pipe ???
+ print STDERR "$Pgm: error(s) in/from filter: $filter\n";
+ }
+ local($filtered_string) = `cat /tmp/lit$$`;
+ unlink("/tmp/lit$$");
+ $filtered_string;
+}
+
+sub deatified2verb_nl { # lit-deatify put 'em in; now we take 'em out
+ local($_) = @_;
+
+ s/\001newline\003/\n/g; # _WITH_ newlines
+ s/\001lbrace\003/\{/g;
+ s/\001rbrace\003/\}/g;
+ s/\001rbracket\003/\]/g;
+
+ $_;
+}
+
+sub deatified2verb { # without newlines
+ local($_) = @_;
+
+ $_ = &deatified2verb_nl($_);
+
+ s/\n/ /g; # the difference; to SPACES
+ $_;
+}
+
+sub de_newlined {
+ local($_) = @_;
+
+ s/\n/\001newline\003/g;
+ $_;
+}
+
+sub root_and_suffix {
+ local($filename) = @_;
+ local($root,$suffix);
+
+ # find the file's "suffix" (NB: *.lit.hs has a 6-letter suffix)
+ if ($filename =~ /\.(lit\.[^\.\/]+)$/) { # cf \input handling in reader
+ $suffix = $1;
+ ($root = $filename) =~ s/\.(lit\.[^\.\/]+)$//;
+
+ } elsif ($filename =~ /\.([^\.\/]+)$/) {
+ $suffix = $1;
+ ($root = $filename) =~ s/\.([^\.\/]+)$//;
+
+ } else {
+ # should there be a warning or something here?
+ $root = '???';
+ $suffix = '???';
+ }
+ ($root, $suffix);
+}
+