Return to basics.sml CVS log

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

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

1.1     ! root        1: (* Copyright 1989 by AT&T Bell Laboratories *)
        !             2: (* basics.sml *)
        !             3: 
        !             4: (* basic datatypes *)
        !             5: 
        !             6: structure Basics : BASICS = struct
        !             7: 
        !             8:   structure Symbol = Symbol
        !             9:   structure Access = Access
        !            10:   structure IntStrMap = IntStrMap
        !            11:   structure Stampset = Stampset
        !            12: 
        !            13:   open Symbol Access PrintUtil
        !            14: 
        !            15:     type spath = symbol list
        !            16:     type label = symbol
        !            17:     type stamp = int
        !            18:     type polysign = {weakness: int, eq: bool} list
        !            19:     type sharespec = {s: (spath*spath) list,
        !            20:                      t: (spath*spath) list}
        !            21: 
        !            22:     datatype bool3 = YES | NO | MAYBE
        !            23: 
        !            24:   (* fixity attributes *)
        !            25: 
        !            26:     datatype fixity = NONfix | INfix of (int*int)
        !            27: 
        !            28:     datatype conrep
        !            29:       = UNDECIDED 
        !            30:       | TAGGED of int 
        !            31:       | CONSTANT of int 
        !            32:       | TRANSPARENT 
        !            33:       | TRANSU
        !            34:       | TRANSB
        !            35:       | REF
        !            36:       | VARIABLE of access (* exception constructor *)
        !            37: 
        !            38:     val infinity = 10000000
        !            39: 
        !            40:     datatype tvkind
        !            41:       = IBOUND of int   (* inferred bound type variables -- indexed *)
        !            42:       | META of                 (* metavariables -- depth = infinity for metaargs *)
        !            43:          {depth: int,
        !            44:           weakness: int,
        !            45:           eq: bool}
        !            46:       | INSTANTIATED of ty
        !            47:       | UBOUND of  (* user bound type variables -- user name*)
        !            48:          {name: symbol,
        !            49:           weakness: int,
        !            50:           eq: bool}
        !            51: 
        !            52:     and datacon  (* exceptions are a special case with rep=VARIABLE() *)
        !            53:       = DATACON of
        !            54:          {name  : symbol,
        !            55:           const : bool,
        !            56:           typ   : ty ref,
        !            57:           rep   : conrep,
        !            58:           sign  : conrep list}
        !            59: 
        !            60:     and tyckind
        !            61:       = ABStyc (* atomic and abstract types *)
        !            62:       | DEFtyc of tyfun
        !            63:       | DATAtyc of datacon list
        !            64:       | RECORDtyc of label list
        !            65:       | UNDEFtyc of symbol list option
        !            66: 
        !            67:     and tycon
        !            68:       = TYCON of
        !            69:          {stamp : stamp,
        !            70:           arity : int,
        !            71:           eq    : bool3 ref,
        !            72:           path  : symbol list,
        !            73:           kind  : tyckind}
        !            74:       | INDtyc of int   (* indirect tycon -- only in bindings (in sigs) *)
        !            75:       | SHRtyc of int list   (* sharing indirection -- probably not used *)
        !            76:       | RELtyc of int list   (* relative tycon -- only in type expressions *)
        !            77:       | NULLtyc
        !            78: 
        !            79:     and ty 
        !            80:       = VARty of tyvar
        !            81:       | CONty of tycon ref * ty list
        !            82:       | FLEXRECORDty of rowty ref
        !            83:       | POLYty of {sign: {weakness:int, eq:bool} list, tyfun: tyfun}
        !            84:       | UNDEFty
        !            85:       | ERRORty
        !            86: 
        !            87:     and rowty
        !            88:       = OPEN of (label * ty) list
        !            89:       | CLOSED of ty
        !            90: 
        !            91:     and tyfun
        !            92:       = TYFUN of
        !            93:          {arity : int,
        !            94:           body : ty}
        !            95: 
        !            96: 
        !            97:   (* variables *)
        !            98: 
        !            99:     and var
        !           100:       = VALvar of                    (* ordinary variables *)
        !           101:          {access: access,
        !           102:           name : symbol list,
        !           103:           typ : ty ref}
        !           104:       | OVLDvar of                   (* overloaded identifier *)
        !           105:          {name : symbol,
        !           106:           options: {indicator: ty, variant: var} list ref,
        !           107:           scheme: tyfun}
        !           108:       | UNKNOWNvar of symbol      (* place holder for backpatching *)
        !           109: 
        !           110: 
        !           111:   (* structures and signatures *)
        !           112: 
        !           113:     and strenv 
        !           114:       =        DIR
        !           115:       | REL of {s: Structure array, t: tycon array}
        !           116: 
        !           117:     and strkind
        !           118:       = STRkind of
        !           119:           {path : symbol list}
        !           120:       | SIGkind of
        !           121:          {share: sharespec,
        !           122:           bindings : binding list,
        !           123:           stamps : Stampset.stampsets}
        !           124: 
        !           125:     and Structure
        !           126:       = STRstr of
        !           127:          {stamp : stamp,
        !           128:           sign  : stamp,
        !           129:           table : symtable,
        !           130:           env   : strenv,
        !           131:           kind  : strkind}
        !           132:       | INDstr of int        (* indirect substructure binding *)
        !           133:       | SHRstr of int list   (* sharing indirection *)
        !           134:       | NULLstr
        !           135: 
        !           136:     and Functor
        !           137:       = FUNCTOR of
        !           138:          {paramName: symbol,
        !           139:           param: Structure,
        !           140:           body: Structure,
        !           141:           paramVis: bool,
        !           142:           stamps: Stampset.stampsets}
        !           143: 
        !           144:     and signatureVar
        !           145:       = SIGvar of
        !           146:          {name: symbol,
        !           147:           binding: Structure}
        !           148: 
        !           149:     and structureVar
        !           150:       = STRvar of
        !           151:          {name: symbol list,
        !           152:           access: access,         
        !           153:           binding: Structure}
        !           154: 
        !           155:     and functorVar
        !           156:       = FCTvar of
        !           157:          {name: symbol,
        !           158:           access: access,         
        !           159:           binding: Functor}
        !           160: 
        !           161:     and fixityVar
        !           162:       = FIXvar of
        !           163:          {name: symbol,
        !           164:           binding: fixity}
        !           165: 
        !           166:     and binding 
        !           167:       = VARbind of var  
        !           168:       | CONbind of datacon
        !           169:       | TYCbind of tycon ref (* patchable *)
        !           170:       | TYVbind of tyvar
        !           171:       | SIGbind of signatureVar
        !           172:       | STRbind of structureVar
        !           173:       | FCTbind of functorVar
        !           174:       | FIXbind of fixityVar
        !           175: 
        !           176:     (* Note: exceptions are identified with data constructors; they
        !           177:        no longer have a separate name space, hence no EXNbind constructor.
        !           178:        On the other hand, structures and functors have separate name spaces,
        !           179:        which may not be correct. *)
        !           180: 
        !           181:     withtype tyvar = tvkind ref
        !           182:     and binder = int * string * binding
        !           183:     and symtable = binding IntStrMap.intstrmap
        !           184: 
        !           185:     datatype trans
        !           186:       = VALtrans of access     (* old position, val, exn, or unthinned str *)
        !           187:       | THINtrans of access * lvar * trans list
        !           188:            (* old str position, substr thinning *)
        !           189:       | CONtrans of datacon            (* constructor as value component *)
        !           190: 
        !           191:     type thinning = (lvar * trans list) option
        !           192: 
        !           193: 
        !           194:   (* building fixities *)
        !           195: 
        !           196:     fun infixleft n = INfix (n+n, n+n)
        !           197:     fun infixright n = INfix (n+n+1, n+n)
        !           198: 
        !           199: 
        !           200:   (* building variables *)
        !           201: 
        !           202:     fun mkVALvar(id: symbol, refty: ty ref) : var =
        !           203:        VALvar{access = LVAR(namedLvar(id)), name = [id], typ = refty}
        !           204: 
        !           205: 
        !           206:   (* building tycons, signatures, structures, and functors *)
        !           207: 
        !           208:     fun mkTyvar(kind: tvkind) : tyvar = ref kind
        !           209:     
        !           210:     fun mkABStyc(path: symbol list, arity: int, eq: bool3,
        !           211:                 {tycStamps,...}: Stampset.stampsets)
        !           212:         : tycon =
        !           213:        TYCON{stamp = Stampset.newStamp(tycStamps), path = path, arity = arity,
        !           214:              eq = ref eq, kind = ABStyc}
        !           215:     
        !           216:     fun mkDEFtyc(path: symbol list, def as TYFUN{arity,...}: tyfun, eq: bool3,
        !           217:                 {tycStamps,...}: Stampset.stampsets)
        !           218:         : tycon =
        !           219:        TYCON{stamp = Stampset.newStamp(tycStamps), path = path,
        !           220:              arity = arity, eq = ref eq, kind = DEFtyc def}
        !           221:     
        !           222:     fun mkDATAtyc(path: symbol list, arity: int, dcons: datacon list, eq: bool3,
        !           223:                 {tycStamps,...}: Stampset.stampsets)
        !           224:         : tycon =
        !           225:        TYCON{stamp = Stampset.newStamp(tycStamps), path = path,
        !           226:              arity = arity, eq = ref eq, kind = DATAtyc dcons}
        !           227:     
        !           228:     fun mkUNDEFtyc(name: symbol, arity: int) : tycon =
        !           229:        TYCON{stamp = ~1, path = [name], arity = arity, eq = ref MAYBE,
        !           230:              kind = UNDEFtyc NONE}
        !           231: 
        !           232:     fun mkSTR(path, table, env, {strStamps,...}: Stampset.stampsets) = 
        !           233:         STRstr{stamp = Stampset.newStamp(strStamps),
        !           234:                sign = 0,  (* guaranteed not to agree with any valid sig stamp *)
        !           235:               table = table,
        !           236:               env = env,
        !           237:               kind = STRkind{path=path}}
        !           238: 
        !           239: end (* structure Basics *)

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.