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/branches/primop-branch-2/src/compiler/ElabData/basics/primopid.sml
ViewVC logotype

Annotation of /sml/branches/primop-branch-2/src/compiler/ElabData/basics/primopid.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1955 - (view) (download)

1 : georgekuan 1954 (* primopid.sml
2 :     *
3 :     * (C) 2001 Lucent Technologies, Bell Labs
4 :     *)
5 :    
6 :     (* [dbm, 6/19/06]
7 :     Folded ii.sml into this structure, eliminating exn hack.
8 :     Changed name of pureInfo to isPrimCast.
9 :     Eliminated redundant INL_PRIM, INL_STR, INL_NO. *)
10 :    
11 :     structure PrimOpId : PRIMOPID =
12 :     struct
13 :    
14 : macqueen 1955 (* in the front end, primops are identified by a primop number *)
15 :     datatype primId = Prim of string | NonPrim
16 : georgekuan 1954
17 : macqueen 1955 datatype strPrimElem = PrimE of primId
18 :     | StrE of strPrimInfo
19 : georgekuan 1954
20 : macqueen 1955 withtype strPrimInfo = strPrimElem list
21 : georgekuan 1954
22 : macqueen 1955 fun bug s = ErrorMsg.impossible ("PrimOpId: " ^ s)
23 :    
24 :     fun isPrimop (Prim _) = true
25 :     | isPrimop NonPrim = false
26 :    
27 :     fun isPrimCallcc (Prim("callcc" | "capture")) = true
28 :     | isPrimCallcc _ = false
29 :    
30 :     fun isPrimCast (Prim "cast") = true
31 :     | isPrimCast _ = false
32 :    
33 :     val selStrPrimId = nth
34 :    
35 : georgekuan 1954 (*
36 :     fun selStrInfo (StrE l, i) =
37 :     (List.nth (l, i) handle Subscript => bug "Wrong field in List")
38 :     | selStrInfo (Null, _) = Null
39 :     | selStrInfo (Info _, i) = bug "Unexpected selection from Info"
40 :    
41 :    
42 :     fun match i { inl_prim, inl_str, inl_no } =
43 :     case i
44 :     of Info x => inl_prim x
45 :     | List l => inl_str l
46 :     | Null => inl_no ()
47 :    
48 :     fun prInfo i = let
49 :     fun loop (i, acc) =
50 :     case i
51 :     of Info (p,_) => PrimOp.prPrimop p :: acc
52 :     | Null => "<InlNo>" :: acc
53 :     | List m =>
54 :     (case m
55 :     of [] => "{}" :: acc
56 :     | h::t =>
57 :     "{" :: loop (h,foldr (fn (x, a) => "," :: loop (x, a))
58 :     ("}" :: acc)
59 :     t))
60 :     in
61 :     concat (loop (i, []))
62 :     end
63 :    
64 :     fun isPrimCallcc (Info ((PrimOp.CALLCC | PrimOp.CAPTURE), _)) = true
65 :     | isPrimCallcc _ = false
66 :    
67 :     fun isPrimCast (Info (PrimOp.CAST, _)) = true
68 :     | isPrimCast _ = false
69 :    
70 :     val mkPrimInfo = Info
71 :     val mkStrInfo = List
72 :     val nullInfo = Null
73 :    
74 :     fun primopTy (Info (_, ty)) = SOME ty
75 :     | primopTy _ = NONE
76 :     *)
77 :     end (* structure InlInfo *)

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