From e51617ee3997267b949ba93305b887118cf664d9 Mon Sep 17 00:00:00 2001 From: "Achim D. Brucker" Date: Thu, 26 Mar 2009 14:05:35 +0000 Subject: [PATCH] update to polyml 5.2.1 git-svn-id: https://projects.brucker.ch/su4sml/svn/su4sml/trunk@8439 3260e6d1-4efc-4170-b0a7-36055960796d --- su4sml/src/compiler/polyml-5.2.sml | 12 ++++---- su4sml/src/rep_logger.sml | 48 +++++++++++++++--------------- su4sml/src/xmi_idtable.sml | 10 +++---- 3 files changed, 36 insertions(+), 34 deletions(-) diff --git a/su4sml/src/compiler/polyml-5.2.sml b/su4sml/src/compiler/polyml-5.2.sml index 5872aca..cc9b773 100644 --- a/su4sml/src/compiler/polyml-5.2.sml +++ b/su4sml/src/compiler/polyml-5.2.sml @@ -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] diff --git a/su4sml/src/rep_logger.sml b/su4sml/src/rep_logger.sml index e7ba115..7f7eed4 100644 --- a/su4sml/src/rep_logger.sml +++ b/su4sml/src/rep_logger.sml @@ -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 diff --git a/su4sml/src/xmi_idtable.sml b/su4sml/src/xmi_idtable.sml index d057fba..de0e49b 100644 --- a/su4sml/src/xmi_idtable.sml +++ b/su4sml/src/xmi_idtable.sml @@ -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, *)