Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/ml-nlffigen/main.sml
ViewVC logotype

Annotation of /sml/trunk/src/ml-nlffigen/main.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 840 - (view) (download)

1 : blume 828 (*
2 :     * main.sml - Driver routine ("main") for ml-ffigen.
3 :     *
4 :     * (C) 2001, Lucent Technologies, Bell Labs
5 :     *
6 :     * author: Matthias Blume (blume@research.bell-labs.com)
7 :     *)
8 :     structure Main = struct
9 :     local
10 : blume 840
11 :     fun tgt (n, sz, sh, cc) =
12 :     { name = n, sizes = sz, shift = sh, stdcall = cc }
13 :    
14 :     val default_target =
15 :     tgt (DefaultName.name,
16 :     DefaultSizes.sizes, DefaultEndian.shift, DefaultCC.stdcall)
17 :    
18 :     val target_table =
19 :     [tgt ("sparc-unix",
20 :     SizesSparc.sizes, EndianBig.shift, CC_ccall.stdcall),
21 :     tgt ("x86-unix",
22 :     SizesX86.sizes, EndianLittle.shift, CC_ccall.stdcall),
23 :     tgt ("x86-win32",
24 :     SizesX86.sizes, EndianLittle.shift, CC_stdcall.stdcall)
25 :     (* needs to be extended ... *)
26 :     ]
27 :    
28 :     fun find_target tg =
29 :     case List.find (fn x => tg = #name x) target_table of
30 :     SOME t => t
31 :     | NONE => raise Fail (concat ["unknown target: " ^ tg])
32 :    
33 : blume 828 fun main0 (arg0, args) = let
34 :     fun substitute (tmpl, s, t) = let
35 :     fun loop ([], a) = String.implode (rev a)
36 :     | loop (#"%" :: #"s" :: l, a) = loop (l, push (s, a))
37 :     | loop (#"%" :: #"t" :: l, a) = loop (l, push (t, a))
38 :     | loop (c :: l, a) = loop (l, c :: a)
39 :     and push (x, a) = List.revAppend (String.explode x, a)
40 :     in
41 :     loop (String.explode tmpl, [])
42 :     end
43 :     fun mangle f = let
44 :     fun dot #"." = true
45 :     | dot _ = false
46 :     fun sep #"_" = true
47 :     | sep #"-" = true
48 :     | sep _ = false
49 :     fun finish l = let
50 :     val fields = List.concat (map (String.fields sep) l)
51 :     fun allUp x = String.map Char.toUpper x
52 :     fun firstUp x =
53 :     case String.explode x of
54 :     h :: t => String.implode
55 :     (Char.toUpper h :: map Char.toLower t)
56 :     | [] => ""
57 :     val sigfields = map allUp fields
58 :     val strfields = map firstUp fields
59 :     val sgn =
60 :     case sigfields of
61 :     [] => raise Fail ("file name without significant \
62 :     \characters: " ^ f)
63 :     | h :: t => String.concat (h ::
64 :     foldr (fn (x, l) =>
65 :     "_" :: x :: l)
66 :     [] t)
67 :     val stn = String.concat strfields
68 :     in
69 :     (sgn, stn)
70 :     end
71 :     in
72 :     case rev (String.fields dot f) of
73 :     ("c" | "h") :: (l as (_ :: _)) => finish (rev l)
74 :     | l => finish (rev l)
75 :     end
76 :     fun proc ([hfile],
77 : blume 840 sgf, stf, cmf, sgn, stn, asu, wid, lsp, t) =
78 : blume 828 let val ifile = OS.FileSys.tmpName ()
79 :     val cpp_tmpl = getOpt (OS.Process.getEnv "FFIGEN_CPP",
80 :     "gcc -E -U__GNUC__ %s > %t")
81 :     val cpp = substitute (cpp_tmpl, hfile, ifile)
82 :     val sgf = getOpt (sgf, hfile ^ ".sig")
83 :     val stf = getOpt (stf, hfile ^ ".sml")
84 :     val cmf = getOpt (cmf, hfile ^ ".cm")
85 :     val (g_sgn, g_stn) = mangle hfile
86 :     val sgn = getOpt (sgn, g_sgn)
87 :     val stn = getOpt (stn, g_stn)
88 :     val _ = if OS.Process.system cpp <> OS.Process.success then
89 :     raise Fail ("C-preprocessor failed: " ^ cpp)
90 :     else ()
91 :     in
92 :     Gen.gen { idlfile = hfile,
93 :     idlsource = ifile,
94 :     sigfile = sgf,
95 :     strfile = stf,
96 :     cmfile = cmf,
97 :     signame = sgn,
98 :     strname = stn,
99 :     allSU = asu,
100 :     lambdasplit = lsp,
101 : blume 840 wid = getOpt (wid, 75),
102 :     target = t }
103 : blume 828 handle e => (OS.FileSys.remove ifile handle _ => (); raise e);
104 :     OS.FileSys.remove ifile handle _ => ();
105 :     OS.Process.success
106 :     end
107 : blume 840 | proc ("-sigfile" :: f :: l,
108 :     _, stf, cmf, sgn, stn, asu, wid, lsp, t) =
109 :     proc (l, SOME f, stf, cmf, sgn, stn, asu, wid, lsp, t)
110 :     | proc ("-strfile" :: f :: l,
111 :     sgf, _, cmf, sgn, stn, asu, wid, lsp, t) =
112 :     proc (l, sgf, SOME f, cmf, sgn, stn, asu, wid, lsp, t)
113 :     | proc ("-cmfile" :: f :: l,
114 :     sgf, stf, _, sgn, stn, asu, wid, lsp, t) =
115 :     proc (l, sgf, stf, SOME f, sgn, stn, asu, wid, lsp, t)
116 :     | proc ("-signame" :: n :: l,
117 :     sgf, stf, cmf, _, stn, asu, wid, lsp, t) =
118 :     proc (l, sgf, stf, cmf, SOME n, stn, asu, wid, lsp, t)
119 :     | proc ("-strname" :: n :: l,
120 :     sgf, stf, cmf, sgn, _, asu, wid, lsp, t) =
121 :     proc (l, sgf, stf, cmf, sgn, SOME n, asu, wid, lsp, t)
122 :     | proc ("-allSU" :: l,
123 :     sgf, stf, cmf, sgn, stn, _, wid, lsp, t) =
124 :     proc (l, sgf, stf, cmf, sgn, stn, true, wid, lsp, t)
125 :     | proc ("-width" :: i :: l,
126 :     sgf, stf, cmf, sgn, stn, asu, _, lsp, t) =
127 :     proc (l, sgf, stf, cmf, sgn, stn, asu, Int.fromString i, lsp, t)
128 : blume 828 | proc ("-lambdasplit" :: s :: l,
129 : blume 840 sgf, stf, cmf, sgn, stn, asu, wid, _, t) =
130 :     proc (l, sgf, stf, cmf, sgn, stn, asu, wid, SOME s, t)
131 :     | proc ("-target" :: tg :: l,
132 :     sgf, stf, cmf, sgn, stn, asu, wid, lsp, _) =
133 :     proc (l, sgf, stf, cmf, sgn, stn, asu, wid, lsp, find_target tg)
134 : blume 828 | proc _ =
135 :     raise Fail
136 :     (concat ["usage: ", arg0,
137 : blume 840 " \\\n\t[-sigfile sigfile] [-strfile strfile] [-cmfile cmfile] \
138 :     \ \\\n\t[-signame signame] [-strname strname] [-allSU] \
139 :     \ \\\n\t[-width linewidth] [-lambdasplit spec] [-target arch-os] \
140 :     \ \\\n idlfile"])
141 : blume 828 in
142 : blume 840 proc (args, NONE, NONE, NONE, NONE, NONE, false, NONE, NONE,
143 :     default_target)
144 : blume 828 end
145 :     in
146 :     fun main args = main0 args
147 :     handle exn => (TextIO.output (TextIO.stdErr, General.exnMessage exn);
148 :     TextIO.output (TextIO.stdErr, "\n");
149 :     OS.Process.failure)
150 :     end
151 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0