HCoop / hcoop / debian / mlton.git / blame
| 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 |