update to polyml 5.2.1

git-svn-id: https://projects.brucker.ch/su4sml/svn/su4sml/trunk@8439 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
Achim D. Brucker 2009-03-26 14:05:35 +00:00
parent 33a6f501a8
commit e51617ee39
3 changed files with 36 additions and 34 deletions

View File

@ -50,19 +50,21 @@ fun drop_last [] = []
fun eval verbose txt =
let
fun drop_newline s =
if String.isSuffix "\n" s then String.substring (s, 0, size s - 1)
else s;
fun eval_fh (print, err) verbose txt =
let
val in_buffer = ref (explode txt);
val in_buffer = ref (String.explode txt);
val out_buffer = ref ([]: string list);
fun output () = SML90.implode (drop_last (rev (! out_buffer)));
(* fun output () = SML90.implode (drop_last (rev (! out_buffer))); *)
fun output () = drop_newline (SML90.implode (rev (! out_buffer)));
fun get () =
(case ! in_buffer of
[] => NONE
| c :: cs => (in_buffer := cs; SOME c));
| c :: cs => (in_buffer := cs; SOME c));
fun put s = out_buffer := s :: ! out_buffer;
val parameters =
[PolyML.Compiler.CPOutStream put]

View File

@ -50,15 +50,15 @@ sig
val get_strict_logging : unit -> bool
val ERROR : log_level
val WARN : log_level
val INFO : log_level
val LERROR : log_level
val LWARN : log_level
val LINFO : log_level
val DEBUG_1 : log_level
val DEBUG_2 : log_level
val DEBUG_3 : log_level
val DEBUG_4 : log_level
val DEBUG_5 : log_level
val LDEBUG_1 : log_level
val LDEBUG_2 : log_level
val LDEBUG_3 : log_level
val LDEBUG_4 : log_level
val LDEBUG_5 : log_level
val get_log_level_str : unit -> string
@ -83,16 +83,16 @@ struct
infix 1 |>
fun x |> f = f x
val ERROR = 0
val WARN = 10
val INFO = 20
val DEBUG_1 = 30
val DEBUG_2 = 40
val DEBUG_3 = 50
val DEBUG_4 = 60
val DEBUG_5 = 70
val LERROR = 0
val LWARN = 10
val LINFO = 20
val LDEBUG_1 = 30
val LDEBUG_2 = 40
val LDEBUG_3 = 50
val LDEBUG_4 = 60
val LDEBUG_5 = 70
val logLevel = ref WARN
val logLevel = ref LWARN
fun set_log_level l = (logLevel := l;())
fun get_log_level () = !logLevel
@ -138,13 +138,13 @@ struct
fun error s = ((print o mk_error_string) s; raise Fail s)
fun errorExn ex s = ((print o mk_error_string) s; raise ex)
fun warn msg = msg |> mk_warn_string |> trace WARN
fun info msg = msg |> mk_info_string |> trace INFO
fun debug1 msg = msg |> mk_debug_string |> trace DEBUG_1
fun debug2 msg = msg |> mk_debug_string |> trace DEBUG_2
fun debug3 msg = msg |> mk_debug_string |> trace DEBUG_3
fun debug4 msg = msg |> mk_debug_string |> trace DEBUG_4
fun debug5 msg = msg |> mk_debug_string |> trace DEBUG_5
fun warn msg = msg |> mk_warn_string |> trace LWARN
fun info msg = msg |> mk_info_string |> trace LINFO
fun debug1 msg = msg |> mk_debug_string |> trace LDEBUG_1
fun debug2 msg = msg |> mk_debug_string |> trace LDEBUG_2
fun debug3 msg = msg |> mk_debug_string |> trace LDEBUG_3
fun debug4 msg = msg |> mk_debug_string |> trace LDEBUG_4
fun debug5 msg = msg |> mk_debug_string |> trace LDEBUG_5
(* fun printStackTrace e =
let val ss = CompilerExt.exnHistory e

View File

@ -461,31 +461,31 @@ fun insert_classifier table package_prefix class =
XMI.classifier_elementtype_of class])
handle ex => case argoUMLWorkaround name of
SOME c => Rep_OclType.Collection (c)
| None => raise ex
| NONE => raise ex
else if String.isPrefix "Sequence(" name
then Rep_OclType.Sequence (Rep_OclType.Classifier [
XMI.classifier_elementtype_of class])
handle ex => case argoUMLWorkaround name of
SOME c => Rep_OclType.Sequence c
| None => raise ex
| NONE => raise ex
else if String.isPrefix "Set(" name
then Rep_OclType.Set (Rep_OclType.Classifier [
XMI.classifier_elementtype_of class])
handle ex => case argoUMLWorkaround name of
SOME c => Rep_OclType.Set c
| None => raise ex
| NONE => raise ex
else if String.isPrefix "Bag(" name
then Rep_OclType.Bag (Rep_OclType.Classifier [
XMI.classifier_elementtype_of class])
handle ex => case argoUMLWorkaround name of
SOME c => Rep_OclType.Bag c
| None => raise ex
| NONE => raise ex
else if String.isPrefix "OrderedSet(" name
then Rep_OclType.OrderedSet (Rep_OclType.Classifier [
XMI.classifier_elementtype_of class])
handle ex => case argoUMLWorkaround name of
SOME c => Rep_OclType.OrderedSet c
| None => raise ex
| NONE => raise ex
else Logger.error ("didn't recognize ocltype "^name)
else Rep_OclType.Classifier path
(* This function is called before the associations are handled, *)