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 846 - (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 : blume 846 val hfile_file = OS.Path.file hfile
83 :     val sgf = getOpt (sgf, hfile_file ^ ".sig")
84 :     val stf = getOpt (stf, hfile_file ^ ".sml")
85 :     val cmf = getOpt (cmf, hfile_file ^ ".cm")
86 :     val (g_sgn, g_stn) = mangle hfile_file
87 : blume 828 val sgn = getOpt (sgn, g_sgn)
88 :     val stn = getOpt (stn, g_stn)
89 :     val _ = if OS.Process.system cpp <> OS.Process.success then
90 :     raise Fail ("C-preprocessor failed: " ^ cpp)
91 :     else ()
92 :     in
93 :     Gen.gen { idlfile = hfile,
94 :     idlsource = ifile,
95 :     sigfile = sgf,
96 :     strfile = stf,
97 :     cmfile = cmf,
98 :     signame = sgn,
99 :     strname = stn,
100 :     allSU = asu,
101 :     lambdasplit = lsp,
102 : blume 840 wid = getOpt (wid, 75),
103 :     target = t }
104 : blume 828 handle e => (OS.FileSys.remove ifile handle _ => (); raise e);
105 :     OS.FileSys.remove ifile handle _ => ();
106 :     OS.Process.success
107 :     end
108 : blume 840 | proc ("-sigfile" :: f :: l,
109 :     _, stf, cmf, sgn, stn, asu, wid, lsp, t) =
110 :     proc (l, SOME f, stf, cmf, sgn, stn, asu, wid, lsp, t)
111 :     | proc ("-strfile" :: f :: l,
112 :     sgf, _, cmf, sgn, stn, asu, wid, lsp, t) =
113 :     proc (l, sgf, SOME f, cmf, sgn, stn, asu, wid, lsp, t)
114 :     | proc ("-cmfile" :: f :: l,
115 :     sgf, stf, _, sgn, stn, asu, wid, lsp, t) =
116 :     proc (l, sgf, stf, SOME f, sgn, stn, asu, wid, lsp, t)
117 :     | proc ("-signame" :: n :: l,
118 :     sgf, stf, cmf, _, stn, asu, wid, lsp, t) =
119 :     proc (l, sgf, stf, cmf, SOME n, stn, asu, wid, lsp, t)
120 :     | proc ("-strname" :: n :: l,
121 :     sgf, stf, cmf, sgn, _, asu, wid, lsp, t) =
122 :     proc (l, sgf, stf, cmf, sgn, SOME n, asu, wid, lsp, t)
123 :     | proc ("-allSU" :: l,
124 :     sgf, stf, cmf, sgn, stn, _, wid, lsp, t) =
125 :     proc (l, sgf, stf, cmf, sgn, stn, true, wid, lsp, t)
126 :     | proc ("-width" :: i :: l,
127 :     sgf, stf, cmf, sgn, stn, asu, _, lsp, t) =
128 :     proc (l, sgf, stf, cmf, sgn, stn, asu, Int.fromString i, lsp, t)
129 : blume 828 | proc ("-lambdasplit" :: s :: l,
130 : blume 840 sgf, stf, cmf, sgn, stn, asu, wid, _, t) =
131 :     proc (l, sgf, stf, cmf, sgn, stn, asu, wid, SOME s, t)
132 :     | proc ("-target" :: tg :: l,
133 :     sgf, stf, cmf, sgn, stn, asu, wid, lsp, _) =
134 :     proc (l, sgf, stf, cmf, sgn, stn, asu, wid, lsp, find_target tg)
135 : blume 828 | proc _ =
136 :     raise Fail
137 :     (concat ["usage: ", arg0,
138 : blume 840 " \\\n\t[-sigfile sigfile] [-strfile strfile] [-cmfile cmfile] \
139 :     \ \\\n\t[-signame signame] [-strname strname] [-allSU] \
140 :     \ \\\n\t[-width linewidth] [-lambdasplit spec] [-target arch-os] \
141 :     \ \\\n idlfile"])
142 : blume 828 in
143 : blume 840 proc (args, NONE, NONE, NONE, NONE, NONE, false, NONE, NONE,
144 :     default_target)
145 : blume 828 end
146 :     in
147 :     fun main args = main0 args
148 :     handle exn => (TextIO.output (TextIO.stdErr, General.exnMessage exn);
149 :     TextIO.output (TextIO.stdErr, "\n");
150 :     OS.Process.failure)
151 :     end
152 :     end

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