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/compiler/ElabData/statenv/coreacc.sml
ViewVC logotype

Annotation of /sml/trunk/compiler/ElabData/statenv/coreacc.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2624 - (view) (download)

1 : blume 903 (* coreacc.sml
2 :     *
3 :     * (C) 2001 Lucent Technologies, Bell Labs
4 :     *)
5 :     structure CoreAccess : sig
6 : blume 2624 val getVar : StaticEnv.staticEnv -> string list -> VarCon.var
7 :     val getCon : StaticEnv.staticEnv -> string list -> VarCon.datacon
8 : blume 904 val getVar' : (unit -> VarCon.var) ->
9 : blume 2624 StaticEnv.staticEnv -> string list -> VarCon.var
10 : blume 904 val getCon' : (unit -> VarCon.datacon) ->
11 : blume 2624 StaticEnv.staticEnv -> string list -> VarCon.datacon
12 : blume 904
13 :     (* like getCon, but returns a bogus exn instead of failing *)
14 : blume 2624 val getExn : StaticEnv.staticEnv -> string list -> VarCon.datacon
15 : blume 903 end = struct
16 :    
17 : blume 904 local
18 : blume 2624 fun impossible m = ErrorMsg.impossible ("CoreAccess: " ^ m)
19 :    
20 : blume 904 exception NoCore
21 :     fun dummyErr _ _ _ = raise NoCore
22 : blume 2624 fun mkpath [] = impossible "mkpath"
23 :     | mkpath [x] = [Symbol.varSymbol x]
24 :     | mkpath (x :: xs) = Symbol.strSymbol x :: mkpath xs
25 :     fun path xs = SymPath.SPATH (CoreSym.coreSym :: mkpath xs)
26 :     fun getCore env xs = Lookup.lookVal (env, path xs, dummyErr)
27 : blume 904 in
28 : blume 2624 fun getVar' err env xs =
29 :     (case getCore env xs of
30 : blume 904 VarCon.VAL r => r
31 :     | _ => impossible "getVar")
32 :     handle NoCore => err ()
33 :    
34 : blume 2624 fun getVar env xs = getVar' (fn () => impossible "getVar") env xs
35 : blume 904
36 : blume 2624 fun getCon' err env xs =
37 :     (case getCore env xs of
38 : blume 904 VarCon.CON c => c
39 :     | _ => err ())
40 :     handle NoCore => err ()
41 :    
42 : blume 2624 fun getCon env xs = getCon' (fn () => impossible "getCon") env xs
43 : blume 904
44 : blume 2624 fun getExn env xs = getCon' (fn () => VarCon.bogusEXN) env xs
45 : blume 904 end
46 : blume 903 end

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