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/ast-to-spec.sml
ViewVC logotype

Diff of /sml/trunk/src/ml-nlffigen/ast-to-spec.sml

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

revision 1095, Tue Feb 26 13:20:40 2002 UTC revision 1096, Tue Feb 26 16:59:02 2002 UTC
# Line 17  Line 17 
17    
18      exception VoidType      exception VoidType
19      exception Ellipsis      exception Ellipsis
20        exception Duplicate of string
21    
22      fun bug m = raise Fail ("AstToSpec: bug: " ^ m)      fun bug m = raise Fail ("AstToSpec: bug: " ^ m)
23      fun err m = raise Fail ("AstToSpec: error: " ^ m)      fun err m = raise Fail ("AstToSpec: error: " ^ m)
24      fun warn m = TextIO.output (TextIO.stdErr, "AstToSpec: warning: " ^ m)      fun warn m = TextIO.output (TextIO.stdErr, "AstToSpec: warning: " ^ m)
25    
26      fun build (bundle, sizes: Sizes.sizes,      fun build { bundle, sizes: Sizes.sizes, collect_enums,
27                 cfiles, match, allSU, eshift, gensym_suffix) =                  cfiles, match, allSU, eshift, gensym_suffix } =
28      let      let
29    
30          val curLoc = ref "?"          val curLoc = ref "?"
# Line 49  Line 50 
50              match srcFile              match srcFile
51    
52          fun includedSU (tag, loc) = (allSU orelse isThisFile loc)          fun includedSU (tag, loc) = (allSU orelse isThisFile loc)
53            fun includedEnum (tag, loc) = isThisFile loc
54    
55          fun includedTy (n, loc) = isThisFile loc          fun includedTy (n, loc) = isThisFile loc
56    
# Line 82  Line 84 
84          val gtys = ref SM.empty          val gtys = ref SM.empty
85          val gvars = ref SM.empty          val gvars = ref SM.empty
86          val gfuns = ref SM.empty          val gfuns = ref SM.empty
87          val enums = ref SM.empty          val named_enums = ref SM.empty
88            val anon_enums = ref SM.empty
89    
90          val seen_structs = ref SS.empty          val seen_structs = ref SS.empty
91          val seen_unions = ref SS.empty          val seen_unions = ref SS.empty
# Line 159  Line 162 
162            | valty C (A.Numeric (_, _, A.UNSIGNED, A.LONG, _)) = Spec.ULONG            | valty C (A.Numeric (_, _, A.UNSIGNED, A.LONG, _)) = Spec.ULONG
163            | valty C (A.Numeric (_, _, _, A.FLOAT, _)) = Spec.FLOAT            | valty C (A.Numeric (_, _, _, A.FLOAT, _)) = Spec.FLOAT
164            | valty C (A.Numeric (_, _, _, A.DOUBLE, _)) = Spec.DOUBLE            | valty C (A.Numeric (_, _, _, A.DOUBLE, _)) = Spec.DOUBLE
165            | valty C (A.Numeric _) = bug "numeric type not (yet) supported"            | valty C (A.Numeric (_, _, A.SIGNED, A.LONGLONG, _)) =
166                Spec.UNIMPLEMENTED "long long"
167              | valty C (A.Numeric (_, _, A.UNSIGNED, A.LONGLONG, _)) =
168                Spec.UNIMPLEMENTED "unsigned long long"
169              | valty C (A.Numeric (_, _, _, A.LONGDOUBLE, _)) =
170                Spec.UNIMPLEMENTED "long double"
171            | valty C (A.Array (NONE, t)) = valty C (A.Pointer t)            | valty C (A.Array (NONE, t)) = valty C (A.Pointer t)
172            | valty C (A.Array (SOME (n, _), t)) =            | valty C (A.Array (SOME (n, _), t)) =
173              let val d = Int.fromLarge n              let val d = Int.fromLarge n
# Line 175  Line 183 
183            | valty C (A.Function f) = fptrty C f            | valty C (A.Function f) = fptrty C f
184            | valty C (A.StructRef tid) = typeref (tid, Spec.STRUCT, C)            | valty C (A.StructRef tid) = typeref (tid, Spec.STRUCT, C)
185            | valty C (A.UnionRef tid) = typeref (tid, Spec.UNION, C)            | valty C (A.UnionRef tid) = typeref (tid, Spec.UNION, C)
186            | valty C (A.EnumRef tid) =            | valty C (A.EnumRef tid) = typeref (tid, fn t => Spec.ENUM (t, false), C)
             typeref (tid, (* hack *) fn _ => Spec.SINT, C)  
187            | valty C (A.TypeRef tid) =            | valty C (A.TypeRef tid) =
188              typeref (tid, fn _ => bug "missing typedef info", C)              typeref (tid, fn _ => bug "missing typedef info", C)
189            | valty C A.Error = err "Error type"            | valty C A.Error = err "Error type"
# Line 184  Line 191 
191          and valty_nonvoid C t = valty C t          and valty_nonvoid C t = valty C t
192              handle VoidType => err "void variable type"              handle VoidType => err "void variable type"
193    
 (*  
         and valty_td (A.StructRef tid, tdname) =  
             typeref (tid, Spec.STRUCT, tdname)  
           | valty_td (A.UnionRef tid, tdname) =  
             typeref (tid, Spec.UNION, tdname)  
           | valty_td (A.EnumRef tid, tdname) =  
             typeref (tid, fn _ => Spec.SINT, tdname)  
           | valty_td (t, _) = valty t  
 *)  
   
