| 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 |