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/trunk/src/compiler/FLINT/opt/fixfix.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/FLINT/opt/fixfix.sml

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

revision 160, Mon Oct 12 03:31:38 1998 UTC revision 162, Tue Oct 27 22:16:21 1998 UTC
# Line 40  Line 40 
40    
41  val cplv = LambdaVar.dupLvar  val cplv = LambdaVar.dupLvar
42    
43    (* to limit the amount of uncurrying *)
44    val maxargs = Control.FLINT.maxargs
45    
46  structure SccNode = struct  structure SccNode = struct
47      type node = LambdaVar.lvar      type node = LambdaVar.lvar
48      val eq = (op =)      val eq = (op =)
# Line 72  Line 75 
75      fun fdcon (fv,(s,Access.EXN(Access.LVAR lv),lty)) = addv(fv, F.VAR lv)      fun fdcon (fv,(s,Access.EXN(Access.LVAR lv),lty)) = addv(fv, F.VAR lv)
76        | fdcon (fv,_) = fv        | fdcon (fv,_) = fv
77    
78      (* recognize the curried essence of a function. *)      (* recognize the curried essence of a function.
79      fun curry (head,r) (le as (F.FIX([(fk,f,args,body)], F.RET[F.VAR lv]))) =       * - hd:bool identifies the head of the (potentially) curried function
80         * - r:bool indicates whether the head was recursive
81         * - na:int gives the number of args still allowed *)
82        fun curry (hd,r,na) (le as (F.FIX([(fk,f,args,body)], F.RET[F.VAR lv]))) =
83          if lv = f then          if lv = f then
84              case fk              case fk
85               of F.FK_FCT => ([], le)    (* don't bother *)               of F.FK_FCT => ([], le)    (* don't bother *)
86                | F.FK_FUN {inline=true,...} => ([], le) (* don't bother *)                | F.FK_FUN {inline=true,...} => ([], le) (* don't bother *)
87                | F.FK_FUN fk' =>                | F.FK_FUN fk' =>
88                  let val fisrec = isSome(#isrec fk')                  let val fisrec = isSome(#isrec fk')
89                  in if head orelse r orelse not fisrec then                      val na = na - length args
90                    in if na >= 0 andalso (hd orelse r orelse not fisrec) then
91                      (* recursive functions are only accepted for uncurrying                      (* recursive functions are only accepted for uncurrying
92                       * if they are the head of the function or if the head                       * if they are the head of the function or if the head
93                       * is already recursive *)                       * is already recursive *)
94                      let val (funs,body) = curry (false, r orelse fisrec) body                      let val (funs,body) =
95                                curry (false, r orelse fisrec, na) body
96                      in ((fk,f,args)::funs,body)                      in ((fk,f,args)::funs,body)
97                      end                      end
98                     else ([], le)                     else ([], le)
# Line 212  Line 220 
220    
221             (* process each fun *)             (* process each fun *)
222             fun ffun (fdec as (fk,f,args,body):F.fundec,(s,fv,funs,m)) =             fun ffun (fdec as (fk,f,args,body):F.fundec,(s,fv,funs,m)) =
223                 case curry (true,false) (F.FIX([fdec], F.RET[F.VAR f]))                 case curry (true,false,!maxargs) (F.FIX([fdec], F.RET[F.VAR f]))
224                  of (args as _::_::_,body) => (* curried function *)                  of (args as _::_::_,body) => (* curried function *)
225                     let val ((fk,f,fargs,fbody),(fk',f',fargs',fbody')) =                     let val ((fk,f,fargs,fbody),(fk',f',fargs',fbody')) =
226                             uncurry(args,body)                             uncurry(args,body)

Legend:
Removed from v.160  
changed lines
  Added in v.162

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