Mercurial > urweb

comparison src/cjr_print.sml @ 1324:d596c7002ad8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
More accurate/conservative leaky type detection in CjrPrint
author Adam Chlipala <adamc@hcoop.net>
date Sun, 28 Nov 2010 15:06:11 -0500
parents 80bff6449f41
children 4dd5d23bace2
comparison
equal deleted inserted replaced
1323:0d8bd8ae8417 1324:d596c7002ad8
523 (EPrim (Prim.String "FALSE"), _))], 523 (EPrim (Prim.String "FALSE"), _))],
524 _) => [(e, Bool)] 524 _) => [(e, Bool)]
525 525
526 | _ => raise Fail "CjrPrint: getPargs" 526 | _ => raise Fail "CjrPrint: getPargs"
527 527
528 val notLeakies = SS.fromList ["int", "float", "char", "time", "bool", "unit", "client", "channel",
529 "xhtml", "page", "xbody", "css_class"]
530 val notLeakies' = SS.fromList ["blob"]
531
528 fun notLeaky env allowHeapAllocated = 532 fun notLeaky env allowHeapAllocated =
529 let 533 let
530 fun nl ok (t, _) = 534 fun nl ok (t, _) =
531 case t of 535 case t of
532 TFun _ => false 536 TFun _ => false
546 in 550 in
547 List.all (fn (_, _, to) => case to of 551 List.all (fn (_, _, to) => case to of
548 NONE => true 552 NONE => true
549 | SOME t => nl ok' t) cons 553 | SOME t => nl ok' t) cons
550 end) 554 end)
551 | TFfi ("Basis", "string") => false 555 | TFfi ("Basis", t) => SS.member (notLeakies, t)
552 | TFfi ("Basis", "blob") => allowHeapAllocated 556 orelse (allowHeapAllocated andalso SS.member (notLeakies', t))
553 | TFfi _ => true 557 | TFfi _ => false
554 | TOption t => allowHeapAllocated andalso nl ok t 558 | TOption t => allowHeapAllocated andalso nl ok t
555 | TList (t, _) => allowHeapAllocated andalso nl ok t 559 | TList (t, _) => allowHeapAllocated andalso nl ok t
556 in 560 in
557 nl IS.empty 561 nl IS.empty
558 end 562 end