Mercurial > urweb

comparison src/compiler.sml @ 1146:7fdea74b1dd9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fixes for rooted modules
author Adam Chlipala <adamc@hcoop.net>
date Thu, 04 Feb 2010 16:29:09 -0500
parents d4cd54a4ea06
children de48dc2c9ee8
comparison
equal deleted inserted replaced
1145:6249df767d4c 1146:7fdea74b1dd9
728 [] => (ErrorMsg.error "Empty module path"; 728 [] => (ErrorMsg.error "Empty module path";
729 (Source.DStyle "Boo", loc)) 729 (Source.DStyle "Boo", loc))
730 | [_] => d 730 | [_] => d
731 | piece :: pieces => 731 | piece :: pieces =>
732 let 732 let
733 val this = prefix ^ "." ^ piece 733 val this = case prefix of
734 "" => piece
735 | _ => prefix ^ "." ^ piece
734 val old = SS.member (!defed, this) 736 val old = SS.member (!defed, this)
737
738 fun notThere (ch, s) =
739 Substring.isEmpty (#2 (Substring.splitl
740 (fn ch' => ch' <> ch) s))
741
742 fun simOpen () =
743 SS.foldl (fn (full, ds) =>
744 if String.isPrefix (this ^ ".") full
745 andalso notThere (#".",
746 Substring.extract (full,
747 size
748 this + 1,
749 NONE)) then
750 let
751 val parts = String.tokens
752 (fn ch => ch = #".") full
753
754 val part = List.last parts
755
756 val imp = if length parts >= 2 then
757 (Source.StrProj
758 ((Source.StrVar
759 (List.nth (parts,
760 length
761 parts
762 - 2)),
763 loc),
764 part), loc)
765 else
766 (Source.StrVar part, loc)
767 in
768 (Source.DStr (part, NONE, imp),
769 loc) :: ds
770 end
771 else
772 ds) [] (!fulls)
735 in 773 in
736 defed := SS.add (!defed, this); 774 defed := SS.add (!defed, this);
737 (Source.DStr (piece, NONE, 775 (Source.DStr (piece, NONE,
738 (Source.StrConst (if old then 776 (Source.StrConst (if old then
739 [(Source.DOpen (piece, []), 777 simOpen ()
740 loc), 778 @ [makeD this pieces]
741 makeD prefix pieces]
742 else 779 else
743 [makeD prefix pieces]), loc)), 780 [makeD this pieces]), loc)),
744 loc) 781 loc)
745 end 782 end
746 in 783 in
747 if SS.member (!fulls, full) then 784 if SS.member (!fulls, full) then
748 ErrorMsg.error ("Rooted module " ^ full ^ " has multiple versions.") 785 ErrorMsg.error ("Rooted module " ^ full ^ " has multiple versions.")
749 else 786 else
750 (); 787 ();
751 fulls := SS.add (!fulls, full); 788
752
753 makeD "" pieces 789 makeD "" pieces
790 before ignore (foldl (fn (new, path) =>
791 let
792 val new' = case path of
793 "" => new
794 | _ => path ^ "." ^ new
795 in
796 fulls := SS.add (!fulls, new');
797 new'
798 end) "" pieces)
754 end 799 end
755 in 800 in
756 checkErrors (); 801 checkErrors ();
757 d 802 d
758 end 803 end