Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* spec.sml |
2 | * 2005 Matthew Fluet (mfluet@acm.org) | |
3 | * Adapted for MLton. | |
4 | *) | |
5 | ||
6 | (* | |
7 | * spec.sml - A data structure describing the export interface of a | |
8 | * C program. | |
9 | * | |
10 | * (C) 2001, Lucent Technologies, Bell Labs | |
11 | * | |
12 | * author: Matthias Blume (blume@research.bell-labs.com) | |
13 | *) | |
14 | structure Spec = struct | |
15 | ||
16 | datatype constness = RO | RW | |
17 | type tag = string | |
18 | ||
19 | datatype basic_ctype = | |
20 | SCHAR | UCHAR | |
21 | | SSHORT | USHORT | |
22 | | SINT | UINT | |
23 | | SLONG | ULONG | |
24 | | SLONGLONG | ULONGLONG | |
25 | | FLOAT | DOUBLE | |
26 | ||
27 | datatype ctype = | |
28 | BASIC of basic_ctype | |
29 | | VOIDPTR | |
30 | | STRUCT of tag | |
31 | | UNION of tag | |
32 | | ENUM of tag * bool | |
33 | | FPTR of cft | |
34 | | PTR of cobj | |
35 | | ARR of { t: ctype, d: int, esz: int } | |
36 | | UNIMPLEMENTED of string | |
37 | ||
38 | withtype cft = { args: ctype list, res: ctype option } | |
39 | ||
40 | and cobj = constness * ctype | |
41 | ||
42 | datatype fieldspec = | |
43 | OFIELD of { offset: int, spec: cobj, synthetic: bool } | |
44 | | SBF of { offset: int, constness: constness, bits: word, shift: word } | |
45 | | UBF of { offset: int, constness: constness, bits: word, shift: word } | |
46 | ||
47 | type field = { name: string, spec: fieldspec } | |
48 | ||
49 | type s = | |
50 | { src: string, | |
51 | tag: tag, | |
52 | anon: bool, | |
53 | size: word, | |
54 | fields: field list, | |
55 | exclude: bool } | |
56 | type u = | |
57 | { src: string, | |
58 | tag: tag, | |
59 | anon: bool, | |
60 | size: word, | |
61 | all: field list, | |
62 | exclude: bool } | |
63 | ||
64 | type gty = { src: string, name: string, spec: ctype } | |
65 | ||
66 | type gvar = { src: string, name: string, spec: cobj } | |
67 | ||
68 | type gfun = { src: string, | |
69 | name: string, | |
70 | spec: cft, | |
71 | argnames: string list option } | |
72 | ||
73 | type enumval = { name: string, spec: LargeInt.int } | |
74 | ||
75 | type enum = { src: string, | |
76 | tag: tag, | |
77 | anon: bool, | |
78 | descr: string, | |
79 | spec: enumval list, | |
80 | exclude: bool } | |
81 | ||
82 | type spec = { structs: s list, | |
83 | unions: u list, | |
84 | gtys: gty list, | |
85 | gvars: gvar list, | |
86 | gfuns: gfun list, | |
87 | enums: enum list } | |
88 | ||
89 | fun join (x: spec, y: spec) = let | |
90 | fun uniq sel = let | |
91 | fun loop ([], a) = rev a | |
92 | | loop (h :: t, a) = | |
93 | loop (t, if List.exists | |
94 | (fn x => (sel x : string) = sel h) a then a | |
95 | else h :: a) | |
96 | in | |
97 | loop | |
98 | end | |
99 | in | |
100 | { structs = uniq #tag (#structs x, #structs y), | |
101 | unions = uniq #tag (#unions x, #unions y), | |
102 | gtys = uniq #name (#gtys x, #gtys y), | |
103 | gvars = uniq #name (#gvars x, #gvars y), | |
104 | gfuns = uniq #name (#gfuns x, #gfuns y), | |
105 | enums = uniq #tag (#enums x, #enums y) } : spec | |
106 | end | |
107 | ||
108 | val empty : spec = { structs = [], | |
109 | unions = [], | |
110 | gtys = [], | |
111 | gvars = [], | |
112 | gfuns = [], | |
113 | enums = [] } | |
114 | end |