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:
parent
33a6f501a8
commit
e51617ee39
|
@ -50,19 +50,21 @@ fun drop_last [] = []
|
||||||
|
|
||||||
fun eval verbose txt =
|
fun eval verbose txt =
|
||||||
let
|
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 =
|
fun eval_fh (print, err) verbose txt =
|
||||||
let
|
let
|
||||||
val in_buffer = ref (explode txt);
|
val in_buffer = ref (String.explode txt);
|
||||||
val out_buffer = ref ([]: string list);
|
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 () =
|
fun get () =
|
||||||
(case ! in_buffer of
|
(case ! in_buffer of
|
||||||
[] => NONE
|
[] => NONE
|
||||||
| c :: cs => (in_buffer := cs; SOME c));
|
| c :: cs => (in_buffer := cs; SOME c));
|
||||||
fun put s = out_buffer := s :: ! out_buffer;
|
fun put s = out_buffer := s :: ! out_buffer;
|
||||||
|
|
||||||
|
|
||||||
val parameters =
|
val parameters =
|
||||||
[PolyML.Compiler.CPOutStream put]
|
[PolyML.Compiler.CPOutStream put]
|
||||||
|
|
||||||
|
|
|
@ -50,15 +50,15 @@ sig
|
||||||
val get_strict_logging : unit -> bool
|
val get_strict_logging : unit -> bool
|
||||||
|
|
||||||
|
|
||||||
val ERROR : log_level
|
val LERROR : log_level
|
||||||
val WARN : log_level
|
val LWARN : log_level
|
||||||
val INFO : log_level
|
val LINFO : log_level
|
||||||
|
|
||||||
val DEBUG_1 : log_level
|
val LDEBUG_1 : log_level
|
||||||
val DEBUG_2 : log_level
|
val LDEBUG_2 : log_level
|
||||||
val DEBUG_3 : log_level
|
val LDEBUG_3 : log_level
|
||||||
val DEBUG_4 : log_level
|
val LDEBUG_4 : log_level
|
||||||
val DEBUG_5 : log_level
|
val LDEBUG_5 : log_level
|
||||||
|
|
||||||
val get_log_level_str : unit -> string
|
val get_log_level_str : unit -> string
|
||||||
|
|
||||||
|
@ -83,16 +83,16 @@ struct
|
||||||
infix 1 |>
|
infix 1 |>
|
||||||
fun x |> f = f x
|
fun x |> f = f x
|
||||||
|
|
||||||
val ERROR = 0
|
val LERROR = 0
|
||||||
val WARN = 10
|
val LWARN = 10
|
||||||
val INFO = 20
|
val LINFO = 20
|
||||||
val DEBUG_1 = 30
|
val LDEBUG_1 = 30
|
||||||
val DEBUG_2 = 40
|
val LDEBUG_2 = 40
|
||||||
val DEBUG_3 = 50
|
val LDEBUG_3 = 50
|
||||||
val DEBUG_4 = 60
|
val LDEBUG_4 = 60
|
||||||
val DEBUG_5 = 70
|
val LDEBUG_5 = 70
|
||||||
|
|
||||||
val logLevel = ref WARN
|
val logLevel = ref LWARN
|
||||||
fun set_log_level l = (logLevel := l;())
|
fun set_log_level l = (logLevel := l;())
|
||||||
fun get_log_level () = !logLevel
|
fun get_log_level () = !logLevel
|
||||||
|
|
||||||
|
@ -138,13 +138,13 @@ struct
|
||||||
|
|
||||||
fun error s = ((print o mk_error_string) s; raise Fail s)
|
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 errorExn ex s = ((print o mk_error_string) s; raise ex)
|
||||||
fun warn msg = msg |> mk_warn_string |> trace WARN
|
fun warn msg = msg |> mk_warn_string |> trace LWARN
|
||||||
fun info msg = msg |> mk_info_string |> trace INFO
|
fun info msg = msg |> mk_info_string |> trace LINFO
|
||||||
fun debug1 msg = msg |> mk_debug_string |> trace DEBUG_1
|
fun debug1 msg = msg |> mk_debug_string |> trace LDEBUG_1
|
||||||
fun debug2 msg = msg |> mk_debug_string |> trace DEBUG_2
|
fun debug2 msg = msg |> mk_debug_string |> trace LDEBUG_2
|
||||||
fun debug3 msg = msg |> mk_debug_string |> trace DEBUG_3
|
fun debug3 msg = msg |> mk_debug_string |> trace LDEBUG_3
|
||||||
fun debug4 msg = msg |> mk_debug_string |> trace DEBUG_4
|
fun debug4 msg = msg |> mk_debug_string |> trace LDEBUG_4
|
||||||
fun debug5 msg = msg |> mk_debug_string |> trace DEBUG_5
|
fun debug5 msg = msg |> mk_debug_string |> trace LDEBUG_5
|
||||||
|
|
||||||
(* fun printStackTrace e =
|
(* fun printStackTrace e =
|
||||||
let val ss = CompilerExt.exnHistory e
|
let val ss = CompilerExt.exnHistory e
|
||||||
|
|
|
@ -461,31 +461,31 @@ fun insert_classifier table package_prefix class =
|
||||||
XMI.classifier_elementtype_of class])
|
XMI.classifier_elementtype_of class])
|
||||||
handle ex => case argoUMLWorkaround name of
|
handle ex => case argoUMLWorkaround name of
|
||||||
SOME c => Rep_OclType.Collection (c)
|
SOME c => Rep_OclType.Collection (c)
|
||||||
| None => raise ex
|
| NONE => raise ex
|
||||||
else if String.isPrefix "Sequence(" name
|
else if String.isPrefix "Sequence(" name
|
||||||
then Rep_OclType.Sequence (Rep_OclType.Classifier [
|
then Rep_OclType.Sequence (Rep_OclType.Classifier [
|
||||||
XMI.classifier_elementtype_of class])
|
XMI.classifier_elementtype_of class])
|
||||||
handle ex => case argoUMLWorkaround name of
|
handle ex => case argoUMLWorkaround name of
|
||||||
SOME c => Rep_OclType.Sequence c
|
SOME c => Rep_OclType.Sequence c
|
||||||
| None => raise ex
|
| NONE => raise ex
|
||||||
else if String.isPrefix "Set(" name
|
else if String.isPrefix "Set(" name
|
||||||
then Rep_OclType.Set (Rep_OclType.Classifier [
|
then Rep_OclType.Set (Rep_OclType.Classifier [
|
||||||
XMI.classifier_elementtype_of class])
|
XMI.classifier_elementtype_of class])
|
||||||
handle ex => case argoUMLWorkaround name of
|
handle ex => case argoUMLWorkaround name of
|
||||||
SOME c => Rep_OclType.Set c
|
SOME c => Rep_OclType.Set c
|
||||||
| None => raise ex
|
| NONE => raise ex
|
||||||
else if String.isPrefix "Bag(" name
|
else if String.isPrefix "Bag(" name
|
||||||
then Rep_OclType.Bag (Rep_OclType.Classifier [
|
then Rep_OclType.Bag (Rep_OclType.Classifier [
|
||||||
XMI.classifier_elementtype_of class])
|
XMI.classifier_elementtype_of class])
|
||||||
handle ex => case argoUMLWorkaround name of
|
handle ex => case argoUMLWorkaround name of
|
||||||
SOME c => Rep_OclType.Bag c
|
SOME c => Rep_OclType.Bag c
|
||||||
| None => raise ex
|
| NONE => raise ex
|
||||||
else if String.isPrefix "OrderedSet(" name
|
else if String.isPrefix "OrderedSet(" name
|
||||||
then Rep_OclType.OrderedSet (Rep_OclType.Classifier [
|
then Rep_OclType.OrderedSet (Rep_OclType.Classifier [
|
||||||
XMI.classifier_elementtype_of class])
|
XMI.classifier_elementtype_of class])
|
||||||
handle ex => case argoUMLWorkaround name of
|
handle ex => case argoUMLWorkaround name of
|
||||||
SOME c => Rep_OclType.OrderedSet c
|
SOME c => Rep_OclType.OrderedSet c
|
||||||
| None => raise ex
|
| NONE => raise ex
|
||||||
else Logger.error ("didn't recognize ocltype "^name)
|
else Logger.error ("didn't recognize ocltype "^name)
|
||||||
else Rep_OclType.Classifier path
|
else Rep_OclType.Classifier path
|
||||||
(* This function is called before the associations are handled, *)
|
(* This function is called before the associations are handled, *)
|
||||||
|
|
Loading…
Reference in New Issue