Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/cm/main/symval.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log 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