HCoop / hcoop / debian / mlton.git / blame
| Commit | Line | Data |
|---|---|---|
| 7f918cf1 CE |
1 | (* debug.sml |
| 2 | * 2004 Matthew Fluet (mfluet@acm.org) | |
| 3 | * Ported to MLton threads. | |
| 4 | *) | |
| 5 | ||
| 6 | (* debug.sml | |
| 7 | * | |
| 8 | * COPYRIGHT (c) 1995 AT&T Bell Laboratories. | |
| 9 | * COPYRIGHT (c) 1989-1991 John H. Reppy | |
| 10 | * | |
| 11 | * Debugging support for the CML core. | |
| 12 | *) | |
| 13 | ||
| 14 | structure Debug : DEBUG = | |
| 15 | struct | |
| 16 | structure C = Critical | |
| 17 | val debugFlg = false | |
| 18 | ||
| 19 | fun sayDebug (msgs: (unit -> string) list, | |
| 20 | msg: unit -> string) = | |
| 21 | if debugFlg | |
| 22 | then let | |
| 23 | val msgs = List.map (fn f => f ()) msgs | |
| 24 | val msg = concat [String.concatWith " " msgs, " :: ", msg ()] | |
| 25 | in | |
| 26 | C.atomicBegin (); | |
| 27 | TextIO.print (concat [msg, "\n"]); | |
| 28 | C.atomicEnd () | |
| 29 | end | |
| 30 | else () | |
| 31 | fun sayDebug' (msg: string) = sayDebug ([], fn () => msg) | |
| 32 | end |