Annotation of /sml/trunk/src/cm/main/symval.sml

Parent Directory | Revision Log

---

Revision 336 - (view) (download)

1 :	blume	336	signature SYMVAL = sig
2 :
3 :			type env
4 :
5 :			val look : env -> string -> int option
6 :			val empty : env
7 :
8 :			val default : { arch: string,
9 :			extra_arch: string option,
10 :			big: bool,
11 :			size: int,
12 :			os: SMLofNJ.SysInfo.os_kind,
13 :			version: int list }
14 :			-> env
15 :			end
16 :
17 :			structure SymVal :> SYMVAL = struct
18 :
19 :			type env = int StringMap.map
20 :
21 :			fun look e s = StringMap.find (e, s)
22 :
23 :			val empty = StringMap.empty
24 :
25 :			fun default { arch, extra_arch, big, size, os, version } = let
26 :			fun mk_arch_sym a = "ARCH_" ^ a
27 :			val arch_sym = mk_arch_sym arch
28 :			val endian_sym = if big then "BIG_ENDIAN" else "LITTLE_ENDIAN"
29 :			val size_sym = "SIZE_" ^ Int.toString size
30 :			val os_sym = case os of
31 :			SMLofNJ.SysInfo.UNIX => "OPSYS_UNIX"
32 :			| SMLofNJ.SysInfo.WIN32 => "OPSYS_WIN32"
33 :			| SMLofNJ.SysInfo.MACOS => "OPSYS_MACOS"
34 :			| SMLofNJ.SysInfo.OS2 => "OPSYS_OS2"
35 :			| SMLofNJ.SysInfo.BEOS => "OPSYS_BEOS"
36 :			val (major, minor) =
37 :			case version of
38 :			[] => (0, 0)
39 :			| [major] => (major, 0)
40 :			| major :: minor :: _ => (major, minor)
41 :			val major_sym = "SMLNJ_VERSION"
42 :			val minor_sym = "SMLNJ_MINOR_VERSION"
43 :
44 :			val almost_alldefs = [(arch_sym, 1),
45 :			(endian_sym, 1),
46 :			(size_sym, 1),
47 :			(os_sym, 1),
48 :			(major_sym, major),
49 :			(minor_sym, minor)]
50 :
51 :			val alldefs =
52 :			case extra_arch of
53 :			NONE => almost_alldefs
54 :			| SOME a => (mk_arch_sym a, 1) :: almost_alldefs
55 :			in
56 :			foldl StringMap.insert' empty alldefs
57 :			end
58 :			end

---

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