2 * Author
: Matthew
Fluet (mfluet@acm
.org
)
4 * This requires that you have SML
/NJ installed
.
5 * It works
with SML
/NJ
110.47 and may require changes to work
with other
6 * versions
, since it depends on the CM
structure.
8 * cm2mlb takes a
".cm" file
and prints on stdout a corresponding
".mlb".
10 * To use from the REPL
, do the following
:
11 * CM2MLB
.cm2mlb
{defines
= ["MLton"],
14 * sources
= "sources.cm",
15 * out
= TextIO.stdOut
}
17 * Before using from the shell
, you must
do the following
, where <smlnj
> is
18 * the root directory
of the SML
/NJ installation
. You may need to be root
in
20 * 1. From the SML
/NJ REPL
:
21 * CM
.make
"cm2mlb.cm";
23 * 2. ln
-s
<smlnj
>/bin
/.run
-sml
<smlnj
>/bin
/cm2mlb
24 * 3. mv cm2mlb
.x86
-linux
<smlnj
>/bin
/.heap
26 * Once it is installed
, the usage is
as follows
:
27 * cm2mlb
[-Dsym
...] [-bind file
] [-map file
] sources
.cm
29 * -Dsym can be used to define CM preprocessor symbols
.
30 * -bind file can be used to add cm anchor bindings
.
31 * -map file can be used to add cm2mlb mappings
.
36 val cm2mlb
: {defines
: string list
,
39 out
: TextIO.outstream
,
40 sources
: string} -> unit
41 val main
: string * string list
-> OS
.Process
.status
42 val export
: unit
-> unit
45 structure PG
= PortableGraph
47 fun message s
= TextIO.output (TextIO.stdErr
, s ^
"\n")
49 (message ("Error: " ^ msg
)
50 ; OS
.Process
.exit OS
.Process
.failure
)
64 structure AnchorBind
=
67 fun make (file
: string) =
68 if OS
.FileSys
.access (file
, [OS
.FileSys
.A_READ
])
73 val f
= TextIO.openIn file
77 case TextIO.inputLine f
of
78 NONE
=> List.rev lines
79 | SOME l
=> loop (l
::lines
)
82 before TextIO.closeIn f
83 end handle e
=> (TextIO.closeIn f
; raise e
)
88 if CharVector
.all
Char.isSpace line
89 orelse CharVector
.sub (line
, 0) = #
"#"
92 case String.tokens
Char.isSpace line
of
94 SOME
{anchor
= anchor
, value
= value
}
95 | _
=> die (concat
["strange anchor->value mapping: ",
102 structure AnchorMap
=
105 fun make (file
: string) =
106 if OS
.FileSys
.access (file
, [OS
.FileSys
.A_READ
])
111 val f
= TextIO.openIn file
115 case TextIO.inputLine f
of
116 NONE
=> List.rev lines
117 | SOME l
=> loop (l
::lines
)
120 before TextIO.closeIn f
121 end handle e
=> (TextIO.closeIn f
; raise e
)
126 if CharVector
.all
Char.isSpace line
127 orelse CharVector
.sub (line
, 0) = #
"#"
130 case String.tokens
Char.isSpace line
of
131 [cmAnchor
, mlbPath
] =>
132 SOME
{cmAnchor
= cmAnchor
, mlbPath
= mlbPath
}
133 | _
=> die (concat
["strange cm->mlb mapping: ",
139 val default
= make
"cm2mlb-map"
142 fun cm2mlb
{defines
, binds
, maps
, out
, sources
} =
144 (* Define preprocessor symbols
*)
147 (fn sym
=> (#
set (CM
.symval sym
)) (SOME
1))
149 val _
= (#set CM
.Control
.verbose
) false
150 val _
= (#set CM
.Control
.warn_obsolete
) false
151 val _
= Control
.printWarnings
:= false
155 (fn {anchor
, value
} =>
156 #
set (CM
.Anchor
.anchor anchor
) (SOME value
))
157 (List.concat (List.map AnchorBind
.make binds
))
162 ((List.map AnchorMap
.make maps
) @
165 fun peekAnchorMap cmAnchor
' =
166 case List.find (fn {cmAnchor
, ...} => cmAnchor
= cmAnchor
') anchorMap
of
168 | SOME
{mlbPath
, ...} => SOME mlbPath
170 val peekAnchorMap
= peekAnchorMap
174 if OS
.FileSys
.access (sources
, [OS
.FileSys
.A_READ
])
176 else die (concat
["file not found: ", sources
])
177 val {dir
, file
= sources
} = OS
.Path
.splitDirFile sources
178 val () = if dir
<> "" then OS
.FileSys
.chDir dir
else ()
180 case CM
.Graph
.graph sources
of
181 SOME
{graph
as PG
.GRAPH
{imports
, ...}, imports
= importLibs
, nativesrc
} =>
187 val cmLibDescr
= CM
.Library
.descr cmLib
188 val cmLibOSString
= CM
.Library
.osstring cmLib
192 val {base
, ext
} = OS
.Path
.splitBaseExt cmLibOSString
193 val mlbLib
= OS
.Path
.joinBaseExt
{base
= base
, ext
= SOME
"mlb"}
198 fun doitAnchoredPath arcs
=
200 fun loop (prefix
, suffix
) =
202 then concat
["(* ", cmLibDescr
, " =??=> *) ", mlbLibDef ()]
203 else case peekAnchorMap (String.concatWith
"/" (List.rev prefix
)) of
205 concat
["(* ", cmLibDescr
, " ====> *) ", mlbPath ^ suffix
]
210 then OS
.Path
.joinBaseExt
211 {base
= #
base (OS
.Path
.splitBaseExt (List.hd prefix
)),
213 else (List.hd prefix
) ^ suffix
215 loop (List.tl prefix
, "/" ^ suffix
)
218 loop (List.rev arcs
, "")
222 if String.sub (cmLibDescr
, 0) = #
"$"
223 then case String.fields (fn #
"/" => true | _
=> false) cmLibDescr
of
224 "$" :: (arcs
as (arc0
:: _
)) =>
225 doitAnchoredPath (("$" ^ arc0
) :: arcs
)
229 case CharVector
.findi (fn (_
, #
"(") => true | _
=> false) arc0
of
231 String.extract (arc0
, i
+ 2, SOME (String.size arc0
- i
- 3))
234 doitAnchoredPath (arc0
:: arcs
)
236 | arcs
=> doitAnchoredPath arcs
237 else concat
["(* ", cmLibOSString
, " ===> *) ", mlbLibDef ()]
240 [" basis ", bid
, " =\n",
245 (imports
, importLibs
)
247 TextIO.output (out
, "local\n");
248 List.app (fn s
=> TextIO.output (out
, s
)) imports
;
249 TextIO.output (out
, "in\n");
250 GenMLB
.gen
{graph
= graph
,
251 nativesrc
= nativesrc
,
252 importprefix
= fn _
=> "",
255 TextIO.output (out
, "end\n")
257 | NONE
=> die ("CM.Graph.graph " ^ sources ^
" failed")
261 (message
"Usage: cm2mlb [-Dsym ...] [-bind file] [-map file] sources.cm"
266 val defines
= ref
["MLton"]
272 cm2mlb
{defines
= !defines
,
278 if String.isPrefix
"-D" flag
280 (defines
:= String.extract (flag
, 2, NONE
) :: !defines
282 else if "-bind" = flag
284 file
:: args
=> (binds
:= file
:: !binds
286 | _
=> usage
"missing map file"
287 else if "-map" = flag
289 file
:: args
=> (maps
:= file
:: !maps
291 | _
=> usage
"missing map file"
292 else usage (String.concat
["invalid flag ", flag
])
293 | _
=> usage
"wrong number of arguments"
295 loop args
handle e
=> die (concat
["cm2mlb failed: ", General
.exnMessage e
])