194          and typeref (tid, otherwise, C) =          and typeref (tid, otherwise, C) =
195              case Tidtab.find (tidtab, tid) of              case Tidtab.find (tidtab, tid) of
196                  NONE => bug "tid not bound in tidtab"                  NONE => bug "tid not bound in tidtab"
# Line 206  Line 203 
203                       structty (tid, name, C, members, location)                       structty (tid, name, C, members, location)
204                     | B.Union (tid, members) =>                     | B.Union (tid, members) =>
205                       unionty (tid, name, C, members, location)                       unionty (tid, name, C, members, location)
206                     | B.Enum (tid, edefs) => let                     | B.Enum (tid, edefs) =>
207                           fun one ({ name, uid, location, ctype, kind }, i) =                       enumty (tid, name, C, edefs, location)
                              { name = Symbol.name name, spec = i }  
                          val all = map one edefs  
                          val (tn, anon) = tagname (name, C, tid)  
                          val rtn = reported_tagname (tn, anon)  
                      in  
                          enums := SM.insert (!enums, rtn,  
                                              { src = srcOf location,  
                                                tag = rtn,  
                                                spec = all });  
                          Spec.SINT  
                      end  
208                     | B.Typedef (_, t) => let                     | B.Typedef (_, t) => let
209                           val n =                           val n =
210                               case name of                               case name of
# Line 237  Line 223 
223                           res                           res
224                       end)                       end)
225    
226            and enumty (tid, name, C, edefs, location) = let
227                val (tag_stem, anon) = tagname (name, C, tid)
228                val tag = reported_tagname (tag_stem, anon)
229                fun one ({ name, uid, location, ctype, kind }, i) =
230                    { name = Symbol.name name, spec = i }
231                val enums = if anon then anon_enums else named_enums
232            in
233                enums := SM.insert (!enums, tag,
234                                    { src = srcOf location,
235                                      tag = tag,
236                                      anon = anon,
237                                      descr = tag,
238                                      exclude = not (includedEnum (tag, location)),
239                                      spec = map one edefs });
240                Spec.ENUM (tag, anon)
241            end
242    
243          and structty (tid, name, C, members, location) = let          and structty (tid, name, C, members, location) = let
244              val (tag_stem, anon) = tagname (name, C, tid)              val (tag_stem, anon) = tagname (name, C, tid)
245              val tag = reported_tagname (tag_stem, anon)              val tag = reported_tagname (tag_stem, anon)
# Line 435  Line 438 
438                       end)                       end)
439                | (A.AUTO | A.REGISTER | A.STATIC) => ()                | (A.AUTO | A.REGISTER | A.STATIC) => ()
440    
441          fun declaration (A.TypeDecl { tid, ... }) =          fun dotid tid =
442              (* Spec.SINT is an arbitrary choice; the value gets              (* Spec.SINT is an arbitrary choice; the value gets
443               * ignored anyway *)               * ignored anyway *)
444              (ignore (typeref (tid, fn _ => Spec.SINT, tl_context))              (ignore (typeref (tid, fn _ => Spec.SINT, tl_context))
445               handle VoidType => ())     (* ignore type aliases for void *)               handle VoidType => ())     (* ignore type aliases for void *)
446    
447            fun declaration (A.TypeDecl { tid, ... }) = dotid tid
448            | declaration (A.VarDecl (v, _)) = varDecl v            | declaration (A.VarDecl (v, _)) = varDecl v
449    
450          fun coreExternalDecl (A.ExternalDecl d) = declaration d          fun coreExternalDecl (A.ExternalDecl d) = declaration d
# Line 453  Line 458 
458              else ()              else ()
459    
460          fun doast l = app externalDecl l          fun doast l = app externalDecl l
461    
462            fun gen_enums () = let
463                val ael = SM.listItems (!anon_enums)
464                val nel = SM.listItems (!named_enums)
465                infix $
466                fun x $ [] = [x]
467                  | x $ y = x :: ", " :: y
468                fun onev (v as { name, spec }, m) =
469                    if SM.inDomain (m, name) then raise Duplicate name
470                    else SM.insert (m, name, v)
471                fun onee ({ src, tag, anon, spec, descr, exclude }, (m, sl)) =
472                    (foldl onev m spec, src $ sl)
473            in
474                if collect_enums then
475                    let val (m, sl) = foldl onee (SM.empty, []) ael
476                    in
477                        if SM.isEmpty m then nel
478                        else { src = concat (rev sl),
479                               tag = "'",
480                               anon = false,
481                               descr = "collected from unnamed enumerations",
482                               exclude = false,
483                               spec = SM.listItems m }
484                             :: nel
485                    end handle Duplicate name =>
486                               (warn (concat ["constant ", name,
487                                              " defined more than once;\
488                                              \ disabling `-collect'\n"]);
489                                ael @ nel)
490                else ael @ nel
491            end
492      in      in
493          doast ast;          doast ast;
494            app (dotid o #1) (Tidtab.listItemsi tidtab);
495          { structs = !structs,          { structs = !structs,
496            unions = !unions,            unions = !unions,
497            gtys = SM.listItems (!gtys),            gtys = SM.listItems (!gtys),
498            gvars = SM.listItems (!gvars),            gvars = SM.listItems (!gvars),
499            gfuns = SM.listItems (!gfuns),            gfuns = SM.listItems (!gfuns),
500            enums = SM.listItems (!enums) } : Spec.spec            enums = gen_enums () } : Spec.spec
501      end      end
502  end  end

Legend:
Removed from v.1095  
changed lines
  Added in v.1096

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