Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] View of /branches/vis15/src/compiler/gen/fragments/mkfrags.sml
ViewVC logotype

View of /branches/vis15/src/compiler/gen/fragments/mkfrags.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3773 - (download) (annotate)
Tue Apr 26 19:02:15 2016 UTC (4 years, 9 months ago) by jhr
File size: 3502 byte(s)
  Adding fragments generator script
(* mkfrags.sml
 *
 * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
 *
 * COPYRIGHT (c) 2016 The University of Chicago
 * All rights reserved.
 *
 * Program to generate a file "fragments.sml" containing a structure "Fragments"
 * from a CATALOG file.
 *)

structure MkFrags : sig

    val doit : string -> unit

    val main : string * string list -> OS.Process.status

  end = struct

    structure F = Format

    val smlHead = "\
          \(* %s\n\
          \ *\n\
          \ * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)\n\
	  \ *\n\
	  \ * COPYRIGHT (c) 2016 The University of Chicago\n\
          \ * All rights reserved.\n\
          \ *\n\
          \ * !!! THIS FILE WAS GENERATED; DO NOT EDIT !!!\n\
          \ *)\n\
          \\n\
          \structure Fragments =\n\
          \  struct\n\
          \"

    val smlFoot = "\
          \\n\
          \  end\n\
          \"

  (* load the catalog from the file *)
    fun loadCatalog file = let
	  val inS = TextIO.openIn file
	  fun lp l = (case TextIO.inputLine inS
		 of NONE => List.rev l
		  | SOME ln => (case String.tokens Char.isSpace ln
		     of [] => lp l
		      | s1::sr => if String.isPrefix "#" s1
			  then lp l
			  else (case sr
			     of [s2] => lp ((s1, s2) :: l)
			      | _ => raise Fail (concat[
				    "bogus input line \"", String.toString ln, "\""
				  ])
			    (* end case *))
		    (* end case *))
		(* end case *))
	  in
	    (lp [] before TextIO.closeIn inS)
              handle ex => (TextIO.closeIn inS; raise ex)
          end

  (* load the contents of an ".in" file *)
    fun load srcFile = let
          val inS = TextIO.openIn srcFile
          fun lp l = (case TextIO.inputLine inS
                 of NONE => List.rev l
                  | SOME ln => lp(ln::l)
                (* end case *))
          in
            (lp [] before TextIO.closeIn inS)
              handle ex => (TextIO.closeIn inS; raise ex)
          end

    fun doFile (outS, fragDir) (srcFile, smlVar) = let
          val text = load (OS.Path.concat (fragDir, srcFile))
          fun prf (fmt, items) = TextIO.output(outS, F.format fmt items)
          in
            prf ("\n", []);
            prf ("    val %s = \"\\\n", [F.STR smlVar]);
	    prf ("          \\/*---------- begin %s ----------*/\\n\\\n", [F.STR srcFile]);
            List.app (fn ln => prf("          \\%s\\\n", [F.STR(String.toString ln)])) text;
	    prf ("          \\/*---------- end %s ----------*/\\n\\\n", [F.STR srcFile]);
            prf ("          \\\"\n", [])
          end

    fun doit dir = let
	  val fragDir = OS.Path.concat(dir, "fragments")
	  val catalogFile = OS.Path.concat(fragDir, "CATALOG")
	  val fragFile = OS.Path.concat(dir, "fragments.sml")
	  val catalog = if OS.FileSys.access(catalogFile, [OS.FileSys.A_READ])
		then loadCatalog catalogFile
		else raise Fail(concat["cannot find \"", catalogFile, "\""])
	  val outS = TextIO.openOut fragFile
          fun prf (fmt, items) = TextIO.output(outS, F.format fmt items)
	  in
            prf (smlHead, [F.STR(OS.Path.file fragFile)]);
	    List.app (doFile (outS, fragDir)) catalog;
            prf (smlFoot, []);
            TextIO.closeOut outS
          end
	    
    fun main (_, [srcDir]) = (
          (doit srcDir; OS.Process.success) handle _ => OS.Process.failure)
      | main _ = (
          TextIO.output(TextIO.stdErr, "usage: mkfrags <dir>\n");
          OS.Process.failure)

  end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0