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 977 - (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 : blume 975
77 :     val sgf = ref NONE
78 :     val stf = ref NONE
79 :     val cmf = ref NONE
80 :     val sgn = ref NONE
81 :     val stn = ref NONE
82 :     val asu = ref false
83 :     val wid = ref NONE
84 :     val lsp = ref NONE
85 :     val target = ref default_target
86 :     val wrq = ref NONE
87 : blume 977 val namedargs = ref false
88 : blume 975
89 :     fun proc [hfile] =
90 : blume 828 let val ifile = OS.FileSys.tmpName ()
91 :     val cpp_tmpl = getOpt (OS.Process.getEnv "FFIGEN_CPP",
92 :     "gcc -E -U__GNUC__ %s > %t")
93 :     val cpp = substitute (cpp_tmpl, hfile, ifile)
94 : blume 846 val hfile_file = OS.Path.file hfile
95 : blume 975 val sgf = getOpt (!sgf, hfile_file ^ ".sig")
96 :     val stf = getOpt (!stf, hfile_file ^ ".sml")
97 :     val cmf = getOpt (!cmf, hfile_file ^ ".cm")
98 : blume 846 val (g_sgn, g_stn) = mangle hfile_file
99 : blume 975 val sgn = getOpt (!sgn, g_sgn)
100 :     val stn = getOpt (!stn, g_stn)
101 : blume 828 val _ = if OS.Process.system cpp <> OS.Process.success then
102 :     raise Fail ("C-preprocessor failed: " ^ cpp)
103 :     else ()
104 :     in
105 :     Gen.gen { idlfile = hfile,
106 :     idlsource = ifile,
107 :     sigfile = sgf,
108 :     strfile = stf,
109 :     cmfile = cmf,
110 :     signame = sgn,
111 :     strname = stn,
112 : blume 975 allSU = !asu,
113 :     lambdasplit = !lsp,
114 :     weightreq = !wrq,
115 :     wid = getOpt (!wid, 75),
116 : blume 977 namedargs = !namedargs,
117 : blume 975 target = !target }
118 : blume 828 handle e => (OS.FileSys.remove ifile handle _ => (); raise e);
119 :     OS.FileSys.remove ifile handle _ => ();
120 :     OS.Process.success
121 :     end
122 : blume 975 | proc ("-sigfile" :: f :: l) = (sgf := SOME f; proc l)
123 :     | proc ("-strfile" :: f :: l) = (stf := SOME f; proc l)
124 :     | proc ("-cmfile" :: f :: l) = (cmf := SOME f; proc l)
125 :     | proc ("-signame" :: n :: l) = (sgn := SOME n; proc l)
126 :     | proc ("-strname" :: n :: l) = (stn := SOME n; proc l)
127 :     | proc ("-allSU" :: l) = (asu := true; proc l)
128 :     | proc ("-width" :: i :: l) = (wid := Int.fromString i; proc l)
129 :     | proc ("-lambdasplit" :: s :: l) = (lsp := SOME s; proc l)
130 :     | proc ("-target" :: tg :: l) = (target := find_target tg; proc l)
131 :     | proc ("-light" :: l) = (wrq := SOME false; proc l)
132 :     | proc ("-heavy" :: l) = (wrq := SOME true; proc l)
133 : blume 977 | proc ("-namedargs" :: l) = (namedargs := true; proc l)
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 975 proc args
143 : blume 828 end
144 :     in
145 :     fun main args = main0 args
146 :     handle exn => (TextIO.output (TextIO.stdErr, General.exnMessage exn);
147 :     TextIO.output (TextIO.stdErr, "\n");
148 :     OS.Process.failure)
149 :     end
150 :     end

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