Mercurial > urweb

comparison src/mono_util.sml @ 1845:c1e3805e604e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Make Scriptcheck catch more script/message-passing uses, and move the phase earlier in compilation
author Adam Chlipala <adam@chlipala.net>
date Fri, 15 Mar 2013 16:09:55 -0400
parents 38297294cf98
children 8958b580d026
comparison
equal deleted inserted replaced
1844:2c5e6f78560c 1845:c1e3805e604e
662 662
663 fun mapfoldB (all as {bind, ...}) = 663 fun mapfoldB (all as {bind, ...}) =
664 let 664 let
665 val mfd = Decl.mapfoldB all 665 val mfd = Decl.mapfoldB all
666 666
667 fun mff ctx ds = 667 fun mff ctx (ds, ps) =
668 case ds of 668 case ds of
669 nil => S.return2 nil 669 nil => S.return2 (nil, ps)
670 | d :: ds' => 670 | d :: ds' =>
671 S.bind2 (mfd ctx d, 671 S.bind2 (mfd ctx d,
672 fn d' => 672 fn d' =>
673 let 673 let
674 val ctx' = 674 val ctx' =
703 | DStyle _ => ctx 703 | DStyle _ => ctx
704 | DTask _ => ctx 704 | DTask _ => ctx
705 | DPolicy _ => ctx 705 | DPolicy _ => ctx
706 | DOnError _ => ctx 706 | DOnError _ => ctx
707 in 707 in
708 S.map2 (mff ctx' ds', 708 S.map2 (mff ctx' (ds', ps),
709 fn ds' => 709 fn (ds', _) =>
710 d' :: ds') 710 (d' :: ds', ps))
711 end) 711 end)
712 in 712 in
713 mff 713 mff
714 end 714 end
715 715
739 exp = fn e => fn s => S.Continue (e, exp (e, s)), 739 exp = fn e => fn s => S.Continue (e, exp (e, s)),
740 decl = fn d => fn s => S.Continue (d, decl (d, s))} d s of 740 decl = fn d => fn s => S.Continue (d, decl (d, s))} d s of
741 S.Continue (_, s) => s 741 S.Continue (_, s) => s
742 | S.Return _ => raise Fail "MonoUtil.File.fold: Impossible" 742 | S.Return _ => raise Fail "MonoUtil.File.fold: Impossible"
743 743
744 val maxName = foldl (fn ((d, _) : decl, count) => 744 fun maxName (f : file) =
745 case d of 745 foldl (fn ((d, _) : decl, count) =>
746 DDatatype dts => 746 case d of
747 foldl (fn ((_, n, ns), count) => 747 DDatatype dts =>
748 foldl (fn ((_, n', _), m) => Int.max (n', m)) 748 foldl (fn ((_, n, ns), count) =>
749 (Int.max (n, count)) ns) count dts 749 foldl (fn ((_, n', _), m) => Int.max (n', m))
750 | DVal (_, n, _, _, _) => Int.max (n, count) 750 (Int.max (n, count)) ns) count dts
751 | DValRec vis => foldl (fn ((_, n, _, _, _), count) => Int.max (n, count)) count vis 751 | DVal (_, n, _, _, _) => Int.max (n, count)
752 | DExport _ => count 752 | DValRec vis => foldl (fn ((_, n, _, _, _), count) => Int.max (n, count)) count vis
753 | DTable _ => count 753 | DExport _ => count
754 | DSequence _ => count 754 | DTable _ => count
755 | DView _ => count 755 | DSequence _ => count
756 | DDatabase _ => count 756 | DView _ => count
757 | DJavaScript _ => count 757 | DDatabase _ => count
758 | DCookie _ => count 758 | DJavaScript _ => count
759 | DStyle _ => count 759 | DCookie _ => count
760 | DTask _ => count 760 | DStyle _ => count
761 | DPolicy _ => count 761 | DTask _ => count
762 | DOnError _ => count) 0 762 | DPolicy _ => count
763 763 | DOnError _ => count) 0 (#1 f)
764 fun appLoc f = 764
765 fun appLoc f (fl : file) =
765 let 766 let
766 val eal = Exp.appLoc f 767 val eal = Exp.appLoc f
767 768
768 fun appl (d : decl) = 769 fun appl (d : decl) =
769 case #1 d of 770 case #1 d of
788 | PolInsert e1 => eal e1 789 | PolInsert e1 => eal e1
789 | PolDelete e1 => eal e1 790 | PolDelete e1 => eal e1
790 | PolUpdate e1 => eal e1 791 | PolUpdate e1 => eal e1
791 | PolSequence e1 => eal e1 792 | PolSequence e1 => eal e1
792 in 793 in
793 app appl 794 app appl (#1 fl)
794 end 795 end
795 796
796 end 797 end
797 798
798 end 799 end