Package: src/packages/flx_cache.fdoc

Felix Cache

key	file
flx_cache.flx	share/lib/std/felix/flx_cache.flx

The flx cache manager.

Check if the flx cache is stale and deletes it if it is.

//[flx_cache.flx]
class FlxCache
{
  fun gramtime(debugln: string -> 0) (path:string, s:string) : double = {
    //println$ "Path=" + path + " file = " + s;
    fun maxtime (x:double) (s:string) => max (x, gramtime debugln (path, s));
    if s.[0]=="@".char do
      var file =
        let f = s.[1 to].strip in
        if Filename::is_absolute_filename f then f
        else Directory::mk_absolute_filename (Filename::join$ path, f)
      ;
      var filetime = FileStat::dfiletime(file,0.0);
      if filetime == 0.0 do
        println$ "Grammar include file '" + file "' doesn't exist, exiting";
        // this one is pretty fatal :-)
        System::exit 1;
      done
      debugln$ "Grammar include file '" + file + "' time=" + FileStat::strfiletime(filetime);
      var filetext = load file;
      var files = split (filetext, "\n");
      files = map strip of (string) files;
      files = filter (fun (s:string) => s != "") files;
      files = map (fun (s:string) => Filename::join (split(s,"/"))) files;
      //println$ "Files=" + files;
      return fold_left maxtime filetime files;
    else
      file = Filename::join$ path, s;
      filetime = FileStat::dfiletime(file,0.0);
      if filetime == 0.0 do
        println$ "Grammar file " + file " doesn't exist, exiting";
        // this one is pretty fatal :-)
        System::exit 1;
      done
      debugln$ "Grammar file " + file + " time=" + FileStat::strfiletime(filetime);
      return filetime;
    done
  }

  // FLX_INSTALL_DIR: root for finding standard grammar
  // STDGRAMMAR: root standard grammar key, within FLX_INSTALL_DIR
  //      usually "grammar/grammar.files"
  // FLXG: absolute filename of felix compiler executable

  // CACHE_DIR: absolute filename of binary cache
  // OUTPUT_DIR: absolute filename of text cache

  // DEFAULT_CACHE_DIR: default location of CACHE_DIR
  // DEFAULT_OUTPUT_DIR: default location of OUTPUT_DIR
  //    These defaults are used to determine if the
  //    the cache should be deleted automatically
  //    or a an interactive query used to verify.
  //    Automatic deletion requies the caches to be the default.
  // CLEAR_CACHE: switch to force clearing the cache

  typedef cache_validation_spec_t =
  (
     FLX_SHARE_DIR:string,
     GRAMMAR_DIR:string,
     STDGRAMMAR:string,
     FLXG:string,
     CACHE_DIR:string,
     OUTPUT_DIR:string,
     CLEAR_CACHE: int,
     AUTOMATON: string,
     debugln : string -> 0,
     xqt: string -> string,
     quote: string -> string
  );


  // CACHE VALIDATION
  //
  // This function validates the current cache, and if it is considered
  // stale may flush it. If the cache is the default one in the users
  // home directory the flush is done noisily but unconditionally.
  // Otherwise the user is prompted for permission.
  // The special cache locations / and . or "" are never deleted
  // in case it wipes out parts of the root, home, or current directory.

  // The validation checks the time of the flxg compiler used to build
  // it against the current flxg compiler, these must be exactly equal.
  //
  // It also checks that all the files defining the grammar are older
  // than the generated automaton.
  //
  // It does NOT check any RTL C++ libraries are up to date.
  // It does NOT check any Felix program files are up to date.
  // Therefore it does NOT guarrantee the contents of the cache are valid.
  // Rather it ensures only that the compiler and cached automaton are not stale.
  // However if they are stale the whole cache is invalidated.
  //
  // In effect this means this function ensures the parser is ready and valid
  // or non-existant. The compiler and automaton are locked together. If the compiler
  // changes the automaton must be rebuilt.

