Return to prim.sml CVS log

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

Annotation of researchv10no/cmd/sml/src/env/prim.sml, revision 1.1

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.