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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1011, Thu Jan 10 20:22:04 2002 UTC revision 1036, Fri Jan 25 22:05:44 2002 UTC
# Line 8  Line 8 
8  structure Main = struct  structure Main = struct
9    local    local
10    
11        structure RE =
12            RegExpFn (structure P = AwkSyntax
13                      structure E = DfaEngine)
14    
15      fun tgt (n, sz, sh, cc) =      fun tgt (n, sz, sh, cc) =
16          { name  = n, sizes = sz, shift = sh, stdcall = cc }          { name  = n, sizes = sz, shift = sh, stdcall = cc }
17    
# Line 31  Line 35 
35            | NONE => raise Fail (concat ["unknown target: " ^ tg])            | NONE => raise Fail (concat ["unknown target: " ^ tg])
36    
37      fun main0 (arg0, args) = let      fun main0 (arg0, args) = let
38          fun substitute (tmpl, s, t) = let          fun substitute (tmpl, opts, s, t) = let
39              fun loop ([], a) = String.implode (rev a)              fun loop ([], a) = String.implode (rev a)
40                | loop (#"%" :: #"s" :: l, a) = loop (l, push (s, a))                | loop (#"%" :: #"s" :: l, a) = loop (l, push (s, a))
41                | loop (#"%" :: #"t" :: l, a) = loop (l, push (t, a))                | loop (#"%" :: #"t" :: l, a) = loop (l, push (t, a))
42                  | loop (#"%" :: #"o" :: l, a) = loop (l, push (opts, a))
43                | loop (c :: l, a) = loop (l, c :: a)                | loop (c :: l, a) = loop (l, c :: a)
44              and push (x, a) = List.revAppend (String.explode x, a)              and push (x, a) = List.revAppend (String.explode x, a)
45          in          in
# Line 53  Line 58 
58          val target = ref default_target          val target = ref default_target
59          val wrq = ref NONE          val wrq = ref NONE
60          val namedargs = ref false          val namedargs = ref false
61            val cppopts = ref ""
62            val regexp = ref NONE
63    
64          fun finish cfiles = let          fun finish cfiles = let
65              fun mkidlsource cfile = let              fun mkidlsource cfile = let
66                  val ifile = OS.FileSys.tmpName ()                  val ifile = OS.FileSys.tmpName ()
67                  val cpp_tmpl = getOpt (OS.Process.getEnv "FFIGEN_CPP",                  val cpp_tmpl = getOpt (OS.Process.getEnv "FFIGEN_CPP",
68                                         "gcc -E -U__GNUC__ %s > %t")                                         "gcc -E -U__GNUC__ %o %s > %t")
69                  val cpp = substitute (cpp_tmpl, cfile, ifile)                  val cpp = substitute (cpp_tmpl, !cppopts, cfile, ifile)
70              in              in
71                  if OS.Process.system cpp <> OS.Process.success then                  if OS.Process.system cpp <> OS.Process.success then
72                      raise Fail ("C-preprocessor failed: " ^ cpp)                      raise Fail ("C-preprocessor failed: " ^ cpp)
73                  else ();                  else ();
74                  ifile                  ifile
75              end              end
76    
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          in          in
88              Gen.gen { cfiles = cfiles,              Gen.gen { cfiles = cfiles,
89                          match = match,
90                        mkidlsource = mkidlsource,                        mkidlsource = mkidlsource,
91                        dirname = !dir,                        dirname = !dir,
92                        cmfile = !cmf,                        cmfile = !cmf,
# Line 84  Line 103 
103              OS.Process.success              OS.Process.success
104          end          end
105    
106            fun iscppopt opt =
107                size opt < 2 andalso
108                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          fun proc ("-allSU" :: l) = (asu := true; proc l)          fun proc ("-allSU" :: l) = (asu := true; proc l)
117            | proc ("-width" :: i :: l) = (wid := Int.fromString i; proc l)            | proc ("-width" :: i :: l) = (wid := Int.fromString i; proc l)
118            | proc ("-lambdasplit" :: s :: l) = (lsp := SOME s; proc l)            | proc ("-lambdasplit" :: s :: l) = (lsp := SOME s; proc l)
# Line 97  Line 126 
126            | proc ("-prefix" :: p :: l) = (prefix := p; proc l)            | proc ("-prefix" :: p :: l) = (prefix := p; proc l)
127            | proc ("-dir" :: d :: l) = (dir := d; proc l)            | proc ("-dir" :: d :: l) = (dir := d; proc l)
128            | proc ("-cmfile" :: f :: l) = (cmf := f; proc l)            | proc ("-cmfile" :: f :: l) = (cmf := f; proc l)
129              | 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            | proc ("--" :: cfiles) = finish cfiles            | proc ("--" :: cfiles) = finish cfiles
136              | proc (l0 as (opt :: l)) =
137                if iscppopt opt then (addcppopt opt; proc l) else finish l0
138            | proc cfiles = finish cfiles            | proc cfiles = finish cfiles
139      in      in
140          proc args          proc args

Legend:
Removed from v.1011  
changed lines
  Added in v.1036

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