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 1959 - (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 : georgekuan 1959 fun selStrPrimId(StrE elems, slot) = List.nth(elems, slot)
34 :     | selStrPrimId(PrimE id, slot) =
35 :     bug "PrimOpId.selStrPrimId: unexpected PrimE"
36 :     (* This bug happens if we got a primid for a value
37 :     component when we expected a strPrimElem for a
38 :     structure *)
39 : macqueen 1955
40 : georgekuan 1959 fun selValPrimFromStrPrim(StrE elems, slot) =
41 :     (case List.nth(elems, slot)
42 :     of PrimE(id) => id
43 :     | _ =>
44 :     bug "PrimOpId.selValPrimFromStrPrim: unexpected StrE")
45 :     (* This bug occurs if we got a substructure's
46 :     strPrimElem instead of an expected value component's
47 :     primId *)
48 :     | selValPrimFromStrPrim(PrimE _, slot) =
49 :     bug "PrimOpId.selValPrimFromStrPrim: unexpected PrimE"
50 :    
51 : georgekuan 1954 (*
52 :     fun selStrInfo (StrE l, i) =
53 :     (List.nth (l, i) handle Subscript => bug "Wrong field in List")
54 :     | selStrInfo (Null, _) = Null
55 :     | selStrInfo (Info _, i) = bug "Unexpected selection from Info"
56 :    
57 :    
58 :     fun match i { inl_prim, inl_str, inl_no } =
59 :     case i
60 :     of Info x => inl_prim x
61 :     | List l => inl_str l
62 :     | Null => inl_no ()
63 :    
64 :     fun prInfo i = let
65 :     fun loop (i, acc) =
66 :     case i
67 :     of Info (p,_) => PrimOp.prPrimop p :: acc
68 :     | Null => "<InlNo>" :: acc
69 :     | List m =>
70 :     (case m
71 :     of [] => "{}" :: acc
72 :     | h::t =>
73 :     "{" :: loop (h,foldr (fn (x, a) => "," :: loop (x, a))
74 :     ("}" :: acc)
75 :     t))
76 :     in
77 :     concat (loop (i, []))
78 :     end
79 :    
80 :     fun isPrimCallcc (Info ((PrimOp.CALLCC | PrimOp.CAPTURE), _)) = true
81 :     | isPrimCallcc _ = false
82 :    
83 :     fun isPrimCast (Info (PrimOp.CAST, _)) = true
84 :     | isPrimCast _ = false
85 :    
86 :     val mkPrimInfo = Info
87 :     val mkStrInfo = List
88 :     val nullInfo = Null
89 :    
90 :     fun primopTy (Info (_, ty)) = SOME ty
91 :     | primopTy _ = NONE
92 :     *)
93 :     end (* structure InlInfo *)

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