  // returns cache time
  gen validate_cache  (var spec: cache_validation_spec_t) : int * double =
  {

    // ensure the cache directory exists
    Directory::mkdirs(spec.CACHE_DIR);

    // get the OS timestamp of the flxg compiler, +inf if not found
    var flxg_time = FileStat::dfiletime(spec.FLXG, #FileStat::future_time);
    spec.debugln$ "Flxg=" + spec.FLXG;
    spec.debugln$ "Flxg_time=" + FileStat::strfiletime(flxg_time);

    // get the OS timestamp of the file flxg_time.stamp
    // this file is created with the cache
    var flxg_stamp = Filename::join spec.CACHE_DIR "flxg_time.stamp";
    var cache_time = FileStat::dfiletime(flxg_stamp,#FileStat::future_time);
    spec.debugln$ "cache_time=" + FileStat::strfiletime(cache_time);

    // get the timestamp string recorded in flxg_time.stamp
    var flxg_stamp_data = load flxg_stamp;
    //println$ "Flxg_stamp_data=" + flxg_stamp_data;

    // convert the timestamp string to a double, if there is junk
    // there or the string is empty, 0.0 is returned by atof,
    // adjust that to -inf
    var flxg_stamp_time = match flxg_stamp_data.atof with | 0.0 => #FileStat::past_time | x => x;

    spec.debugln$ "Flxg_stamp_data : " + FileStat::strfiletime(flxg_stamp_time);

    // Calculate the time of the newest text file defining the grammar
    // these are files in directory share/lib/grammar.
    var grammar_time = gramtime spec.debugln (spec.GRAMMAR_DIR, "@"+spec.STDGRAMMAR);
    spec.debugln$ "Grammar text time=" + FileStat::strfiletime (grammar_time);

    // calculate the name of the compiled grammar automaton in the cache
    var automaton_name = spec.AUTOMATON;

    // Get the timestamp of the grammar automaton or -inf if it doesn't exist.
    var automaton_time = FileStat::dfiletime(automaton_name,#FileStat::past_time);
    spec.debugln$ "Automaton " + automaton_name + " time=" + FileStat::strfiletime(automaton_time);

    // If the cache exists and the recorded compiler time stamp is not equal
    // to the current compiler time stamp, then the cache is stale
    // and should be deleted.
    if cache_time != #FileStat::future_time and flxg_stamp_time != flxg_time do
      println$ "Cache may be out of date due to compiler change!";
      println$ "Flxg compiler time stamp=" + FileStat::strfiletime(flxg_time);
      println$ "Cache time stamp        =" + FileStat::strfiletime(cache_time);

      // special safety check if the output dirs are root or current directory
      if not (
        (spec.OUTPUT_DIR == "/" or spec.OUTPUT_DIR == "" or spec.OUTPUT_DIR == ".") or
        (spec.CACHE_DIR == "/" or spec.CACHE_DIR == "" or spec.CACHE_DIR == ".")
      )
      do
        spec&.CLEAR_CACHE <- 1;
      done

    // If the automaton exists and the grammar is newer than the automaton
    // then the cache is stale and should be deleted.
    elif grammar_time > automaton_time do
      println$ "Cache may be out of date due to grammar upgrade!";
      println$ "Grammar time stamp          =" + FileStat::strfiletime(grammar_time);
      println$ "Automaton.syntax time stamp =" + FileStat::strfiletime(automaton_time);
      spec&.CLEAR_CACHE <- 1;
    done

    // FFF BE CAREFUL! The value "/" for these caches is perfectly good
    if spec.CLEAR_CACHE != 0 do
      // refuse to delete "" or "/" or ".", basic safety check
      if
        (spec.OUTPUT_DIR == "/" or spec.OUTPUT_DIR == "" or spec.OUTPUT_DIR == ".") or
        (spec.CACHE_DIR == "/" or spec.CACHE_DIR == "" or spec.CACHE_DIR == ".")
      do
        println "WILL NOT DELETE CACHES";
        println$ "output cache " + spec.OUTPUT_DIR;
        println$ "binary cache " + spec.CACHE_DIR;
        // INTENTIONAL EXIT
        System::exit(1);
      done

      println$ "Delete cache " + spec.OUTPUT_DIR;
      if PLAT_WIN32 do
          C_hack::ignore$ spec.xqt("mkdir "+spec.quote(spec.OUTPUT_DIR+"\\rubbish") +"& rmdir /Q /S " + spec.quote(spec.OUTPUT_DIR));
      else
          C_hack::ignore$ spec.xqt("rm -rf " + spec.quote(spec.OUTPUT_DIR));
      done
      println$ "Delete cache " + spec.CACHE_DIR;

      if PLAT_WIN32 do
          C_hack::ignore$ spec.xqt("mkdir "+spec.quote(spec.CACHE_DIR+"\\rubbish")+"& rd /Q /S " + spec.quote(spec.CACHE_DIR));
      else
          C_hack::ignore$ spec.xqt("rm -rf " + spec.quote(spec.CACHE_DIR));
      done

      // Make a new cache.
      Directory::mkdirs(spec.CACHE_DIR);

      // make the stamp file with the time of the current compiler.
      var f = fopen_output flxg_stamp;
      write(f, fmt(flxg_time, fixed (0,3)));
      f.fclose;
    done
    return spec.CLEAR_CACHE, cache_time;
  }

  fun cache_join (c:string, var f:string) =
  {
    //debugln$ "[cache_join] " + c + " with  " + f;
    if PLAT_WIN32 do
      if f.[1 to 3] == ":\\" do f = f.[0 to 1]+f.[2 to];
      elif f.[1] == char ":" do f = f.[0 to 1]+"\\"+f.[2 to];
      done
      if f.[0] == char "\\" do f = f.[1 to]; done
    else
      if f.[0] == char "/" do f = f.[1 to]; done
    done
      var k = Filename::join(c,f);
      //debugln$ "[cache_join] result = " + k;
      return k;
  }

}