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/gen.sml
ViewVC logotype

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

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

revision 1010, Wed Jan 9 21:27:48 2002 UTC revision 1011, Thu Jan 10 20:22:04 2002 UTC
# Line 1  Line 1 
1  (*  (*
2   * gen.sml - Generating and pretty-printing ML code implementing a   * gen-new.sml - Generating and pretty-printing ML code implementing a
3   *           typed interface to a C program.   *           typed interface to a C program.
4   *   *
5   *  (C) 2001, Lucent Technologies, Bell Labs   *  (C) 2001, Lucent Technologies, Bell Labs
# Line 8  Line 8 
8   *)   *)
9  local  local
10      val program = "ml-ffigen"      val program = "ml-ffigen"
11      val version = "0.4"      val version = "0.6"
12      val author = "Matthias Blume"      val author = "Matthias Blume"
13      val email = "blume@research.bell-labs.com"      val email = "blume@research.bell-labs.com"
14      structure S = Spec      structure S = Spec
15  in  in
16    
17  structure Gen :> sig  structure Gen :> sig
18      val gen : { idlfile: string,      val gen : { cfiles: string list,
19                  idlsource: string,                  mkidlsource: string -> string,
20                  sigfile: string,                  dirname: string,
                 strfile: string,  
21                  cmfile:  string,                  cmfile:  string,
22                  signame: string,                  prefix: string,
23                  strname: string,                  extramembers: string list,
24                    libraryhandle: string,
25                    complete: bool,
26    
27                  allSU: bool,                  allSU: bool,
28                  lambdasplit: string option,                  lambdasplit: string option,
29                  wid: int,                  wid: int,
# Line 45  Line 47 
47      val Un = P.Un      val Un = P.Un
48      val Unit = P.Unit      val Unit = P.Unit
49      val ETuple = P.ETUPLE      val ETuple = P.ETUPLE
50        val EUnit = ETuple []
51      fun ERecord [] = P.ETUPLE []      fun ERecord [] = P.ETUPLE []
52        | ERecord l = P.ERECORD l        | ERecord l = P.ERECORD l
53      val EVar = P.EVAR      val EVar = P.EVAR
# Line 62  Line 65 
65    
66      val dontedit = "(* This file has been generated automatically. \      val dontedit = "(* This file has been generated automatically. \
67                     \DO NOT EDIT! *)"                     \DO NOT EDIT! *)"
68      fun mkCredits (src, archos) =  
69          concat ["(* [from ", src, " by ", author, "'s ",      fun mkCredits archos =
70            concat ["(* [by ", author, "'s ",
71                  program, " (version ", version, ") for ",                  program, " (version ", version, ") for ",
72                  archos, "] *)"]                  archos, "] *)"]
73      val commentsto = concat ["(* Send comments and suggestions to ",      val commentsto = concat ["(* Send comments and suggestions to ",
74                               email, ". Thanks! *)"]                               email, ". Thanks! *)"]
75    
76      fun arg_id s = "a_" ^ s  
77      fun su_id (K, tag) = concat [K, "_", tag]      fun fptr_rtti_struct_id i = "FPtrRTTI_" ^ Int.toString i
78      fun isu_id (K, tag) = "I_" ^ su_id (K, tag)      fun fptr_rtti_qid i = fptr_rtti_struct_id i ^ ".typ"
79      fun Styp t = su_id ("S", t) ^ ".typ"      fun fptr_mkcall_qid i = fptr_rtti_struct_id i ^ ".mkcall"
80      fun Utyp t = su_id ("U", t) ^ ".typ"  
81      fun fptr_rtti_id n = "fptr_rtti_" ^ n      fun SUTstruct K t = concat [K, "T_", t]
82        val STstruct = SUTstruct "S"
83        val UTstruct = SUTstruct "U"
84        fun Styp t = STstruct t ^ ".typ"
85        fun Utyp t = UTstruct t ^ ".typ"
86    
87        fun isu_id (K, tag) = concat ["I", K, "_", tag]
88      fun fieldtype_id n = "t_f_" ^ n      fun fieldtype_id n = "t_f_" ^ n
89      fun fieldrtti_id n = "typ_f_" ^ n      fun fieldrtti_id n = "typ_f_" ^ n
90      fun field_id (n, p) = concat ["f_", n, p]      fun field_id (n, p) = concat ["f_", n, p]
91      fun typetype_id n = "typ_t_" ^ n  
92      fun gvar_id n = "g_" ^ n      fun arg_id s = "a_" ^ s
     fun funrtti_id n = "typ_fn_" ^ n  
     fun fptr_id n = "fptr_fn_" ^ n  
     fun fun_id (n, p) = concat ["fn_", n, p]  
93      fun enum_id n = "e_" ^ n      fun enum_id n = "e_" ^ n
     fun let_id c = "t_" ^ String.str c  
94    
95      fun gen args = let      fun gen args = let
96            val { cfiles, mkidlsource,
97          val { idlfile, idlsource,                dirname, cmfile, prefix, extramembers, libraryhandle, complete,
               sigfile, strfile, cmfile,  
               signame, strname,  
98                allSU, lambdasplit,                allSU, lambdasplit,
99                wid,                wid,
100                weightreq,                weightreq,
101                namedargs = doargnames,                namedargs = doargnames,
102                target = { name = archos, sizes, shift, stdcall } } = args                target = { name = archos, sizes, shift, stdcall } } = args
103    
104            fun SUstruct K t = concat [prefix, K, "_", t]
105            val Sstruct = SUstruct "S"
106            val Ustruct = SUstruct "U"
107            fun Tstruct n = concat [prefix, "T_", n]
108            fun Gstruct n = concat [prefix, "G_", n]
109            fun Fstruct n = concat [prefix, "F_", n]
110            fun Estruct n = concat [prefix, "E_", n]
111    
112          val (doheavy, dolight) =          val (doheavy, dolight) =
113              case weightreq of              case weightreq of
114                  NONE => (true, true)                  NONE => (true, true)
115                | SOME true => (true, false)                | SOME true => (true, false)
116                | SOME false => (false, true)                | SOME false => (false, true)
117    
118          val credits = mkCredits (idlfile, archos)          val credits = mkCredits archos
119    
120          val astbundle = ParseToAst.fileToAst'          fun getSpec (cfile, s) = let
121                val idlsource = mkidlsource cfile
122            in
123                (let val astbundle = ParseToAst.fileToAst'
124                              TextIO.stdErr                              TextIO.stdErr
125                              (sizes, State.INITIAL)                              (sizes, State.INITIAL)
126                              idlsource                              idlsource
127                     val s' =
128                         AstToSpec.build (astbundle, sizes, cfiles, allSU, shift)
129                 in
130                     S.join (s', s)
131                 end handle e => (OS.FileSys.remove idlsource handle _ => ();
132                                  raise e))
133                before (OS.FileSys.remove idlsource handle _ => ())
134            end
135    
136          val spec = AstToSpec.build (astbundle, sizes, idlfile, allSU, shift)          val spec = foldl getSpec S.empty cfiles
137    
138          val { structs, unions, gvars, gfuns, gtys, enums } = spec          val { structs, unions, gvars, gfuns, gtys, enums } = spec
139    
140          fun openPP f =          val do_dir = let
141              PP.openStream (SimpleTextIODev.openDev { dst = TextIO.openOut f,              val done = ref false
142                                                       wid = wid })              fun doit () =
143                    if !done then ()
144                    else (done := true;
145                          if OS.FileSys.isDir dirname handle _ => false then ()
146                          else OS.FileSys.mkDir dirname)
147            in
148                doit
149            end
150    
151            val files = ref extramembers    (* all files that should go
152                                             * into the .cm description *)
153            val exports = ref []
154    
155            fun smlfile x = let
156                val file = OS.Path.joinBaseExt { base = x, ext = SOME "sml" }
157                val result = OS.Path.joinDirFile { dir = dirname, file = file }
158            in
159                files := file :: !files;
160                do_dir ();
161                result
162            end
163    
164            fun descrfile file = let
165                val result = OS.Path.joinDirFile { dir = dirname, file = file }
166            in
167                do_dir ();
168                result
169            end
170    
171          exception Incomplete          exception Incomplete
172    
# Line 174  Line 224 
224              fun fs (S.OFIELD { spec = (_, t), ... }, a) = ty (t, a)              fun fs (S.OFIELD { spec = (_, t), ... }, a) = ty (t, a)
225                | fs (_, a) = a                | fs (_, a) = a
226              fun f ({ name, spec }, a) = fs (spec, a)              fun f ({ name, spec }, a) = fs (spec, a)
227              fun s ({ tag, size, anon, fields }, a) = foldl f a fields              fun s ({ src, tag, size, anon, fields }, a) = foldl f a fields
228              fun u ({ tag, size, anon, largest, all }, a) =              fun u ({ src, tag, size, anon, largest, all }, a) =
229                  foldl f a (largest :: all)                  foldl f a (largest :: all)
230              fun gty ({ name, spec }, a) = ty (spec, a)              fun gty ({ src, name, spec }, a) = ty (spec, a)
231              fun gvar ({ name, spec = (_, t) }, a) = ty (t, a)              fun gvar ({ src, name, spec = (_, t) }, a) = ty (t, a)
232              fun gfun ({ name, spec, argnames }, a) = ty (S.FPTR spec, a)              fun gfun ({ src, name, spec, argnames }, a) = ty (S.FPTR spec, a)
233          in          in
234              foldl gfun (foldl gvar              foldl gfun (foldl gvar
235                           (foldl gty (foldl u (foldl s ([], [], []) structs)                           (foldl gty (foldl u (foldl s ([], [], []) structs)
# Line 201  Line 251 
251                | _ => NONE                | _ => NONE
252          end          end
253    
         val cgtys = List.filter (not o isSome o incomplete o #spec) gtys  
   
254          fun rwro S.RW = Type "rw"          fun rwro S.RW = Type "rw"
255            | rwro S.RO = Type "ro"            | rwro S.RO = Type "ro"
256    
# Line 212  Line 260 
260    
261          fun Suobj'rw p sut = Con ("su_obj" ^ p, [sut, Type "rw"])          fun Suobj'rw p sut = Con ("su_obj" ^ p, [sut, Type "rw"])
262          fun Suobj'ro sut = Con ("su_obj'", [sut, Type "ro"])          fun Suobj'ro sut = Con ("su_obj'", [sut, Type "ro"])
         fun Suobj''c sut = Con ("su_obj'", [sut, Type "'c"])  
263    
264          fun wtn_fptr_p p { args, res } = let          fun wtn_fptr_p p { args, res } = let
265              fun topty (S.STRUCT t) = Suobj'ro (St t)              fun topty (S.STRUCT t) = Suobj'ro (St t)
# Line 323  Line 370 
370                | rtti_val (S.UNION t) = EVar (Utyp t)                | rtti_val (S.UNION t) = EVar (Utyp t)
371                | rtti_val (S.FPTR cft) =                | rtti_val (S.FPTR cft) =
372                  (case List.find (fn x => #1 x = cft) fptr_types of                  (case List.find (fn x => #1 x = cft) fptr_types of
373                       SOME (_, i) => EVar (fptr_rtti_id (Int.toString i))                       SOME (_, i) => EVar (fptr_rtti_qid i)
374                     | NONE => raise Fail "fptr type missing")                     | NONE => raise Fail "fptr type missing")
375                | rtti_val (S.PTR (S.RW, t)) =                | rtti_val (S.PTR (S.RW, t)) =
376                  (case incomplete t of                  (case incomplete t of
# Line 338  Line 385 
385                  EApp (EVar "T.arr", ETuple [rtti_val t, dim_val d])                  EApp (EVar "T.arr", ETuple [rtti_val t, dim_val d])
386          end          end
387    
388          fun do_sig_file () = let          fun fptr_mkcall spec =
389                case List.find (fn x => #1 x = spec) fptr_types of
390              val sigpp = openPP sigfile                  SOME (_, i) => fptr_mkcall_qid i
391                  | NONE => raise Fail "missing fptr_type (mkcall)"
392              fun nl () = PP.newline sigpp  
393              fun str s = PP.string sigpp s          fun openPP (f, src) = let
394              fun sp () = PP.space sigpp 1              val dst = TextIO.openOut f
395              fun nsp () = PP.nbSpace sigpp 1              val stream = PP.openStream (SimpleTextIODev.openDev
396              fun Box a = PP.openBox sigpp (PP.Abs a)                                              { dst = dst, wid = wid })
397              fun HBox () = PP.openHBox sigpp              fun nl () = PP.newline stream
398              fun HOVBox a = PP.openHOVBox sigpp (PP.Abs a)              fun str s = PP.string stream s
399              fun VBox a = PP.openVBox sigpp (PP.Abs a)              fun sp () = PP.space stream 1
400              fun endBox () = PP.closeBox sigpp              fun nsp () = PP.nbSpace stream 1
401              fun ppty t = P.ppType sigpp t              fun Box a = PP.openBox stream (PP.Abs a)
402                fun HBox () = PP.openHBox stream
403              fun pr_su_tag t =              fun HVBox x = PP.openHVBox stream x
404                  (nl (); HBox (); str "type"; sp (); ppty t; endBox ())              fun HOVBox a = PP.openHOVBox stream (PP.Abs a)
405                fun VBox a = PP.openVBox stream (PP.Abs a)
406              fun pr_struct_tag { tag, size, anon, fields } =              fun endBox () = PP.closeBox stream
407                  pr_su_tag (St tag)              fun ppty t = P.ppType stream t
408                fun ppExp e = P.ppExp stream e
409              fun pr_union_tag { tag, size, anon, largest, all } =              fun ppFun x = P.ppFun stream x
410                  pr_su_tag (Un tag)              fun line s = (nl (); str s)
411                fun pr_vdef (v, e) =
412                    (nl (); HOVBox 4; str "val"; nsp (); str v; nsp (); str "=";
413                     sp (); ppExp e; endBox ())
414                fun pr_fdef (f, args, res) = (nl (); ppFun (f, args, res))
415    
416              fun pr_decl (keyword, connector) (v, t) =              fun pr_decl (keyword, connector) (v, t) =
417                  (nl (); HOVBox 4; str keyword; nsp (); str v; nsp ();                  (nl (); HOVBox 4; str keyword; nsp (); str v; nsp ();
418                   str connector; sp (); ppty t; endBox ())                   str connector; sp (); ppty t; endBox ())
   
419              val pr_tdef = pr_decl ("type", "=")              val pr_tdef = pr_decl ("type", "=")
420              val pr_vdecl = pr_decl ("val", ":")              val pr_vdecl = pr_decl ("val", ":")
421                fun closePP () = (PP.closeStream stream; TextIO.closeOut dst)
             fun pr_su_structure (StUn, K, su, tag, fields) = let  
   
                 fun pr_field_typ { name, spec = S.OFIELD { spec = (c, t),  
                                                            synthetic = false,  
                                                            offset } } =  
                     pr_tdef (fieldtype_id name, wtn_ty t)  
                   | pr_field_typ _ = ()  
   
                 fun pr_field_rtti { name, spec = S.OFIELD { spec = (c, t),  
                                                             synthetic = false,  
                                                             offset } } =  
                     pr_vdecl (fieldrtti_id name, rtti_ty t)  
                   | pr_field_rtti _ = ()  
   
                 fun pr_field_acc0 (name, p, t) =  
                     pr_vdecl (field_id (name, p),  
                               Arrow (Con ("su_obj" ^ p, [StUn tag, Type "'c"]),  
                                      t))  
   
                 fun pr_bf_acc (name, p, sg, c) =  
                     pr_field_acc0 (name, p, Con (sg ^ "bf", [cro c]))  
   
                 fun pr_field_acc p { name, spec = S.OFIELD { spec = (c, t),  
                                                              synthetic = false,  
                                                              offset } } =  
                     pr_field_acc0 (name, p, obj_ty p (t, cro c))  
                   | pr_field_acc p { name, spec = S.OFIELD _ } = ()  
                   | pr_field_acc p { name, spec = S.SBF bf } =  
                     pr_bf_acc (name, p, "s", #constness bf)  
                   | pr_field_acc p { name, spec = S.UBF bf } =  
                     pr_bf_acc (name, p, "u", #constness bf)  
422              in              in
423                str dontedit;
424                case src of
425                    NONE => ()
426                  | SOME s =>
427                    (nl (); str (concat ["(* [from code at ", s, "] *)"]));
428                line credits;
429                line commentsto;
430                  nl ();                  nl ();
431                  nl (); str (concat ["structure ", su_id (K, tag),              { stream = stream,
432                                      " : sig (* ", su, " ", tag, " *)"]);                nl = nl, str = str, sp = sp, nsp = nsp, Box = Box, HVBox = HVBox,
433                  HBox = HBox, HOVBox = HOVBox, VBox = VBox, endBox = endBox,
434                  ppty = ppty, ppExp = ppExp, ppFun = ppFun, line = line,
435                  pr_vdef = pr_vdef, pr_fdef = pr_fdef, pr_tdef = pr_tdef,
436                  pr_vdecl = pr_vdecl,
437                  closePP = closePP
438                  }
439            end
440    
441            val get_callop = let
442                val ncallops = ref 0
443                val callops = ref []
444                fun callop_sid i = "Callop_" ^ Int.toString i
445                fun callop_qid i = callop_sid i ^ ".callop"
446                fun get (ml_args_t, e_proto, ml_res_t) =
447                    case List.find (fn (ep, _) => ep = e_proto) (!callops) of
448                        SOME (_, i) => callop_qid i
449                      | NONE => let
450                            val i = !ncallops
451                            val sn = callop_sid i
452                            val file = smlfile ("callop-" ^ Int.toString i)
453                            val { pr_vdef, closePP, str, nl, Box, endBox, ... } =
454                                openPP (file, NONE)
455                        in
456                            ncallops := i + 1;
457                            callops := (e_proto, i) :: !callops;
458                            str (concat ["structure ", sn, " = struct"]);
459                  Box 4;                  Box 4;
460                  pr_tdef ("tag", StUn tag);                          pr_vdef ("callop",
461                  nl ();                                   EConstr (EVar "RawMemInlineT.rawccall",
462                  nl (); str (concat ["(* size for this ", su, " *)"]);                                            Arrow (Tuple [Type "Word32.word",
463                  pr_vdecl ("size", Con ("S.size", [Con ("su", [StUn tag])]));                                                          ml_args_t,
464                  nl ();                                                          e_proto],
465                  nl (); str (concat ["(* RTTI for this ", su, " *)"]);                                                   ml_res_t)));
                 pr_vdecl ("typ", Con ("T.typ", [Con ("su", [StUn tag])]));  
                 nl ();  
                 nl (); str "(* witness types for fields *)";  
                 app pr_field_typ fields;  
                 nl ();  
                 nl (); str "(* RTTI for fields *)";  
                 app pr_field_rtti fields;  
                 if doheavy then  
                     (nl ();  
                      nl (); str "(* field accessors *)";  
                      app (pr_field_acc "") fields)  
                 else ();  
                 if dolight then  
                     (nl ();  
                      nl (); str "(* field accessors (lightweight variety) *)";  
                      app (pr_field_acc "'") fields)  
                 else ();  
466                  endBox ();                  endBox ();
467                  nl (); str (concat ["end (* structure ",                          nl (); str "end"; nl (); closePP ();
468                                      su_id (K, tag), " *)"])                          callop_qid i
469              end              end
   
             fun pr_struct_structure { tag, size, anon, fields } =  
                 pr_su_structure (St, "S", "struct", tag, fields)  
             fun pr_union_structure { tag, size, anon, largest, all } =  
                 pr_su_structure (Un, "U", "union", tag, all)  
   
             fun pr_gty_rtti { name, spec } =  
                 pr_vdecl (typetype_id name, rtti_ty spec)  
   
             fun pr_gvar_obj { name, spec = (c, t) } =  
                 pr_vdecl (gvar_id name, Arrow (Unit, obj_ty "" (t, rwro c)))  
   
             fun pr_gfun_rtti { name, spec, argnames } =  
                 pr_vdecl (funrtti_id name, rtti_ty (S.FPTR spec))  
   
             fun pr_gfun_fptr { name, spec, argnames } =  
                 pr_vdecl (fptr_id name,  
                           Arrow (Unit, wtn_ty (S.FPTR spec)))  
   
             fun pr_gfun_func p { name, spec, argnames } =  
                 pr_vdecl (fun_id (name, p),  
                           topfunc_ty p (spec, argnames))  
   
             fun pr_isu (K, tag) =  
                 (nl ();  
                  str (concat ["structure ", isu_id (K, tag),  
                               " : POINTER_TO_INCOMPLETE_TYPE"]))  
             fun pr_istruct tag = pr_isu ("S", tag)  
             fun pr_iunion tag = pr_isu ("U", tag)  
   
             fun pr_enum_const { name, spec } = pr_vdecl (enum_id name, sint_ty)  
470          in          in
471              (* Generating the signature file... *)              get
             str dontedit;  
             nl (); str credits;  
             nl (); str commentsto;  
             nl (); str "local open C.Dim C in";  
             nl (); str (concat ["signature ", signame, " = sig"]);  
             VBox 4;  
             app pr_istruct incomplete_structs;  
             app pr_iunion incomplete_unions;  
             app pr_struct_tag structs;  
             app pr_union_tag unions;  
             app pr_struct_structure structs;  
             app pr_union_structure unions;  
             if not (List.null cgtys) then  
                 (nl (); nl (); str "(* RTTI for typedefs *)";  
                  app pr_gty_rtti cgtys)  
             else ();  
             if not (List.null gvars) then  
                 (nl (); nl (); str "(* object handles for global variables *)";  
                  app pr_gvar_obj gvars)  
             else ();  
             if not (List.null gfuns) then  
                 (nl (); nl (); str "(* RTTI for global function(-pointer)s *)";  
                  app pr_gfun_rtti gfuns;  
                  nl (); nl (); str "(* global function pointers *)";  
                  app pr_gfun_fptr gfuns;  
                  nl (); nl (); str "(* global functions *)";  
                  if dolight then app (pr_gfun_func "'") gfuns else ();  
                  if doheavy then app (pr_gfun_func "") gfuns else ())  
             else ();  
             if not (List.null enums) then  
                 (nl (); nl (); str "(* enum constants *)";  
                  app pr_enum_const enums)  
             else ();  
             endBox ();  
             nl (); str (concat ["end (* signature ", signame, " *)"]);  
             nl (); str "end (* local *)";  
             nl ();  
   
             PP.closeStream sigpp  
472          end          end
473    
474          fun do_fct_file () = let          fun pr_fptr_rtti ({ args, res }, i) = let
             val strpp = openPP strfile  
   
             fun nl () = PP.newline strpp  
             fun str s = PP.string strpp s  
             fun sp () = PP.space strpp 1  
             fun nsp () = PP.nbSpace strpp 1  
             fun Box a = PP.openBox strpp (PP.Abs a)  
             fun HBox () = PP.openHBox strpp  
             fun HOVBox a = PP.openHOVBox strpp (PP.Abs a)  
             fun VBox a = PP.openVBox strpp (PP.Abs a)  
             fun endBox () = PP.closeBox strpp  
             fun ppty t = P.ppType strpp t  
             fun ppExp e = P.ppExp strpp e  
             fun ppFun x = P.ppFun strpp x  
   
             fun pr_fdef (f, args, res) = (nl (); ppFun (f, args, res))  
   
             fun pr_def_t (sep, keyword, connector) (v, t) =  
                 (sep ();  
                  HOVBox 4; str keyword; nsp (); str v; nsp (); str connector;  
                  sp (); ppty t; endBox ())  
   
             val pr_vdecl = pr_def_t (fn () => (), "val", ":")  
   
             val pr_tdef = pr_def_t (nl, "type", "=")  
   
             fun pr_vdef (v, e) =  
                 (nl ();  
                  HOVBox 4; str "val"; nsp (); str v; nsp (); str "=";  
                  sp (); ppExp e; endBox ())  
   
             fun pr_su_tag (su, tag, false) =  
                 let fun build [] = Type su  
                       | build (h :: tl) = Con (let_id h, [build tl])  
                 in  
                     pr_tdef (su_id (su, tag), build (rev (String.explode tag)))  
                 end  
               | pr_su_tag (su, tag, true) =  
                 (nl (); str "local";  
                  VBox 4;  
                  nl (); str  
                     "structure X :> sig type t end = struct type t = unit end";  
                  endBox ();  
                  nl (); str "in";  
                  VBox 4;  
                  pr_tdef (su_id (su, tag), Type "X.t");  
                  endBox ();  
                  nl (); str "end")  
   
             fun pr_struct_tag { tag, size, anon, fields } =  
                 pr_su_tag ("s", tag, anon)  
             fun pr_union_tag { tag, size, anon, largest, all } =  
                 pr_su_tag ("u", tag, anon)  
   
             fun pr_su_tag_copy (k, tag) = let  
                 val tn = su_id (k, tag)  
             in  
                 pr_tdef (tn, Type tn)  
             end  
475    
476              fun pr_struct_tag_copy { tag, size, anon, fields } =              val structname = fptr_rtti_struct_id i
477                  pr_su_tag_copy ("s", tag)              val file = smlfile ("fptr-rtti-" ^ Int.toString i)
             fun pr_union_tag_copy { tag, size, anon, largest, all } =  
                 pr_su_tag_copy ("u", tag)  
478    
479              fun pr_fptr_rtti ({ args, res }, i) = let              val { closePP, str, Box, endBox, pr_fdef, pr_vdef, nl, ... } =
480                    openPP (file, NONE)
481    
482                  (* cproto encoding *)                  (* cproto encoding *)
483                  fun List t = Con ("list", [t])                  fun List t = Con ("list", [t])
# Line 745  Line 650 
650                                     args))                                     args))
651    
652                  val arg_e = ETuple (extra_arg_e @ args_el)                  val arg_e = ETuple (extra_arg_e @ args_el)
653                val callop_n = get_callop (ml_args_t, e_proto, ml_res_t)
654              in              in
655                  nl ();              str "local open C_Int in";
656                  str (concat ["val ", fptr_rtti_id (Int.toString i), " = let"]);              nl (); str (concat ["structure ", structname, " = struct"]);
657                  VBox 4;              Box 4;
                 pr_vdef ("callop",  
                           EConstr (EVar "RawMemInlineT.rawccall",  
                                    Arrow (Tuple [Type "Word32.word",  
                                                  ml_args_t,  
                                                  e_proto],  
                                           ml_res_t)));  
658                  pr_fdef ("mkcall",                  pr_fdef ("mkcall",
659                           [EVar "a", ETuple (extra_arg_v @ arg_vl)],                           [EVar "a", ETuple (extra_arg_v @ arg_vl)],
660                           res_wrap (EApp (EVar "callop",                       res_wrap (EApp (EVar callop_n,
661                                           ETuple [EVar "a", arg_e,                                           ETuple [EVar "a", arg_e,
662                                                   EVar "nil"])));                                                   EVar "nil"])));
663                  endBox ();              pr_vdef ("typ",
664                  nl (); str "in";                       EConstr (EApp (EVar "mk_fptr_typ",
                 VBox 4;  
                 nl (); ppExp (EConstr (EApp (EVar "mk_fptr_typ",  
665                                               EVar "mkcall"),                                               EVar "mkcall"),
666                                         rtti_ty (S.FPTR { args = args,                                         rtti_ty (S.FPTR { args = args,
667                                                          res = res })));                                                          res = res })));
668                  endBox ();                  endBox ();
669                  nl (); str "end"              nl (); str "end"; nl (); str "end"; nl (); closePP ()
670            end
671    
672            fun pr_sut_structure (src, tag, anon, size, k, K) = let
673                val file = smlfile (concat [k, "t-", tag])
674                val { str, closePP, nl, Box, endBox, VBox, pr_tdef,
675                      pr_vdef, ... } =
676                    openPP (file, SOME src)
677                fun build [] = Type k
678                  | build (h :: tl) = Con ("t_" ^ String.str h, [build tl])
679                val (utildef, tag_t) =
680                    if anon then
681                        ("structure X :> sig type t end \
682                         \= struct type t = unit end",
683                         Type "X.t")
684                    else
685                        ("open Tag",
686                         build (rev (String.explode tag)))
687    
688            in
689                str "local";
690                Box 4;
691                nl (); str (concat ["structure ", SUstruct K tag, " = struct"]);
692                Box 4;
693                nl (); str "local";
694                VBox 4;
695                nl (); str utildef;
696                endBox ();
697                nl (); str "in";
698                VBox 4;
699                pr_tdef ("tag", tag_t);
700                endBox ();
701                nl (); str "end";
702                pr_vdef ("size",
703                         EConstr (EApp (EVar "C_Int.mk_su_size", EWord size),
704                                  Con ("C.S.size",
705                                       [Con ("C.su", [Type "tag"])])));
706                pr_vdef ("typ",
707                         EApp (EVar "C_Int.mk_su_typ", EVar "size"));
708                endBox ();
709                nl (); str "end";
710                endBox ();
711                nl (); str "in";
712                Box 4;
713                nl (); str (concat ["structure ", SUTstruct K tag,
714                                    " = ", SUstruct K tag]);
715                endBox ();
716                nl (); str "end"; nl ();
717                closePP ()
718              end              end
719    
720              fun pr_su_structure (StUn, k, K, tag, size, fields) = let          fun pr_st_structure { src, tag, anon, size, fields } =
721                pr_sut_structure (src, tag, anon, size, "s", "S")
722            fun pr_ut_structure { src, tag, anon, size, largest, all } =
723                pr_sut_structure (src, tag, anon, size, "u", "U")
724    
725            fun pr_su_structure (src, tag, fields, k, K) = let
726    
727                val file = smlfile (concat [k, "-", tag])
728                val { closePP, Box, endBox, str, nl,
729                      pr_tdef, pr_vdef, pr_fdef, ... } =
730                    openPP (file, SOME src)
731    
732                  fun rwro S.RW = "rw"                  fun rwro S.RW = "rw"
733                    | rwro S.RO = "ro"                    | rwro S.RO = "ro"
734    
735                  fun pr_field_typ { name, spec = S.OFIELD { spec = (c, t),                  fun pr_field_typ { name, spec = S.OFIELD { spec = (c, t),
736                                                             synthetic = false,                                                             synthetic = false,
737                                                             offset } } =                                                             offset } } =
738                      pr_tdef (fieldtype_id name, wtn_ty t)                      pr_tdef (fieldtype_id name, wtn_ty t)
739                    | pr_field_typ _ = ()                    | pr_field_typ _ = ()
740    
741                  fun pr_field_rtti { name, spec = S.OFIELD { spec = (c, t),                  fun pr_field_rtti { name, spec = S.OFIELD { spec = (c, t),
742                                                             synthetic = false,                                                             synthetic = false,
743                                                             offset } } =                                                             offset } } =
744                      pr_vdef (fieldrtti_id name, rtti_val t)                  pr_vdef (fieldrtti_id name,
745                             EConstr (rtti_val t,
746                                      Con ("T.typ", [Type (fieldtype_id name)])))
747                    | pr_field_rtti _ = ()                    | pr_field_rtti _ = ()
748    
749                  fun pr_bf_acc (name, p, sign,              fun arg_x p = EConstr (EVar "x",
750                                 { offset, constness, bits, shift }) =                                     Con ("su_obj" ^ p,
751                                            [Type "tag", Type "'c"]))
752    
753    
754                fun pr_bf_acc (name, p, sign, { offset, constness, bits, shift }) =
755                      let val maker =                      let val maker =
756                              concat ["mk_", rwro constness, "_", sign, "bf", p]                              concat ["mk_", rwro constness, "_", sign, "bf", p]
757                      in                      in
758                          pr_fdef (field_id (name, p),                          pr_fdef (field_id (name, p),
759                                   [EVar "x"],                               [arg_x p],
760                                   EApp (EApp (EVar maker,                                   EApp (EApp (EVar maker,
761                                               ETuple [EInt offset,                                               ETuple [EInt offset,
762                                                       EWord bits,                                                       EWord bits,
# Line 804  Line 769 
769                      in                      in
770                          if synthetic then ()                          if synthetic then ()
771                          else pr_fdef (field_id (name, "'"),                          else pr_fdef (field_id (name, "'"),
772                                        [EConstr (EVar "x",                                    [arg_x "'"],
773                                                  Suobj''c (StUn tag))],                                    EConstr (EApp (EVar "mk_field'",
774                                        EConstr (EApp (EApp (EVar "mk_field'",                                                   ETuple [EInt offset,
775                                                             EInt offset),                                                           EVar "x"]),
776                                                       EVar "x"),                                             Con ("obj'",
777                                                 obj_ty "'" (t, cro c)))                                                  [Type (fieldtype_id name),
778                                                     cro c])))
779                      end                      end
780                    | pr_field_acc' { name, spec = S.SBF bf } =                    | pr_field_acc' { name, spec = S.SBF bf } =
781                      pr_bf_acc (name, "'", "s", bf)                      pr_bf_acc (name, "'", "s", bf)
# Line 825  Line 791 
791                              val rttival = EVar (fieldrtti_id name)                              val rttival = EVar (fieldrtti_id name)
792                          in                          in
793                              pr_fdef (field_id (name, ""),                              pr_fdef (field_id (name, ""),
794                                       [EVar "x"],                                   [arg_x ""],
795                                       EApp (EApp (EApp (EVar maker, rttival),                                   EApp (EVar maker,
796                                                   EInt offset),                                         ETuple [rttival,
797                                             EVar "x"))                                                 EInt offset,
798                                                   EVar "x"]))
799                          end                          end
800                    | pr_field_acc { name, spec = S.SBF bf } =                    | pr_field_acc { name, spec = S.SBF bf } =
801                      pr_bf_acc (name, "", "s", bf)                      pr_bf_acc (name, "", "s", bf)
802                    | pr_field_acc { name, spec = S.UBF bf } =                    | pr_field_acc { name, spec = S.UBF bf } =
803                      pr_bf_acc (name, "", "u", bf)                      pr_bf_acc (name, "", "u", bf)
804    
805                val sustruct = "structure " ^ SUstruct K tag
806              in              in
807                  nl ();              str "local open C.Dim C_Int in";
808                  str (concat ["structure ", su_id (K, tag), " = struct"]);              nl (); str (sustruct ^ " = struct");
809                  Box 4;                  Box 4;
810                  nl (); str ("open " ^ su_id (K, tag));              nl (); str ("open " ^ SUTstruct K tag);
811                  app pr_field_typ fields;                  app pr_field_typ fields;
812                  app pr_field_rtti fields;                  app pr_field_rtti fields;
813                  if dolight then app pr_field_acc' fields else ();                  if dolight then app pr_field_acc' fields else ();
814                  if doheavy then app pr_field_acc fields else ();                  if doheavy then app pr_field_acc fields else ();
815                  endBox ();                  endBox ();
816                  nl (); str "end"              nl (); str "end";
817                nl (); str "end";
818                nl (); closePP ();
819                exports := sustruct :: (!exports)
820            end
821    
822            fun pr_s_structure { src, tag, anon, size, fields } =
823                pr_su_structure (src, tag, fields, "s", "S")
824            fun pr_u_structure { src, tag, anon, size, largest, all } =
825                pr_su_structure (src, tag, all, "u", "U")
826    
827            fun pr_t_structure { src, name, spec } =
828                case incomplete spec of
829                    SOME _ => ()
830                  | NONE => let
831                        val file = smlfile ("t-" ^ name)
832                        val { closePP, Box, endBox, str, nl, pr_tdef,
833                              pr_vdef, ... } =
834                            openPP (file, SOME src)
835                        val tstruct = "structure " ^ Tstruct name
836                    in
837                        str "local open C in";
838                        nl (); str (tstruct ^ " = struct");
839                        Box 4;
840                        pr_tdef ("t", rtti_ty spec);
841                        pr_vdef ("typ", EConstr (rtti_val spec, Type "t"));
842                        endBox ();
843                        nl (); str "end";
844                        nl (); str "end";
845                        nl ();
846                        closePP ();
847                        exports := tstruct :: !exports
848              end              end
849    
850              fun pr_struct_structure { tag, size, anon, fields } =          fun pr_gvar { src, name, spec = (c, t) } = let
851                  pr_su_structure (St, "s", "S", tag, size, fields)              val file = smlfile ("g-" ^ name)
852              fun pr_union_structure { tag, size, anon, largest, all } =              val { closePP, str, nl, Box, VBox, endBox,
853                  pr_su_structure (Un, "u", "U", tag, size, all)                    pr_fdef, pr_vdef, pr_tdef, ... } =
854                    openPP (file, SOME src)
855              fun pr_gty_rtti { name, spec } =              val rwobj = EApp (EVar "mk_obj",
856                  pr_vdef (typetype_id name, rtti_val spec)                                ETuple [rtti_val t, EApp (EVar "h", EUnit)])
   
             fun pr_addr (prefix, name) =  
                 pr_vdef (prefix ^ name,  
                          EApp (EApp (EVar "D.lib_symbol", EVar "so_h"),  
                                EString name))  
   
             fun pr_gvar_addr { name, spec } = pr_addr ("gh_", name)  
   
             fun pr_gvar_obj { name, spec = (c, t) } = let  
                 val rwobj = EApp (EApp (EVar "mk_obj", rtti_val t),  
                                   EApp (EVar "D.addr", EVar ("gh_" ^ name)))  
857                  val obj = case c of S.RW => rwobj                  val obj = case c of S.RW => rwobj
858                                    | S.RO => EApp (EVar "ro", rwobj)                                    | S.RO => EApp (EVar "ro", rwobj)
859                val gstruct = "structure " ^ Gstruct name
860              in              in
861                  pr_fdef (gvar_id name, [ETuple []], obj)              str (gstruct ^ " = struct");
862                Box 4;
863                nl (); str "local";
864                VBox 4;
865                nl (); str "open C_Int";
866                pr_vdef ("h", EApp (EVar libraryhandle, EString name));
867                endBox ();
868                nl (); str "in";
869                VBox 4;
870                pr_tdef ("t", wtn_ty t);
871                pr_vdef ("typ", EConstr (rtti_val t, Con ("T.typ", [Type "t"])));
872                pr_fdef ("obj", [EUnit],
873                         EConstr (obj, Con ("obj", [Type "t", rwro c])));
874                endBox ();
875                nl (); str "end";
876                endBox ();
877                nl (); str "end"; nl ();
878                closePP ();
879                exports := gstruct :: !exports
880              end              end
881    
882              fun pr_gfun_rtti { name, spec, argnames } =          fun pr_gfun x = let
883                  pr_vdef (funrtti_id name, rtti_val (S.FPTR spec))              val { src, name, spec = spec as { args, res }, argnames } = x
884    
885              fun pr_gfun_addr { name, spec, argnames } = pr_addr ("fnh_", name)              val file = smlfile ("f-" ^ name)
886                val { closePP, str, nl, pr_fdef, Box, endBox,
887              fun pr_gfun_fptr { name, spec, argnames } =                    pr_vdef, pr_vdecl, ... } =
888                  pr_fdef (fptr_id name,                  openPP (file, SOME src)
889                           [ETuple []],              fun do_f is_light = let
                          EApp (EApp (EVar "mk_fptr", EVar (funrtti_id name)),  
                                EApp (EVar "D.addr", EVar ("fnh_" ^ name))))  
   
             fun pr_gfun_func is_light x = let  
                 val { name, spec = { args, res }, argnames } = x  
                 val p = if is_light then "'" else ""  
890                  val ml_vars =                  val ml_vars =
891                      rev (#1 (foldl (fn (_, (l, i)) =>                      rev (#1 (foldl (fn (_, (l, i)) =>
892                                         (EVar ("x" ^ Int.toString i) :: l,                                         (EVar ("x" ^ Int.toString i) :: l,
# Line 920  Line 922 
922                           [writeto])                           [writeto])
923                        | _ => (ml_vars, c_exps, [])                        | _ => (ml_vars, c_exps, [])
924                  val call = EApp (EVar "call",                  val call = EApp (EVar "call",
925                                   ETuple [EApp (EVar (fptr_id name),                                   ETuple [EApp (EVar "fptr", EUnit),
                                                ETuple []),  
926                                           ETuple c_exps])                                           ETuple c_exps])
927                  val ml_res =                  val ml_res =
928                      case res of                      case res of
# Line 946  Line 947 
947                                                 ml_vars))                                                 ml_vars))
948                        | _ => ETuple ml_vars                        | _ => ETuple ml_vars
949              in              in
950                  pr_fdef (fun_id (name, p), [argspat], ml_res)                  pr_fdef (if is_light then "f'" else "f", [argspat], ml_res)
951              end              end
952                fun do_fsig is_light = let
953              fun pr_isu_arg (K, tag) =                  val p = if is_light then "'" else ""
                 (sp (); str (concat ["structure ", isu_id (K, tag),  
                                      " : POINTER_TO_INCOMPLETE_TYPE"]))  
             fun pr_istruct_arg tag = pr_isu_arg ("S", tag)  
             fun pr_iunion_arg tag = pr_isu_arg ("U", tag)  
   
             fun pr_isu_def (kw, K, tag) = let  
                 val n = isu_id (K, tag)  
954              in              in
955                  nl ();                  pr_vdecl ("f" ^ p, topfunc_ty p (spec, argnames))
                 str (concat [kw, " ", n, " = ", n])  
956              end              end
957              fun pr_istruct_res tag = pr_isu_def ("where", "S", tag)              val fstruct = "structure " ^ Fstruct name
             fun pr_iunion_res tag = pr_isu_def ("where", "U", tag)  
             fun pr_istruct_def tag = pr_isu_def ("structure", "S", tag)  
             fun pr_iunion_def tag = pr_isu_def ("structure", "U", tag)  
   
             fun pr_pre_su (K, k, STUN, StUn, tag, size) =  
                 (nl (); str (concat ["structure ",  
                                      su_id (K, tag), " = struct"]);  
                  VBox 4;  
                  pr_tdef ("tag", Type (su_id (k, tag)));  
                  pr_vdef ("size",  
                           EConstr (EApp (EVar "C_Int.mk_su_size", EWord size),  
                                    Con ("C.S.size",  
                                         [Con ("C.su", [StUn tag])])));  
                  pr_vdef ("typ", EApp (EVar "C_Int.mk_su_typ", EVar "size"));  
                  endBox ();  
                  nl (); str "end")  
   
             fun pr_pre_struct { tag, size, anon, fields } =  
                 pr_pre_su ("S", "s", S.STRUCT, St, tag, size)  
             fun pr_pre_union { tag, size, anon, largest, all } =  
                 pr_pre_su ("U", "u", S.UNION, Un, tag, size)  
   
             fun pr_enum_const { name, spec } =  
                 pr_vdef (enum_id name, EConstr (ELInt spec, sint_ty))  
958          in          in
959              (* Generating the functor file... *)              str "local";
960              str dontedit;              Box 4;
961              nl (); str credits;              nl (); str "open C_Int";
962              nl (); str commentsto;              pr_vdef ("h", EApp (EVar libraryhandle, EString name));
             nl ();  
             str (concat ["structure ", strname, " = struct"]);  
             VBox 4;  
   
             if length structs + length unions <> 0 then  
                 (nl (); str "local";  
                  VBox 4;  
                  nl (); str "open Tag";  
963                   endBox ();                   endBox ();
964                   nl (); str "in";                   nl (); str "in";
965                   VBox 4;              nl (); str (fstruct ^ " : sig");
966                   (* definitions for struct/union tags *)              Box 4;
967                   app pr_struct_tag structs;              pr_vdecl ("typ", rtti_ty (S.FPTR spec));
968                   app pr_union_tag unions;              pr_vdecl ("fptr", Arrow (Unit, wtn_ty (S.FPTR spec)));
969                   endBox ();              if doheavy then do_fsig false else ();
970                   nl (); str "end")              if dolight then do_fsig true else ();
             else ();  
   
             (* "pre"-structures for all structures and unions *)  
             app pr_pre_struct structs;  
             app pr_pre_union unions;  
   
             (* the main functor *)  
             nl ();  
             str "functor"; nsp (); str (strname ^ "Fn");  
             HOVBox 4;  
             sp ();  
             PP.openHVBox strpp (PP.Rel 1);  
             str "(";  
             pr_vdecl ("library", Type "DynLinkage.lib_handle");  
             app pr_istruct_arg incomplete_structs;  
             app pr_iunion_arg incomplete_unions;  
             str ")";  
             endBox ();  
             sp (); str ":"; sp (); str signame;  
             VBox 4;  
             app pr_istruct_res incomplete_structs;  
             app pr_iunion_res incomplete_unions;  
971              endBox ();              endBox ();
972              nsp (); str "=";              nl (); str "end = struct";
973                Box 4;
974                pr_vdef ("typ", rtti_val (S.FPTR spec));
975                pr_fdef ("fptr",
976                         [EUnit],
977                         EApp (EVar "mk_fptr",
978                               ETuple [EVar (fptr_mkcall spec),
979                                       EApp (EVar "h", EUnit)]));
980                if doheavy then do_f false else ();
981                if dolight then do_f true else ();
982              endBox ();              endBox ();
983              nl (); str "struct";              nl (); str "end"; nl (); str "end"; nl ();
984              VBox 4;              closePP ();
985                exports := fstruct :: !exports
986              (* copy definitions for struct/union tags *)          end
             app pr_struct_tag_copy structs;  
             app pr_union_tag_copy unions;  
   
             (* other local stuff (to define RTTI for function pointers) *)  
             nl (); str "local";  
             VBox 4;  
             nl (); str "structure D = DynLinkage";  
             nl (); str "open C.Dim C_Int";  
   
             (* low-level call operations for all function pointers *)  
             app pr_fptr_rtti fptr_types;  
   
             (* the library handle (handle on shared object) *)  
             nl (); str "val so_h = library";  
             (* addr handles for global variables *)  
             app pr_gvar_addr gvars;  
             (* addr handles for global C functions *)  
             app pr_gfun_addr gfuns;  
987    
988            fun pr_enum { src, tag, spec } = let
989                val file = smlfile ("e-" ^ tag)
990                val { closePP, str, nl, pr_vdef, Box, endBox, ... } =
991                    openPP (file, SOME src)
992                fun v { name, spec } =
993                    pr_vdef (enum_id name, EConstr (ELInt spec, sint_ty))
994                val estruct = "structure " ^ Estruct tag
995            in
996                str (estruct ^ " = struct");
997                Box 4;
998                app v spec;
999              endBox ();              endBox ();
1000              nl (); str "in";              nl (); str "end"; nl ();
1001              VBox 4;              closePP ();
1002              (* carry-throughs for incomplete types *)              exports := estruct :: !exports
             app pr_istruct_def incomplete_structs;  
             app pr_iunion_def incomplete_unions;  
             (* ML structures corresponding to C struct declarations *)  
             app pr_struct_structure structs;  
             (* ML structurse corresponding to C union declarations *)  
             app pr_union_structure unions;  
   
             (* RTTI for C typedefs *)  
             app pr_gty_rtti cgtys;  
             (* (suspended) objects for global variables *)  
             app pr_gvar_obj gvars;  
             (* RTTI for pointers corresponding to global C functions *)  
             app pr_gfun_rtti gfuns;  
             (* (suspended) function pointers for global C functions *)  
             app pr_gfun_fptr gfuns;  
             (* ML functions corresponding to global C functions *)  
             if dolight then app (pr_gfun_func true) gfuns else ();  
             if doheavy then app (pr_gfun_func false) gfuns else ();  
             (* enum constants *)  
             app pr_enum_const enums;  
             endBox ();  
             nl (); str "end";           (* local *)  
             endBox ();  
             nl (); str "end";           (* functor/struct *)  
             endBox ();  
             nl (); str "end";           (* structure/struct *)  
             nl ();  
   
             PP.closeStream strpp  
1003          end          end
1004    
1005          fun do_cm_file () = let          fun do_iptrs () = let
1006              val cmpp = openPP cmfile              val file = smlfile "iptrs"
1007                val { closePP, str, nl, ... } = openPP (file, NONE)
1008                fun pr_isu_def K tag = let
1009                    val istruct = "structure " ^ isu_id (K, tag)
1010                in
1011                    str (istruct ^ " = PointerToIncompleteType ()");
1012                    nl ();
1013                    exports := istruct :: !exports
1014                end
1015            in
1016                app (pr_isu_def "S") incomplete_structs;
1017                app (pr_isu_def "U") incomplete_unions;
1018                closePP ()
1019            end
1020    
1021              fun nl () = PP.newline cmpp          fun do_cmfile () = let
1022              fun str s = PP.string cmpp s              val file = descrfile cmfile
1023              fun sp () = PP.space cmpp 1              val { closePP, line, str, nl, VBox, endBox, ... } =
1024              fun nsp () = PP.nbSpace cmpp 1                  openPP (file, NONE)
             fun VBox a = PP.openVBox cmpp (PP.Abs a)  
             fun endBox () = PP.closeBox cmpp  
             fun line s = (nl (); str s)  
             val ls =  
                 case lambdasplit of  
                     NONE => ""  
                   | SOME s => concat ["\t(lambdasplit:", s, ")"]  
1025          in          in
1026              (* Generating the .cm file... *)              str "(primitive c-int)";
             str dontedit;  
             line credits;  
             line commentsto;  
             line "(primitive c-int)";  
1027              line "library";              line "library";
1028              VBox 4;              VBox 4;
1029              line ("signature " ^ signame);              app line (!exports);
             line ("structure " ^ strname);  
1030              endBox ();              endBox ();
1031              line "is";              nl (); str "is";
1032              VBox 4;              VBox 4;
1033              app line ["$/basis.cm","$/c-int.cm", "$smlnj/init/init.cmi : cm"];              app line ["$/basis.cm","$/c-int.cm", "$smlnj/init/init.cmi : cm"];
1034              line (sigfile ^ ls);              app line (!files);
             line (strfile ^ ls);  
1035              endBox ();              endBox ();
1036              nl ();              nl ();
1037                closePP ()
             PP.closeStream cmpp  
1038          end          end
1039            val needs_iptr =
1040                case (incomplete_structs, incomplete_unions) of
1041                    ([], []) => false
1042                  | _ => true
1043      in      in
1044          do_sig_file ();  
1045          do_fct_file ();          app pr_fptr_rtti fptr_types;
1046          do_cm_file ()          app pr_st_structure structs;
1047            app pr_ut_structure unions;
1048            app pr_s_structure structs;
1049            app pr_u_structure unions;
1050            app pr_t_structure gtys;
1051            app pr_gvar gvars;
1052            app pr_gfun gfuns;
1053            app pr_enum enums;
1054            if complete andalso needs_iptr then do_iptrs () else ();
1055            do_cmfile ()
1056      end      end
1057  end  end
1058  end  end

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

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