## patchfile.pkg
#
# Adding content to files in spots
# marked by linepairs like
#
# # Do not edit this or following lines --- they are autobuilt.
# ...
# # Do not edit this or preceding lines --- they are autobuilt.
# Compiled by:
# src/lib/std/standard.libstipulate
package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg package deq = queue; # queue is from src/lib/src/queue.pkg package psx = posixlib; # posixlib is from src/lib/std/src/psx/posixlib.pkg package sm = string_map; # string_map is from src/lib/src/string-map.pkg #
=~ = regex::(=~);
herein
# This package is invoked in:
#
# src/lib/make-library-glue/make-library-glue.pkg package patchfile:
Patchfile # Patchfile is from src/lib/make-library-glue/patchfile.api {
# We divide the files we patch into texts and patches
# according to the scheme
#
# text
# # Do not edit this or following lines --- they are autobuilt.
# patch
# # Do not edit this or preceding lines --- they are autobuilt.
# text
#
# where the texts are literal program text provided by the
# programmer whereas the patches are literal program text
# which we synthesize. (The shown 'do not edit' lines are
# considered part of the texts.)
#
# We represent such a file in memory as a list of file
# parts (that is, texts and patches) where each part
# is in turn a list of lines represented as strings:
#
Patch = { patchname: String, # This is the externally visible representation of a patch,
lines: List(String) # designed for client-code convenience, mostly used for
}; # arguments to (and results from) exported functions.
Patch_Id = { filename: String,
patchname: String
};
Patch' = { patch_id: Patch_Id,
lines: List(String)
};
Patch'' = { patchname: String, # This is the internal representation of a patch,
deque: deq::Queue(String) # which allows for more efficient prepend/append operations.
};
File_Part = TEXT List(String) # Static part contents as a list of lines.
| PATCH String # Name of patch.
;
Patchfile = PATCHFILE {
filename: String,
parts: List(File_Part), # This preserves the order of the file parts and the contents of the TEXT parts.
patches: sm::Map(Patch'') # This preserves the contents of the patches, indexed by name.
};
fun print_patchfile (PATCHFILE { filename, parts, patches })
=
{ printf "PATCHFILE filename = '%s'\n" filename;
printf "PATCHFILE parts follow:\n";
print_patchfile_parts parts;
}
where
fun print_strings [] => ();
print_strings (string ! rest)
=>
{ print string;
print_strings rest;
};
end;
fun print_patchfile_parts []
=>
();
print_patchfile_parts (TEXT strings ! rest)
=>
{ print "TEXT:\n";
print_strings strings;
print_patchfile_parts rest;
};
print_patchfile_parts (PATCH patchname ! rest)
=>
case (sm::get (patches, patchname))
#
THE { patchname, deque }
=>
{ printf "PATCH '%s':\n" patchname;
print_strings (deq::to_list deque);
print_patchfile_parts rest;
};
NULL => raise exception DIE "impossible";
esac;
end;
end;
fun patch_count (PATCHFILE { parts, ... })
=
patch_count' (parts, 0)
where
fun patch_count' ([], n) => n;
patch_count' ( TEXT _ ! rest, n) => patch_count' (rest, n );
patch_count' (PATCH _ ! rest, n) => patch_count' (rest, n + 1);
end;
end;
fun text_count (PATCHFILE { parts, ... })
=
text_count' (parts, 0)
where
fun text_count' ([], n) => n;
text_count' ( TEXT _ ! rest, n) => text_count' (rest, n + 1);
text_count' (PATCH _ ! rest, n) => text_count' (rest, n );
end;
end;
fun get_patch_names (PATCHFILE { patches, ... })
=
sm::keys_list patches;
stipulate
fun get (PATCHFILE { filename, patches, ... }, patchname)
=
case (sm::get (patches, patchname))
#
THE patch => patch;
NULL => raise exception DIE (sprintf "No patch %s in file %s" patchname filename);
esac;
herein
fun get_patch (pf as PATCHFILE { filename, patches, ... }, patchname)
=
{ (get (pf, patchname)) -> { patchname, deque };
#
{ patchname, lines => deq::to_list deque };
};
fun apply_patch (pf as PATCHFILE { filename, parts, patches }) { patchname, lines }
=
{ get (pf, patchname); # Verify that patch exists.
#
PATCHFILE { filename, parts, patches => sm::set (patches, patchname, { patchname, deque => deq::from_list lines } ) };
};
fun prepend_to_patch (pf as PATCHFILE { filename, parts, patches }, patchname, lines)
=
{ (get (pf, patchname)) -> { patchname, deque };
#
PATCHFILE { filename, parts, patches => sm::set (patches, patchname, { patchname, deque => deq::unpull' (deque, lines) } ) };
};
fun append_to_patch (pf as PATCHFILE { filename, parts, patches }, patchname, lines)
=
{ (get (pf, patchname)) -> { patchname, deque };
#
PATCHFILE { filename, parts, patches => sm::set (patches, patchname, { patchname, deque => deq::push' (deque, lines) } ) };
};
end;
fun get_only_patch (pf as PATCHFILE { filename, parts, patches })
=
case (patch_count pf)
#
1 => get_patch' parts
where
fun get_patch' [] => raise exception DIE "impossible";
get_patch' ( TEXT _ ! rest) => get_patch' rest;
get_patch' (PATCH patchname ! _ ) => case (sm::get (patches, patchname))
#
THE { patchname, deque } => deq::to_list deque;
NULL => raise exception DIE "impossible";
esac;
end;
end;
n => raise exception DIE (sprintf "get_only_patch: Patchable file %s has %d patches instead of 1" filename n);
esac;
fun set_only_patch (pf as PATCHFILE { filename, parts, patches }) lines
=
case (patch_count pf)
#
1 => PATCHFILE { filename, parts, patches => set_patch' parts }
where
fun set_patch' [] => raise exception DIE "impossible";
#
set_patch' (TEXT _ ! rest) => set_patch' rest;
set_patch' (PATCH patchname ! _) => sm::set (patches, patchname, { patchname, deque => deq::from_list lines } );
end;
end;
n => raise exception DIE (sprintf "set_only_patch: patchable file %s has %d patches instead of 1" filename n);
esac;
fun apply_patches (pf as PATCHFILE { filename, parts, patches }) replacement_patches
=
PATCHFILE { filename, parts, patches => set_it (replacement_patches, patches) }
where
fun set_it ([], patches) => patches;
#
set_it (({ patchname, lines }) ! rest, patches)
=>
case (sm::get (patches, patchname))
#
THE _ => set_it (rest, sm::set (patches, patchname, { patchname, deque => deq::from_list lines } ));
NULL => raise exception DIE "impossible";
esac;
end;
end;
fun make_patch_beginline { patchname: String } = sprintf " Do not edit this or following lines --- they are autobuilt. (patchname=\"%s\")" patchname;
fun make_patch_endline { patchname: String } = sprintf " Do not edit this or preceding lines --- they are autobuilt. (patchname=\"%s\")" patchname;
#
# The point of these two functions is to avoid embedding knowledge
# about these magic lines in files that generate patchable files.
#
# We do not include newlines because caller may need to wrap
# the lines in (say) /* ... */ style comment characters.
# Read and return a Patchfile:
#
fun read_patchfile filename
=
{
fd = fil::open_for_read filename
except
io_exceptions::IO _
=
raise exception DIE (sprintf "Fatal: Unable to open input file '%s'" filename);
my (parts, patches)
=
read_text ([], sm::empty, [])
where
fun read_text (parts, patches, lines)
=
case (fil::read_line fd)
#
NULL => (reverse ((TEXT (reverse lines)) ! parts), patches);
THE line
=>
if (line =~ ./ Do not edit this or following lines --- they are autobuilt. \(patchname="[A-Za-z0-9_\-]+"\)/)
#
patchname = the (regex::find_first_match_to_ith_group 1 ./patchname="([A-Za-z0-9_\-]+)"/ line); # Removing the \ from the pattern yields a useless 'unable to parse' error message. XXX SUCKO FIXME.
#
read_patch ((TEXT (reverse (line ! lines))) ! parts, patches, patchname, []);
else
read_text (parts, patches, line ! lines);
fi;
esac
also
fun read_patch (parts, patches, patchname, lines)
=
case (fil::read_line fd)
#
THE line
=>
if (line =~ ./ Do not edit this or preceding lines --- they are autobuilt./)
#
patches = sm::set (patches, patchname, { patchname, deque => deq::from_list (reverse lines) } );
read_text ((PATCH patchname) ! parts, patches, [ line ]);
else
read_patch (parts, patches, patchname, line ! lines);
fi;
NULL => raise exception DIE (sprintf "Fatal: Missing 'Do not edit this or preceding lines' line in %s" filename);
esac;
end;
fil::close_input fd;
PATCHFILE { filename, parts, patches };
};
# Write a patchable file back into the filesystem.
#
fun write_patchfile (PATCHFILE { filename, parts, patches })
=
{
stat = psx::stat filename; # Get original filemode, so that we can create updated copy of file with same mode.
patch_lines_written = REF 0;
#
tmp_filename = filename + "~"; # Write updated file to a temporary filename, so that if we
# crash halfway through the write, the original remains untouched.
fd = psx::creat (tmp_filename, stat.mode)
except
_ = raise exception DIE (sprintf "Fatal: Unable to open output file '%s'" tmp_filename);
fun write_text_lines (line ! rest)
=>
{ psx::write_string (fd, line);
#
write_text_lines rest;
};
write_text_lines [] => ();
end;
fun write_patch_lines (line ! rest) # Actually 'line' may be just a string (i.e., line fragment).
=>
{ psx::write_string (fd, line);
#
patch_lines_written := *patch_lines_written + 1; # This is the only difference between us and write_text_lines.
write_patch_lines rest;
};
write_patch_lines [] => ();
end;
write_text parts
where
fun write_text ((TEXT lines) ! rest)
=>
{
write_text_lines lines;
write_patch rest;
};
write_text []
=>
();
write_text _
=>
raise exception DIE (sprintf "Internal bug detected in write_text in write_patchfile while processing %s" filename);
end
also
fun write_patch ((PATCH patchname) ! rest)
=>
{
case (sm::get (patches, patchname))
#
THE { patchname, deque } => write_patch_lines (deq::to_list deque);
#
NULL => raise exception DIE "impossible";
esac;
write_text rest;
};
write_patch []
=>
();
write_patch _
=>
raise exception DIE (sprintf "Internal bug detected in write_patch in write_patchfile while processing %s" filename);
end;
end;
psx::close fd;
# To avoid needlessly exciting Make or emacs or such,
# it is good to avoid overwriting/replacing the original
# file unless the new one is different:
#
if (not (psx::file_contents_are_identical (filename, tmp_filename)))
#
winix__premicrothread::file::remove_file filename;
winix__premicrothread::file::rename_file { from => tmp_filename, to => filename };
sprintf "Alterations to file %-50s %4d lines of patches." (filename+":") *patch_lines_written;
else
winix__premicrothread::file::remove_file tmp_filename;
sprintf "No net change to file %s." filename;
fi;
};
# Write a patchable file back into the filesystem.
#
fun write_patchfile' patchfile patches
=
{ patchfile = apply_patches patchfile patches;
#
write_patchfile patchfile;
};
fun map_patches user_fn (pf as PATCHFILE { filename, parts, patches }) # Transform lines of all patches per user_fn.
=
{ patches = sm::map map_it patches
where
fun map_it { patchname, deque }
=
{ list = user_fn { patch_id => { filename, patchname }, # Transform from internal to external patch representation and apply user fn.
lines => deq::to_list deque
};
#
{ patchname, deque => deq::from_list list }; # Transform back from external to internal patch representation.
};
end;
PATCHFILE { filename, parts, patches };
};
fun patch_apply user_fn (pf as PATCHFILE { filename, parts, patches }) # Call user_fn on all patches.
=
{ patches = sm::apply apply_fn patches
where
fun apply_fn { patchname, deque }
=
user_fn { patch_id => { filename, patchname }, # Transform from internal to external patch representation and apply user fn.
lines => deq::to_list deque
};
end;
};
fun patch_fold user_fn init (patchfile as PATCHFILE { filename, patches, ... })
=
sm::fold_backward patch_fold' init patches
where
fun patch_fold' ({ patchname, deque }, result)
=
user_fn ( { patch_id => { filename, patchname },
lines => deq::to_list deque
},
result
);
end;
fun empty_all_patches pf
=
map_patches (\\ _ = []) pf;
map = map_patches; # Calling these 'map', 'apply' and 'fold' in the main body of the file risks confusion
apply = patch_apply; # with list::map and list::apply, but exporting them as pf::map etc is nonproblematic.
fold = patch_fold;
};
end;
## Code by Jeff Prothero: Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.