Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/branches/primop-branch-3/compiler/FLINT/trans/translate.sml
ViewVC logotype

Diff of /sml/branches/primop-branch-3/compiler/FLINT/trans/translate.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 2397, Wed Apr 11 14:46:59 2007 UTC revision 2398, Wed Apr 11 18:54:53 2007 UTC
# Line 7  Line 7 
7    (* Invariant: transDec always applies to a top-level absyn declaration *)    (* Invariant: transDec always applies to a top-level absyn declaration *)
8    val transDec : { rootdec: Absyn.dec,    val transDec : { rootdec: Absyn.dec,
9                     exportLvars: Access.lvar list,                     exportLvars: Access.lvar list,
10                       oldenv: StaticEnv.staticEnv,
11                     env: StaticEnv.staticEnv,                     env: StaticEnv.staticEnv,
12                     cproto_conv: string,                     cproto_conv: string,
13                     compInfo: Absyn.dec CompInfo.compInfo }                     compInfo: Absyn.dec CompInfo.compInfo }
# Line 102  Line 103 
103   ****************************************************************************)   ****************************************************************************)
104    
105  fun transDec  fun transDec
106          { rootdec, exportLvars, env, cproto_conv,          { rootdec, exportLvars, oldenv, env, cproto_conv,
107           compInfo as {errorMatch,error,...}: Absyn.dec CompInfo.compInfo } =           compInfo as {errorMatch,error,...}: Absyn.dec CompInfo.compInfo } =
108  let  let
109    
# Line 141  Line 142 
142              else toLty d (BT.-->(BT.unitTy, ty)))              else toLty d (BT.-->(BT.unitTy, ty)))
143    
144  (** the special lookup functions for the Core environment *)  (** the special lookup functions for the Core environment *)
145    (* DBM: not used -- superceded by CoreAccess *)
146  fun coreLookup(id, env) =  fun coreLookup(id, env) =
147    let val sp = SymPath.SPATH [CoreSym.coreSym, S.varSymbol id]    let val sp = SymPath.SPATH [CoreSym.coreSym, S.varSymbol id]
148        val err = fn _ => fn _ => fn _ => raise NoCore        val err = fn _ => fn _ => fn _ => raise NoCore
# Line 324  Line 326 
326  exception NoCore  exception NoCore
327    
328  fun coreExn id =  fun coreExn id =
329      (case CoreAccess.getCon' (fn () => raise NoCore) (env, id) of      (case CoreAccess.getCon' (fn () => raise NoCore) (oldenv, id) of
330           TP.DATACON { name, rep as DA.EXN _, typ, ... } =>           TP.DATACON { name, rep as DA.EXN _, typ, ... } =>
331           let val nt = toDconLty DI.top typ           let val nt = toDconLty DI.top typ
332               val nrep = mkRep(rep, nt, name)               val nrep = mkRep(rep, nt, name)
# Line 337  Line 339 
339      handle NoCore => (say "WARNING: no Core access\n"; INT 0)      handle NoCore => (say "WARNING: no Core access\n"; INT 0)
340    
341  and coreAcc id =  and coreAcc id =
342      (case CoreAccess.getVar' (fn () => raise NoCore) (env, id) of      (case CoreAccess.getVar' (fn () => raise NoCore) (oldenv, id) of
343           V.VALvar { access, typ, path, ... } =>           V.VALvar { access, typ, path, ... } =>
344           mkAccT(access, toLty DI.top (!typ), getNameOp path)           mkAccT(access, toLty DI.top (!typ), getNameOp path)
345         | _ => bug "coreAcc in translate")         | _ => bug "coreAcc in translate")
# Line 876  Line 878 
878              (* inl_infPrec ("EXTEND_INF", "finToInf", p, lt, false) *)              (* inl_infPrec ("EXTEND_INF", "finToInf", p, lt, false) *)
879              inlToInfPrec("EXTEND_INF", "finToInf", p, lt)              inlToInfPrec("EXTEND_INF", "finToInf", p, lt)
880          | g (p as PO.COPY_INF prec) =          | g (p as PO.COPY_INF prec) =
881              inlToInfPrec ("COPY", "copyInf", p, lt)              inlToInfPrec ("COPY", "finToInf", p, lt)
882          (* default handling for all other primops *)          (* default handling for all other primops *)
883          | g p = PRIM(p, lt, ts)          | g p = PRIM(p, lt, ts)
884    

Legend:
Removed from v.2397  
changed lines
  Added in v.2398

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0