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/basics/primopid.sml
ViewVC logotype

Annotation of /sml/trunk/compiler/ElabData/basics/primopid.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4429 - (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 : dbm 2455 (* in the front end, primops are identified by a unique primop name,
15 : dbm 2603 represented as a string. See the file DEVNOTES/Flint/primop-list
16 :     for the catalog of primop names with their types and primop specs *)
17 :    
18 : dbm 4429 datatype primId = Prim of PrimopBinding.primop_bind | NonPrim
19 : georgekuan 1954
20 : macqueen 1955 datatype strPrimElem = PrimE of primId
21 :     | StrE of strPrimInfo
22 : georgekuan 1954
23 : macqueen 1955 withtype strPrimInfo = strPrimElem list
24 : georgekuan 1954
25 : macqueen 1955 fun bug s = ErrorMsg.impossible ("PrimOpId: " ^ s)
26 :    
27 : dbm 2455 (* isPrimop : primId -> bool *)
28 : macqueen 1955 fun isPrimop (Prim _) = true
29 :     | isPrimop NonPrim = false
30 :    
31 : dbm 2455 (* Used in TopLevel/main/compile.sml to identify callcc/capture primops *)
32 : dbm 4429 fun isPrimCallcc (Prim p) =
33 :     (case PrimopBinding.defnOf p
34 :     of (PrimOp.CALLCC | PrimOp.CAPTURE) => true
35 :     | _ => false)
36 : macqueen 1955 | isPrimCallcc _ = false
37 :    
38 : dbm 2455 (* Used in ElabData/modules/moduleutil.sml to identify cast primop *)
39 : dbm 4429 fun isPrimCast (Prim p) =
40 :     (case PrimOp.defnOf p
41 :     of PrimOp.CAST => true
42 :     | _ => false)
43 : macqueen 1955 | isPrimCast _ = false
44 :    
45 : dbm 2455 (* selStrPrimId : strPrimInfo * int -> strPrimInfo *)
46 : georgekuan 1969 (* Select the prim ids for a substructure *)
47 : dbm 4429 fun selStrPrimId([], slot) = [] (* not a bug? DBM *)
48 : georgekuan 1988 | selStrPrimId(elems, slot) =
49 : georgekuan 1969 (case List.nth(elems, slot)
50 :     of StrE elems' => elems'
51 :     | PrimE _ => bug "PrimOpId.selStrPrimId: unexpected PrimE")
52 : georgekuan 1985 handle Subscript => (bug "PrimOpId.selStrPrimId Subscript")
53 : georgekuan 1959 (* This bug happens if we got a primid for a value
54 :     component when we expected a strPrimElem for a
55 :     structure *)
56 : macqueen 1955
57 : georgekuan 1969 (* Select the prim id for a value component *)
58 : dbm 4429 fun selValPrimFromStrPrim([], slot) = NonPrim (* not a bug? DBM *)
59 : georgekuan 1988 | selValPrimFromStrPrim(elems, slot) =
60 : georgekuan 2009 (case List.nth(elems, slot)
61 : georgekuan 1959 of PrimE(id) => id
62 : dbm 2455 | StrE _ =>
63 :     bug "PrimOpId.selValPrimFromStrPrim: unexpected StrE")
64 :     handle Subscript => bug "PrimOpId.selValPrimFromStrPrim Subscript"
65 :     (* This bug occurs if we got a substructure's
66 :     strPrimElem instead of an expected value component's
67 :     primId *)
68 : georgekuan 1959
69 : georgekuan 1988 fun ppPrim NonPrim = "<NonPrim>"
70 : dbm 4429 | ppPrim (Prim p) = ("<PrimE " ^ PrimOp.nameOf p ^">")
71 : georgekuan 1983
72 :     fun ppStrInfo strelems =
73 :     let fun ppElem [] = ()
74 : georgekuan 1988 | ppElem ((PrimE p)::xs) = (print (ppPrim p); ppElem xs)
75 : georgekuan 1983 | ppElem ((StrE s)::xs) = (ppStrInfo s; ppElem xs)
76 :     in (print "[ "; ppElem strelems; print " ]\n")
77 :     end
78 : georgekuan 1954
79 : dbm 2455 end (* structure PrimOpId *)

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