Return to absyn.sml CVS log

Up to [Research Unix] / researchv10no / cmd / sml / src / absyn

Annotation of researchv10no/cmd/sml/src/absyn/absyn.sml, revision 1.1

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.