Mercurial > urweb

comparison src/compiler.sml @ 1090:e77079953308

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Module roots
author Adam Chlipala <adamc@hcoop.net>
date Thu, 24 Dec 2009 16:35:09 -0500
parents f1647f16097d
children 6f4b05fc4361
comparison
equal deleted inserted replaced
1089:f1647f16097d 1090:e77079953308
641 } 641 }
642 642
643 fun capitalize "" = "" 643 fun capitalize "" = ""
644 | capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE) 644 | capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
645 645
646 structure SM = BinaryMapFn(struct
647 type ord_key = string
648 val compare = String.compare
649 end)
650
651 val moduleRoots = ref ([] : (string * string) list)
652 fun addModuleRoot (k, v) = moduleRoots := (k, v) :: !moduleRoots
653
654 structure SS = BinarySetFn(struct
655 type ord_key = string
656 val compare = String.compare
657 end)
658
646 val parse = { 659 val parse = {
647 func = fn {database, sources = fnames, ffi, ...} : job => 660 func = fn {database, sources = fnames, ffi, ...} : job =>
648 let 661 let
662 val mrs = !moduleRoots
663
649 val anyErrors = ref false 664 val anyErrors = ref false
650 fun checkErrors () = anyErrors := (!anyErrors orelse ErrorMsg.anyErrors ()) 665 fun checkErrors () = anyErrors := (!anyErrors orelse ErrorMsg.anyErrors ())
651 fun nameOf fname = capitalize (OS.Path.file fname) 666 fun nameOf fname = capitalize (OS.Path.file fname)
652 667
653 fun parseFfi fname = 668 fun parseFfi fname =
662 val sgn = (Source.SgnConst (#func parseUrs urs), loc) 677 val sgn = (Source.SgnConst (#func parseUrs urs), loc)
663 in 678 in
664 checkErrors (); 679 checkErrors ();
665 (Source.DFfiStr (mname, sgn), loc) 680 (Source.DFfiStr (mname, sgn), loc)
666 end 681 end
682
683 val defed = ref SS.empty
667 684
668 fun parseOne fname = 685 fun parseOne fname =
669 let 686 let
670 val mname = nameOf fname 687 val mname = nameOf fname
671 val ur = OS.Path.joinBaseExt {base = fname, ext = SOME "ur"} 688 val ur = OS.Path.joinBaseExt {base = fname, ext = SOME "ur"}
684 val loc = {file = ur, 701 val loc = {file = ur,
685 first = ErrorMsg.dummyPos, 702 first = ErrorMsg.dummyPos,
686 last = ErrorMsg.dummyPos} 703 last = ErrorMsg.dummyPos}
687 704
688 val ds = #func parseUr ur 705 val ds = #func parseUr ur
706 val d = (Source.DStr (mname, sgnO, (Source.StrConst ds, loc)), loc)
707
708 val d = case List.find (fn (root, name) =>
709 String.isPrefix (root ^ "/") fname) mrs of
710 NONE => d
711 | SOME (root, name) =>
712 let
713 val fname = String.extract (fname, size root + 1, NONE)
714 val pieces = name :: String.tokens (fn ch => ch = #"/") fname
715 val pieces = List.filter (fn s => size s > 0
716 andalso Char.isAlpha (String.sub (s, 0)))
717 pieces
718 val pieces = map capitalize pieces
719
720 fun makeD prefix pieces =
721 case pieces of
722 [] => (ErrorMsg.error "Empty module path";
723 (Source.DStyle "Boo", loc))
724 | [_] => d
725 | piece :: pieces =>
726 let
727 val this = prefix ^ "." ^ piece
728 val old = SS.member (!defed, this)
729 in
730 defed := SS.add (!defed, this);
731 (Source.DStr (piece, NONE,
732 (Source.StrConst (if old then
733 [(Source.DOpen (piece, []),
734 loc),
735 makeD prefix pieces]
736 else
737 [makeD prefix pieces]), loc)),
738 loc)
739 end
740 in
741 makeD "" pieces
742 end
689 in 743 in
690 checkErrors (); 744 checkErrors ();
691 (Source.DStr (mname, sgnO, (Source.StrConst ds, loc)), loc) 745 d
692 end 746 end
693 747
694 val dsFfi = map parseFfi ffi 748 val dsFfi = map parseFfi ffi
695 val ds = map parseOne fnames 749 val ds = map parseOne fnames
750 val loc = ErrorMsg.dummySpan
696 in 751 in
697 if !anyErrors then 752 if !anyErrors then
698 ErrorMsg.error "Parse failure" 753 ErrorMsg.error "Parse failure"
699 else 754 else
700 (); 755 ();
701 756
702 let 757 let
703 val final = nameOf (List.last fnames) 758 val final = nameOf (List.last fnames)
704 759
705 val ds = dsFfi @ ds 760 val ds = dsFfi @ ds
706 @ [(Source.DExport (Source.StrVar final, ErrorMsg.dummySpan), ErrorMsg.dummySpan)] 761 @ [(Source.DExport (Source.StrVar final, loc), loc)]
762
763 val ds = case database of
764 NONE => ds
765 | SOME s => (Source.DDatabase s, loc) :: ds
707 in 766 in
708 case database of 767 ds
709 NONE => ds
710 | SOME s => (Source.DDatabase s, ErrorMsg.dummySpan) :: ds
711 end handle Empty => ds 768 end handle Empty => ds
712 end, 769 end,
713 print = SourcePrint.p_file 770 print = SourcePrint.p_file
714 } 771 }
715 772