![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to prim.sml CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / sml / src / env|
Return to prim.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / env |
1.1 root 1: (* Copyright 1989 by AT&T Bell Laboratories *)
2: structure Prim : sig structure Access : ACCESS
3: structure Basics : BASICS
4: val primTypes : Basics.Structure
5: val inLine : Basics.Structure
6: val inLineName : Access.primop -> string
7: val pure : Access.primop -> bool
8: val special : Access.access -> bool
9: end =
10: struct
11:
12: structure Access = Access
13: structure Basics = Basics
14:
15: open Access Basics BasicTypes Env NameSpace
16:
17: val symbol = Symbol.symbol
18:
19: (* primTypes structure *)
20:
21: val typesTable = newTable()
22:
23: fun entercon(s: string, c: datacon) =
24: IntStrMap.add typesTable
25: (varIndex(symbol s),s,CONbind c)
26:
27: fun entertyc(s : string, t : tycon ref) =
28: IntStrMap.add typesTable
29: (tycIndex(symbol s),s,TYCbind t) (* *)
30:
31: val primTypes = (
32: entertyc("bool", boolTycon);
33: entercon("true", trueDcon);
34: entercon("false", falseDcon);
35:
36: entertyc("list", listTycon);
37: entercon("::", consDcon);
38: IntStrMap.add typesTable
39: (fixIndex(symbol "::"),
40: "::",FIXbind(FIXvar{name=symbol "::",binding=infixright 5}));
41: entercon("nil", nilDcon);
42:
43: entertyc("ref", refTycon);
44: entercon("ref", refDcon);
45:
46: entertyc("unit", unitTycon);
47: entertyc("int", intTycon);
48: entertyc("real", realTycon);
49: entertyc("cont", contTycon);
50: entertyc("array", arrayTycon);
51: entertyc("string", stringTycon);
52:
53: entertyc("exn",exnTycon);
54:
55: mkSTR([symbol "PrimTypes"], typesTable, DIR, Stampset.globalStamps))
56:
57:
58: (* inLine structure *)
59:
60: val inLineTable = newTable()
61:
62: val bottom = POLYty{sign=[{weakness=infinity,eq=false}],
63: tyfun=TYFUN{arity=1,body=VARty(mkTyvar(IBOUND 0))}}
64:
65: val primopNames = [
66: ("callcc",P.callcc),
67: ("throw",P.throw),
68: ("delay",P.delay),
69: ("force",P.force),
70: ("!",P.!),
71: ("*",P.*),
72: ("+",P.+),
73: ("-",P.-),
74: (":=",P.:=),
75: ("<",P.<),
76: ("<=",P.<=),
77: (">",P.>),
78: (">=",P.>=),
79: ("alength",P.alength),
80: ("boxed",P.boxed),
81: ("div",P.div),
82: ("orb",P.orb),
83: ("andb",P.andb),
84: ("xorb",P.xorb),
85: ("lshift",P.lshift),
86: ("rshift",P.rshift),
87: ("notb",P.notb),
88: ("cast",P.cast),
89: ("=",P.eql),
90: ("fadd",P.fadd),
91: ("fdiv",P.fdiv),
92: ("feql",P.feql),
93: ("fge",P.fge),
94: ("fgt",P.fgt),
95: ("fle",P.fle),
96: ("flt",P.flt),
97: ("fmul",P.fmul),
98: ("fneg",P.fneg),
99: ("fneq",P.fneq),
100: ("fsub",P.fsub),
101: ("gethdlr",P.gethdlr),
102: ("ieql",P.ieql),
103: ("ineq",P.ineq),
104: ("<>",P.neq),
105: ("makeref",P.makeref),
106: ("ordof",P.ordof),
107: ("profile",P.profile),
108: ("sethdlr",P.sethdlr),
109: ("slength",P.slength),
110: ("store",P.store),
111: ("subscript",P.subscript),
112: ("unboxedassign",P.unboxedassign),
113: ("unboxedupdate",P.unboxedupdate),
114: ("update",P.update),
115: ("~",P.~) ]
116:
117: fun enter( s : string, p : primop ) =
118: let val name = symbol s
119: in IntStrMap.add inLineTable
120: (varIndex name,
121: s,VARbind(VALvar{access=INLINE p,
122: name=[name],typ=ref bottom}))
123: end
124:
125: val inLine =
126: (app enter primopNames;
127: mkSTR([symbol "InLine"], inLineTable, DIR, Stampset.globalStamps))
128:
129: fun inLineName p =
130: let fun find [] = ErrorMsg.impossible "Bad primop name"
131: | find ((s,p1)::rest) = if p1=p then s else find rest
132: in find primopNames
133: end
134:
135: val pure =
136: fn P.:= => false
137: | P.! => false (****)
138: | P.subscript => false (****)
139: | P.store => false
140: | P.unboxedassign => false
141: | P.unboxedupdate => false
142: | P.update => false
143: | P.callcc => false
144: | P.~ => false (* these must be here because they may raise *)
145: | P.+ => false
146: | P.- => false
147: | P.* => false
148: | P.div => false
149: | P.fneg => false
150: | P.fadd => false
151: | P.fsub => false
152: | P.fmul => false
153: | P.fdiv => false
154: | P.lshift => false
155: | P.force => false
156: | _ => true
157:
158: fun special(INLINE P.eql) = true
159: | special(INLINE P.neq) = true
160: | special(INLINE P.:=) = true
161: | special(INLINE P.update) = true
162: | special _ = false
163:
164: end (* structure Prim *)
165:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.