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

Parent Directory | Revision Log

---

Revision 353 - (view) (download)

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

---

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