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

SCM Repository

[smlnj] Diff of /sml/trunk/src/cm/depend/build.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/depend/build.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 354, Fri Jun 25 08:36:12 1999 UTC revision 355, Sat Jun 26 13:17:30 1999 UTC
# Line 21  Line 21 
21          ->          ->
22          impexp SymbolMap.map            (* exports *)          impexp SymbolMap.map            (* exports *)
23          * GroupGraph.privileges         (* required privileges (aggregate) *)          * GroupGraph.privileges         (* required privileges (aggregate) *)
24    
25        (* for the autoloader *)
26        type looker = Symbol.symbol -> DAEnv.env
27        val look : looker -> DAEnv.env -> looker
28        val processOneSkeleton : looker -> Skeleton.decl -> unit
29  end  end
30    
31  structure BuildDepend :> BUILDDEPEND = struct  structure BuildDepend :> BUILDDEPEND = struct
# Line 36  Line 41 
41    
42      type impexp = DG.impexp      type impexp = DG.impexp
43    
44        type looker = Symbol.symbol -> DAEnv.env
45    
46      fun look otherwise DE.EMPTY s = otherwise s      fun look otherwise DE.EMPTY s = otherwise s
47        | look otherwise (DE.BINDING (s', v)) s =        | look otherwise (DE.BINDING (s', v)) s =
48          if S.eq (s, s') then v else otherwise s          if S.eq (s, s') then v else otherwise s
# Line 45  Line 52 
52        | look otherwise (DE.FILTER (ss, e)) s =        | look otherwise (DE.FILTER (ss, e)) s =
53          if SymbolSet.member (ss, s) then look otherwise e s else otherwise s          if SymbolSet.member (ss, s) then look otherwise e s else otherwise s
54    
55        fun evalOneSkeleton lookimport = let
56            (* build the lookup function for DG.env *)
57            val lookup = look lookimport
58    
59            fun lookSymPath e (SP.SPATH []) = DE.EMPTY
60              | lookSymPath e (SP.SPATH (p as (h :: t))) = let
61                    (* again, if we don't find it here we just ignore
62                     * the problem and let the compiler catch it later *)
63                    val lookup' = look (fn _ => DE.EMPTY)
64                    fun loop (e, []) = e
65                      | loop (e, h :: t) = loop (lookup' e h, t)
66                in
67                    loop (lookup e h, t)
68                end
69    
70            (* "eval" -- compute the export environment of a skeleton *)
71            fun eval sk = let
72                fun evalDecl e (SK.Bind (name, def)) =
73                    DE.BINDING (name, evalModExp e def)
74                  | evalDecl e (SK.Local (d1, d2)) =
75                    evalDecl (DE.LAYER (evalDecl e d1, e)) d2
76                  | evalDecl e (SK.Seq l) = evalSeqDecl e l
77                  | evalDecl e (SK.Par []) = DE.EMPTY
78                  | evalDecl e (SK.Par (h :: t)) =
79                    foldl (fn (x, r) => DE.LAYER (evalDecl e x, r))
80                    (evalDecl e h) t
81                  | evalDecl e (SK.Open s) = evalModExp e s
82                  | evalDecl e (SK.Ref s) =
83                    (SS.app (ignore o lookup e) s; DE.EMPTY)
84    
85                and evalSeqDecl e [] = DE.EMPTY
86                  | evalSeqDecl e (h :: t) = let
87                        fun one (d, e') =
88                            DE.LAYER (evalDecl (DE.LAYER (e', e)) d, e')
89                    in
90                        foldl one (evalDecl e h) t
91                    end
92    
93                and evalModExp e (SK.Var sp) = lookSymPath e sp
94                  | evalModExp e (SK.Decl l) = evalSeqDecl e l
95                  | evalModExp e (SK.Let (d, m)) =
96                    evalModExp (DE.LAYER (evalSeqDecl e d, e)) m
97                  | evalModExp e (SK.Ign1 (m1, m2)) =
98                    (ignore (evalModExp e m1); evalModExp e m2)
99            in
100                evalDecl DE.EMPTY sk
101            end
102        in
103            eval
104        end
105    
106        fun processOneSkeleton lookimport sk =
107            ignore (evalOneSkeleton lookimport sk)
108    
109      (* get the description for a symbol *)      (* get the description for a symbol *)
110      fun symDesc (s, r) =      fun symDesc (s, r) =
111          S.nameSpaceToString (S.nameSpace s) :: " " :: S.name s :: r          S.nameSpaceToString (S.nameSpace s) :: " " :: S.name s :: r
# Line 164  Line 225 
225                    | NONE => lookfar ()                    | NONE => lookfar ()
226              end              end
227    
228              (* build the lookup function for DG.env *)              val eval = evalOneSkeleton lookimport
             val lookup = look lookimport  
   
             fun lookSymPath e (SP.SPATH []) = DE.EMPTY  
               | lookSymPath e (SP.SPATH (p as (h :: t))) = let  
                     (* again, if we don't find it here we just ignore  
                      * the problem and let the compiler catch it later *)  
                     val lookup' = look (fn _ => DE.EMPTY)  
                     fun loop (e, []) = e  
                       | loop (e, h :: t) = loop (lookup' e h, t)  
                 in  
                     loop (lookup e h, t)  
                 end  
   
             (* "eval" -- compute the export environment of a skeleton *)  
             fun eval sk = let  
                 fun evalDecl e (SK.Bind (name, def)) =  
                     DE.BINDING (name, evalModExp e def)  
                   | evalDecl e (SK.Local (d1, d2)) =  
                     evalDecl (DE.LAYER (evalDecl e d1, e)) d2  
                   | evalDecl e (SK.Seq l) = evalSeqDecl e l  
                   | evalDecl e (SK.Par []) = DE.EMPTY  
                   | evalDecl e (SK.Par (h :: t)) =  
                     foldl (fn (x, r) => DE.LAYER (evalDecl e x, r))  
                           (evalDecl e h) t  
                   | evalDecl e (SK.Open s) = evalModExp e s  
                   | evalDecl e (SK.Ref s) =  
                     (SS.app (ignore o lookup e) s; DE.EMPTY)  
   
                 and evalSeqDecl e [] = DE.EMPTY  
                   | evalSeqDecl e (h :: t) = let  
                         fun one (d, e') =  
                             DE.LAYER (evalDecl (DE.LAYER (e', e)) d, e')  
                     in  
                         foldl one (evalDecl e h) t  
                     end  
   
                 and evalModExp e (SK.Var sp) = lookSymPath e sp  
                   | evalModExp e (SK.Decl l) = evalSeqDecl e l  
                   | evalModExp e (SK.Let (d, m)) =  
                     evalModExp (DE.LAYER (evalSeqDecl e d, e)) m  
                   | evalModExp e (SK.Ign1 (m1, m2)) =  
                     (ignore (evalModExp e m1); evalModExp e m2)  
             in  
                 evalDecl DE.EMPTY sk  
             end  
229    
230              val e = case SmlInfo.skeleton gp i of              val e = case SmlInfo.skeleton gp i of
231                  SOME sk => eval sk                  SOME sk => eval sk

Legend:
Removed from v.354  
changed lines
  Added in v.355

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