Admin/isatest/annomaly.ML
changeset 49469 808a5ba61991
parent 49468 2421ff8c57a5
parent 49467 4ad6182d5bb9
child 49470 a509f19d4cc6
child 49504 aff95a0212d8
     1.1 --- a/Admin/isatest/annomaly.ML	Mon Jul 23 18:52:10 2012 +0200
     1.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.3 @@ -1,69 +0,0 @@
     1.4 -(*  Title:      Admin/isatest/annomaly.ML
     1.5 -    Author:     Martin von Gagern <martin@von-gagern.net>
     1.6 -*)
     1.7 -
     1.8 -use "ML-Systems/smlnj.ML";
     1.9 -
    1.10 -local
    1.11 -
    1.12 -  val smlnj_use_text = use_text
    1.13 -
    1.14 -  val smlnj_use_file = use_file
    1.15 -
    1.16 -  val smlnj_forget_structure = forget_structure
    1.17 -
    1.18 -  fun mkAbsolute path =
    1.19 -      OS.Path.mkAbsolute { path = path, relativeTo = OS.FileSys.getDir () }
    1.20 -
    1.21 -  fun toArcs path = #arcs (OS.Path.fromString path)
    1.22 -
    1.23 -  val isabelleHome =
    1.24 -      case OS.Process.getEnv "ISABELLE_HOME"
    1.25 -       of  NONE => OS.FileSys.getDir ()
    1.26 -         | SOME home => mkAbsolute home
    1.27 -
    1.28 -  fun noparent [] = []
    1.29 -    | noparent (n :: ns) =
    1.30 -      if n = OS.Path.parentArc then noparent ns else n :: noparent ns
    1.31 -
    1.32 -  fun isabellePath [] = []
    1.33 -    | isabellePath ("src" :: name) = "Isabelle" :: name
    1.34 -    | isabellePath (name as (n :: ns)) =
    1.35 -      if n = OS.Path.parentArc then noparent ns else "Isabelle" :: name
    1.36 -
    1.37 -  fun rewrite defPrefix name =
    1.38 -      let val abs = mkAbsolute name
    1.39 -          val rel = OS.Path.mkRelative { path = abs, relativeTo = isabelleHome }
    1.40 -          val exists = (OS.FileSys.access(abs, nil)
    1.41 -                        handle OS.SysErr _ => false)
    1.42 -      in  if exists andalso rel <> ""
    1.43 -          then isabellePath (toArcs rel)
    1.44 -          else defPrefix @ noparent (toArcs name)
    1.45 -      end handle OS.Path.Path => defPrefix @ noparent (toArcs name)
    1.46 -
    1.47 -in
    1.48 -
    1.49 -  fun use_text tune str_of_pos name_space (line, name) p v t =
    1.50 -    let val name = case name of "" => "unnamed" | name => name
    1.51 -        val arcs = rewrite ["use_text"] name
    1.52 -        (* should we have different files for different line numbers? *
    1.53 -        val arcs = if line <= 1 then arcs
    1.54 -                   else arcs @ [ "l." ^ Int.toString line ]
    1.55 -        *)
    1.56 -        val arcs = if t = "structure Isabelle =\nstruct\nend;"
    1.57 -                      andalso name = "ML"
    1.58 -                   then ["empty_Isabelle", "empty" ] else arcs
    1.59 -        val _    = AnnoMaLy.nameNextStream arcs
    1.60 -    in  smlnj_use_text tune str_of_pos name_space (line, name) p v t  end;
    1.61 -
    1.62 -  fun use_file tune str_of_pos name_space output verbose name =
    1.63 -      let val arcs = rewrite ["use_file"] name
    1.64 -          val _    = AnnoMaLy.nameNextStream arcs
    1.65 -      in  smlnj_use_file tune str_of_pos name_space output verbose name  end;
    1.66 -
    1.67 -  fun forget_structure name =
    1.68 -      let val arcs = [ "forget_structure", name ]
    1.69 -          val _    = AnnoMaLy.nameNextStream arcs
    1.70 -      in  smlnj_forget_structure name  end;
    1.71 -
    1.72 -end;