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 1049 - (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 :     val ems = ref []
53 :     val libh = ref "Library.libh"
54 :     val cmpl = ref true
55 : blume 975 val asu = ref false
56 :     val wid = ref NONE
57 :     val lsp = ref NONE
58 :     val target = ref default_target
59 :     val wrq = ref NONE
60 : blume 977 val namedargs = ref false
61 : blume 1036 val cppopts = ref ""
62 :     val regexp = ref NONE
63 : blume 975
64 : blume 1011 fun finish cfiles = let
65 :     fun mkidlsource cfile = let
66 :     val ifile = OS.FileSys.tmpName ()
67 : blume 828 val cpp_tmpl = getOpt (OS.Process.getEnv "FFIGEN_CPP",
68 : blume 1036 "gcc -E -U__GNUC__ %o %s > %t")
69 :     val cpp = substitute (cpp_tmpl, !cppopts, cfile, ifile)
70 : blume 828 in
71 : blume 1011 if OS.Process.system cpp <> OS.Process.success then
72 :     raise Fail ("C-preprocessor failed: " ^ cpp)
73 :     else ();
74 :     ifile
75 : blume 828 end
76 : blume 1036
77 :     val match =
78 :     case !regexp of
79 :     NONE => (fn _ => false)
80 :     | SOME re =>
81 :     (fn s => let fun creader p =
82 :     if p >= size s then NONE
83 :     else SOME (String.sub (s, p), p + 1)
84 :     in
85 :     isSome (StringCvt.scanString (RE.prefix re) s)
86 :     end)
87 : blume 1011 in
88 :     Gen.gen { cfiles = cfiles,
89 : blume 1036 match = match,
90 : blume 1011 mkidlsource = mkidlsource,
91 :     dirname = !dir,
92 :     cmfile = !cmf,
93 :     prefix = !prefix,
94 :     extramembers = !ems,
95 :     libraryhandle = !libh,
96 :     complete = !cmpl,
97 :     allSU = !asu,
98 :     lambdasplit = !lsp,
99 :     weightreq = !wrq,
100 :     wid = getOpt (!wid, 75),
101 :     namedargs = !namedargs,
102 :     target = !target };
103 :     OS.Process.success
104 :     end
105 :    
106 : blume 1036 fun iscppopt opt =
107 : blume 1049 size opt > 2 andalso
108 : blume 1036 String.sub (opt, 0) = #"-" andalso
109 :     Char.contains "IDU" (String.sub (opt, 1))
110 :    
111 :     fun addcppopt opt =
112 :     cppopts := (case !cppopts of
113 :     "" => opt
114 :     | opts => concat [opts, " ", opt])
115 :    
116 : blume 1011 fun proc ("-allSU" :: l) = (asu := true; proc l)
117 : blume 975 | proc ("-width" :: i :: l) = (wid := Int.fromString i; proc l)
118 :     | proc ("-lambdasplit" :: s :: l) = (lsp := SOME s; proc l)
119 :     | proc ("-target" :: tg :: l) = (target := find_target tg; proc l)
120 :     | proc ("-light" :: l) = (wrq := SOME false; proc l)
121 :     | proc ("-heavy" :: l) = (wrq := SOME true; proc l)
122 : blume 977 | proc ("-namedargs" :: l) = (namedargs := true; proc l)
123 : blume 1011 | proc ("-incomplete" :: l) = (cmpl := false; proc l)
124 :     | proc ("-libhandle" :: lh :: l) = (libh := lh; proc l)
125 :     | proc ("-include" :: es :: l) = (ems := es :: !ems; proc l)
126 :     | proc ("-prefix" :: p :: l) = (prefix := p; proc l)
127 :     | proc ("-dir" :: d :: l) = (dir := d; proc l)
128 :     | proc ("-cmfile" :: f :: l) = (cmf := f; proc l)
129 : blume 1036 | proc ("-cppopt" :: opt :: l) = (addcppopt opt; proc l)
130 :     | proc ("-version" :: _) =
131 :     (TextIO.output (TextIO.stdOut, Gen.version ^ "\n");
132 :     OS.Process.exit OS.Process.success)
133 :     | proc ("-match" :: re :: l) =
134 :     (regexp := SOME (RE.compileString re); proc l)
135 : blume 1011 | proc ("--" :: cfiles) = finish cfiles
136 : blume 1036 | proc (l0 as (opt :: l)) =
137 :     if iscppopt opt then (addcppopt opt; proc l) else finish l0
138 : blume 1011 | proc cfiles = finish cfiles
139 : blume 828 in
140 : blume 975 proc args
141 : blume 828 end
142 :     in
143 :     fun main args = main0 args
144 :     handle exn => (TextIO.output (TextIO.stdErr, General.exnMessage exn);
145 :     TextIO.output (TextIO.stdErr, "\n");
146 :     OS.Process.failure)
147 :     end
148 :     end

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