![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to absyn.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 / absyn|
Return to absyn.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / absyn |
1.1 root 1: (* Copyright 1989 by AT&T Bell Laboratories *)
2: structure Absyn = struct
3:
4: structure Basics = Basics
5:
6: local
7: open Access Basics BasicTypes
8: val whileSym = Symbol.symbol "while"
9: and argSym = Symbol.symbol "arg"
10: in
11:
12: open BareAbsyn
13:
14: val unitPat = RECORDpat{fields = nil, flex = false, typ = ref UNDEFty,
15: pats = ref nil}
16: val unitExp = RECORDexp nil
17:
18: val truePat = CONpat(trueDcon)
19: val trueExp = CONexp(trueDcon)
20: val falsePat = CONpat(falseDcon)
21: val falseExp = CONexp(falseDcon)
22:
23: val nilPat = CONpat(nilDcon)
24: val nilExp = CONexp(nilDcon)
25: val consPat = fn pat => APPpat(consDcon,pat)
26: val consExp = CONexp(consDcon)
27:
28: fun TUPLEexp l =
29: let fun addlabels(i,e::r) =
30: (LABEL{number=i-1, name=(Tuples.numlabel i)}, e) :: addlabels(i+1, r)
31: | addlabels(_, nil) = nil
32: in RECORDexp (addlabels(1,l))
33: end
34:
35: fun TUPLEpat l =
36: let fun addlabels(i,e::r) = (Tuples.numlabel i, e) :: addlabels(i+1, r)
37: | addlabels(_, nil) = nil
38: in RECORDpat{fields = addlabels(1,l), flex = false, typ = ref UNDEFty,
39: pats = ref nil}
40: end
41:
42: fun LISTexp l = fold (fn (e,rest) => APPexp(consExp,TUPLEexp[e,rest])) l nilExp
43:
44: fun IFexp (a,b,c) =
45: CASEexp(a, [RULE(truePat,b), RULE(falsePat,c)])
46:
47: fun ORELSEexp(a,b) =
48: IFexp(a,trueExp,b)
49:
50: fun ANDALSOexp(a,b) =
51: IFexp(a,b,falseExp)
52:
53: fun WHILEexp (a,b) =
54: let val tyref = ref UNDEFty
55: val lvar = namedLvar(whileSym)
56: val fb = VALvar{name=[whileSym],
57: access=LVAR(lvar),
58: typ=tyref}
59: val fa = VALvar{name=[whileSym],
60: access=PATH[lvar],
61: typ=tyref}
62: val id = fn x => x
63: val (markdec,markall,markend,markbody) =
64: case (a,b)
65: of (MARKexp(_,a1,a2), MARKexp(_,b1,b2)) =>
66: (fn e => MARKdec(e,a1,b2), fn e => MARKexp(e,a1,b2),
67: fn e => MARKexp(e,b2,b2), fn e => MARKexp(e,b1,b2))
68: | _ => (id,id,id,id)
69: in LETexp(
70: markdec(
71: VALRECdec[
72: RVB{var=fb,
73: exp=markall(FNexp[
74: RULE(unitPat,
75: markall(IFexp(a,
76: markbody (SEQexp[b, APPexp(markend(VARexp(ref fa)),
77: markend unitExp)]),
78: markend unitExp)))]),
79: resultty = NONE,
80: tyvars = nil}]),
81: APPexp(markall(VARexp (ref fa)), markend unitExp))
82: end
83:
84: fun LISTpat l = fold (fn (e,rest) => APPpat(consDcon, TUPLEpat[e,rest])) l nilPat
85:
86: fun FUNdec fbl =
87: let fun fb2rvb (FB {var, clauses as (CLAUSE{pats,...}::_),tyvars}) =
88: let fun getvars (hd::tl) = mkVALvar(argSym,ref UNDEFty) :: getvars tl
89: | getvars nil = nil;
90: val vars = getvars pats
91: fun not1(f,[a]) = a
92: | not1(f,l) = f l
93: fun dovar (VALvar{access=LVAR n,name,typ}) =
94: VARexp(ref(VALvar{access=PATH[n],name=name,typ=typ}))
95: | dovar _ = ErrorMsg.impossible "Absyn.FUNdec.dovar"
96:
97: fun doclause (CLAUSE{pats,exp,resultty=NONE}) =
98: RULE(not1(TUPLEpat,pats), exp)
99: | doclause (CLAUSE{pats,exp=MARKexp(exp',a,b),
100: resultty=SOME ty}) =
101: RULE(not1(TUPLEpat,pats),
102: MARKexp(CONSTRAINTexp(exp',ty),a,b))
103: | doclause (CLAUSE{pats,exp,resultty=SOME ty}) =
104: RULE(not1(TUPLEpat,pats),CONSTRAINTexp(exp,ty))
105:
106: fun last[x] = x | last (a::r) = last r
107: val mark = case (hd clauses, last clauses)
108: of (CLAUSE{exp=MARKexp(_,a,_),...},
109: CLAUSE{exp=MARKexp(_,_,b),...}) =>
110: (fn e => MARKexp(e,a,b))
111: | _ => fn e => e
112: fun makeexp [var] = FNexp(map doclause clauses)
113: | makeexp vars = fold
114: (fn (w,e) => FNexp[RULE(VARpat w,mark e)])
115: vars
116: (CASEexp(TUPLEexp(map dovar vars),
117: map doclause clauses))
118: in RVB {var=var,
119: exp=makeexp vars,
120: resultty=NONE,
121: tyvars=tyvars}
122: end
123: | fb2rvb _ = ErrorMsg.impossible "absyn.38"
124: in VALRECdec (map fb2rvb fbl)
125: end
126:
127: fun SELECTORexp id =
128: let val v = namedLvar id
129: val tyref = ref UNDEFty
130: val v1 = VALvar{name=[id],access=LVAR v, typ=tyref}
131: val v2 = VALvar{name=[id],access=PATH[v],typ=tyref}
132: in FNexp[RULE(RECORDpat{fields=[(id,VARpat v1)], flex=true,
133: typ= ref UNDEFty, pats=ref nil},
134: VARexp(ref v2))]
135: end
136:
137: end (* local open Access Basics ... *)
138: end (* structure Absyn *)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.