1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
signature MATLAB = sig
type t
val openOut: string -> t
type doubleArray
val beginDoubleArray: t * string -> doubleArray
val writeDouble: doubleArray * real -> unit
val concludeDoubleArray: doubleArray -> unit
val writeDoubleArray: t * string * real vector -> unit
val closeOut: t -> unit
end
structure Matlab :> MATLAB = struct
fun outputReal (c, f) = BinIO.output (c, Binary.fromReal f)
fun outputInt32 (c, i) = BinIO.output (c, Binary.fromInt32 i)
fun outputInt16 (c, i) = BinIO.output (c, Binary.fromInt16 i)
type t = BinIO.outstream
type doubleArray = {
outstream: BinIO.outstream
, wholeSizePos: BinIO.StreamIO.out_pos
, paddedSize: int
, arraySizePos: BinIO.StreamIO.out_pos
, dataSizePos: BinIO.StreamIO.out_pos
, elements: int ref
}
fun pad n =
if n > 0 andalso n <= 4 then 4
else (n + 7) div 8 * 8
fun doubleArraySize (nameLength, arrayLength) =
32 + nameLength + 4 + 8 + arrayLength * 8
val s8Tag = 1
val s32Tag = 5
val u32Tag = 6
val doubleTag = 9
val doubleFlag = 6
val matrixTag = 14
fun lsl (x, y) = Word.toIntX (Word.<< (Word.fromInt x, Word.fromInt y))
fun beginDoubleArray (c, name) =
let
val nameSize = Int.min (size name, 63)
val name = Word8VectorSlice.vector (
Word8VectorSlice.slice (Byte.stringToBytes name, 0, SOME nameSize)
)
val paddedSize = pad nameSize
val padding = Word8Vector.tabulate (paddedSize - nameSize, fn _ => 0w0)
val () = outputInt32 (c, matrixTag)
val wholeSizePos = BinIO.getPosOut c
val () = (
outputInt32 (c, 0)
; outputInt32 (c, u32Tag)
; outputInt32 (c, 8)
; outputInt32 (c, doubleFlag)
; outputInt32 (c, 0)
; outputInt32 (c, s32Tag)
; outputInt32 (c, 8)
; outputInt32 (c, 1)
)
val arraySizePos = BinIO.getPosOut c
val () = (
outputInt32 (c, 0)
; if nameSize > 0 andalso nameSize <= 4 then
outputInt32 (c, lsl (nameSize, 16) + s8Tag)
else (
outputInt32 (c, s8Tag)
; outputInt32 (c, nameSize)
); BinIO.output (c, name)
; BinIO.output (c, padding)
; outputInt32 (c, doubleTag)
)
val dataSizePos = BinIO.getPosOut c
val () = outputInt32 (c, 0)
in
{
outstream = c
, wholeSizePos = wholeSizePos
, paddedSize = paddedSize
, arraySizePos = arraySizePos
, dataSizePos = dataSizePos
, elements = ref 0
}
end
fun writeDouble (da, f) = (
outputReal (#outstream da, f)
; #elements da := !(#elements da) + 1
)
fun concludeDoubleArray da =
let
val saved = BinIO.getPosOut (#outstream da)
in
BinIO.setPosOut (#outstream da, #wholeSizePos da)
; outputInt32 (
#outstream da
, doubleArraySize (#paddedSize da, !(#elements da))
); BinIO.setPosOut (#outstream da, #arraySizePos da)
; outputInt32 (#outstream da, !(#elements da))
; BinIO.setPosOut (#outstream da, #dataSizePos da)
; outputInt32 (#outstream da, (!(#elements da) * 8))
; BinIO.setPosOut (#outstream da, saved)
end
fun writeDoubleArray (c, name, array) =
let
val da = beginDoubleArray (c, name)
in
Vector.app (fn x => writeDouble (da, x)) array
; concludeDoubleArray da
end
fun writeHeader (c, software, version) =
let
val date = Date.fromTimeUniv (Time.now ())
val text = concat [
"MATLAB 5.0 MAT-file, written by "
, software, " ", version, ", "
, Date.fmt "%Y-%m-$d %H:%M:%S UTC" date
]
val size = size text
val header =
CharVector.tabulate (
124
, fn i =>
if i < size then String.sub (text, i)
else #" "
)
in
BinIO.output (c, Byte.stringToBytes header)
; outputInt16 (c, 0x0100)
; outputInt16 (c, 0x4d49)
end
fun openOut name =
let
val c = BinIO.openOut name
in
writeHeader (c, Program.name, Program.version)
; c
end
val closeOut = BinIO.closeOut
end
|
