/*
Note - requires that LIST.PLM be loaded as well.
*/ :- module(misc). :- export( [ compare_nocase/2, force_ext/3, freeze/2, get_flag/2, melt/2, newcopy/2, set_flag/2 ]). :- import(list). /*
*/ compare_nocase(Atom, Atom) :- !. compare_nocase(Atom1, Atom2) :- atom_uplow(Atom1, Low), atom_uplow(Atom2, Low). /*
*/ force_ext(Name, Ext, NewName) :- % Backslashes are a pain in file names, so turn % off string esc before processing names, and then % restore it to whatever the user had. get_mode(string_esc, SE_Mode), set_mode(string_esc, off), ( force$ext(Name, Ext, NewName) -> set_mode(string_esc, SE_Mode) ; set_mode(string_esc, SE_Mode), fail). force$ext(SName, SExt, SNewName) :- string(SName), !, string_atom(SName, Name), (string(SExt) -> string_atom(SExt, Ext); Ext = SExt), string_atom(SName, Name), force_ext(Name, Ext, NewName), string_atom(SNewName, NewName). force$ext(Name, Ext, NewName) :- atom_codes(Name, CName), reverse(CName, RCName), remove$ext(RCName, RCNameNoExt), reverse(RCNameNoExt, CNameNoExt), atom_codes(Ext, CExt), force$dot(CExt, DotCExt), append(CNameNoExt, DotCExt, CNewName), atom_codes(NewName, CNewName). force$dot([0'.|Z], [0'.|Z]) :- !. force$dot(Z, [0'.|Z]). remove$ext([0'.|Z], Z) :- !. remove$ext([_, 0'.|Z], Z) :- !. remove$ext([_, _, 0'.|Z], Z) :- !. remove$ext([_, _, _, 0'.|Z], Z) :- !. remove$ext(Z, Z). /*
*/ freeze(Term, Frozen) :- newcopy(Term, Frozen), numbervars(Frozen, 1, _). /*
*/ get_flag(FLAG, VALUE) :- flag(FLAG, VALUE). /*
*/ melt(Frozen, Term) :- string_term(TempString, Frozen), string_term(TempString, Term). /*
*/ newcopy(X, Y) :- copy_term(X,Y). /*
*/ set_flag(FLAG, VALUE) :- (retract(flag(FLAG, _)); true), asserta(flag(FLAG, VALUE)). :- end_module(misc).