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 1060 - (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 : blume 1036 structure RE =
12 :     RegExpFn (structure P = AwkSyntax
13 :     structure E = DfaEngine)
14 :    
15 : blume 840 fun tgt (n, sz, sh, cc) =
16 :     { name = n, sizes = sz, shift = sh, stdcall = cc }
17 :    
18 :     val default_target =
19 :     tgt (DefaultName.name,
20 :     DefaultSizes.sizes, DefaultEndian.shift, DefaultCC.stdcall)
21 :    
22 :     val target_table =
23 :     [tgt ("sparc-unix",
24 :     SizesSparc.sizes, EndianBig.shift, CC_ccall.stdcall),
25 :     tgt ("x86-unix",
26 :     SizesX86.sizes, EndianLittle.shift, CC_ccall.stdcall),
27 :     tgt ("x86-win32",
28 :     SizesX86.sizes, EndianLittle.shift, CC_stdcall.stdcall)
29 :     (* needs to be extended ... *)
30 :     ]
31 :    
32 :     fun find_target tg =
33 :     case List.find (fn x => tg = #name x) target_table of
34 :     SOME t => t
35 :     | NONE => raise Fail (concat ["unknown target: " ^ tg])
36 :    
37 : blume 828 fun main0 (arg0, args) = let
38 : blume 1036 fun substitute (tmpl, opts, s, t) = let
39 : blume 828 fun loop ([], a) = String.implode (rev a)
40 :     | loop (#"%" :: #"s" :: l, a) = loop (l, push (s, a))
41 :     | loop (#"%" :: #"t" :: l, a) = loop (l, push (t, a))
42 : blume 1036 | loop (#"%" :: #"o" :: l, a) = loop (l, push (opts, a))
43 : blume 828 | loop (c :: l, a) = loop (l, c :: a)
44 :     and push (x, a) = List.revAppend (String.explode x, a)
45 :     in
46 :     loop (String.explode tmpl, [])
47 :     end
48 : blume 975
49 : blume 1011 val dir = ref "NLFFI-Generated"
50 :     val cmf = ref "nlffi-generated.cm"
51 :     val prefix = ref ""
52 : blume 1060 val gstem = ref ""
53 : blume 1011 val ems = ref []
54 :     val libh = ref "Library.libh"
55 :     val cmpl = ref true
56 : blume 975 val asu = ref false
57 :     val wid = ref NONE
58 :     val lsp = ref NONE
59 :     val target = ref default_target
60 :     val wrq = ref NONE
61 : blume 977 val namedargs = ref false
62 : blume 1036 val cppopts = ref ""
63 :     val regexp = ref NONE
64 : blume 975
65 : blume 1011 fun finish cfiles = let
66 :     fun mkidlsource cfile = let
67 :     val ifile = OS.FileSys.tmpName ()
68 : blume 828 val cpp_tmpl = getOpt (OS.Process.getEnv "FFIGEN_CPP",
69 : blume 1036 "gcc -E -U__GNUC__ %o %s > %t")
70 :     val cpp = substitute (cpp_tmpl, !cppopts, cfile, ifile)
71 : blume 828 in
72 : blume 1011 if OS.Process.system cpp <> OS.Process.success then
73 :     raise Fail ("C-preprocessor failed: " ^ cpp)
74 :     else ();
75 :     ifile
76 : blume 828 end
77 : blume 1036
78 :     val match =
79 :     case !regexp of
80 :     NONE => (fn _ => false)
81 :     | SOME re =>
82 :     (fn s => let fun creader p =
83 :     if p >= size s then NONE
84 :     else SOME (String.sub (s, p), p + 1)
85 :     in
86 :     isSome (StringCvt.scanString (RE.prefix re) s)
87 :     end)
88 : blume 1011 in
89 :     Gen.gen { cfiles = cfiles,
90 : blume 1036 match = match,
91 : blume 1011 mkidlsource = mkidlsource,
92 :     dirname = !dir,
93 :     cmfile = !cmf,
94 :     prefix = !prefix,
95 : blume 1060 gensym_stem = !gstem,
96 : blume 1011 extramembers = !ems,
97 :     libraryhandle = !libh,
98 :     complete = !cmpl,
99 :     allSU = !asu,
100 :     lambdasplit = !lsp,
101 :     weightreq = !wrq,
102 :     wid = getOpt (!wid, 75),
103 :     namedargs = !namedargs,
104 :     target = !target };
105 :     OS.Process.success
106 :     end
107 :    
108 : blume 1036 fun iscppopt opt =
109 : blume 1049 size opt > 2 andalso
110 : blume 1036 String.sub (opt, 0) = #"-" andalso
111 :     Char.contains "IDU" (String.sub (opt, 1))
112 :    
113 :     fun addcppopt opt =
114 :     cppopts := (case !cppopts of
115 :     "" => opt
116 :     | opts => concat [opts, " ", opt])
117 :    
118 : blume 1011 fun proc ("-allSU" :: l) = (asu := true; proc l)
119 : blume 975 | proc ("-width" :: i :: l) = (wid := Int.fromString i; proc l)
120 :     | proc ("-lambdasplit" :: s :: l) = (lsp := SOME s; proc l)
121 :     | proc ("-target" :: tg :: l) = (target := find_target tg; proc l)
122 :     | proc ("-light" :: l) = (wrq := SOME false; proc l)
123 :     | proc ("-heavy" :: l) = (wrq := SOME true; proc l)
124 : blume 977 | proc ("-namedargs" :: l) = (namedargs := true; proc l)
125 : blume 1011 | proc ("-incomplete" :: l) = (cmpl := false; proc l)
126 :     | proc ("-libhandle" :: lh :: l) = (libh := lh; proc l)
127 :     | proc ("-include" :: es :: l) = (ems := es :: !ems; proc l)
128 :     | proc ("-prefix" :: p :: l) = (prefix := p; proc l)
129 : blume 1060 | proc ("-gensym" :: g :: l) = (gstem := g; proc l)
130 : blume 1011 | proc ("-dir" :: d :: l) = (dir := d; proc l)
131 :     | proc ("-cmfile" :: f :: l) = (cmf := f; proc l)
132 : blume 1036 | proc ("-cppopt" :: opt :: l) = (addcppopt opt; proc l)
133 :     | proc ("-version" :: _) =
134 :     (TextIO.output (TextIO.stdOut, Gen.version ^ "\n");
135 :     OS.Process.exit OS.Process.success)
136 :     | proc ("-match" :: re :: l) =
137 :     (regexp := SOME (RE.compileString re); proc l)
138 : blume 1011 | proc ("--" :: cfiles) = finish cfiles
139 : blume 1036 | proc (l0 as (opt :: l)) =
140 :     if iscppopt opt then (addcppopt opt; proc l) else finish l0
141 : blume 1011 | proc cfiles = finish cfiles
142 : blume 828 in
143 : blume 975 proc args
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