Finish removing PWild; only load a library once, even if referenced multiple times in a .urp tree

6 files changed, 29 insertions, 26 deletions

diff --git a/src/cjr.sml b/src/cjr.sml
index 3742a06f..e582e6ae 100644
--- a/src/cjr.sml
+++ b/src/cjr.sml
@@ -46,8 +46,7 @@ datatype patCon =
        | PConFfi of {mod : string, datatyp : string, con : string, arg : typ option}
 
 datatype pat' =
-         PWild
-       | PVar of string * typ
+         PVar of string * typ
        | PPrim of Prim.t
        | PCon of datatype_kind * patCon * pat option
        | PRecord of (string * pat * typ) list
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index bbbe5c8b..2471ce59 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -163,9 +163,7 @@ fun p_con_named env n =
 
 fun p_pat_preamble env (p, _) =
     case p of
-        PWild => (box [],
-                  env)
-      | PVar (x, t) => (box [p_typ env t,
+        PVar (x, t) => (box [p_typ env t,
                              space,
                              string "__uwr_",
                              p_ident x,
@@ -194,8 +192,7 @@ fun p_patCon env pc =
 
 fun p_patMatch (env, disc) (p, loc) =
     case p of
-        PWild => string "1"
-      | PVar _ => string "1"
+        PVar _ => string "1"
       | PPrim (Prim.Int n) => box [string ("(" ^ disc),
                                    space,
                                    string "==",
@@ -318,9 +315,7 @@ fun p_patMatch (env, disc) (p, loc) =
 
 fun p_patBind (env, disc) (p, loc) =
     case p of
-        PWild =>
-        (box [], env)
-      | PVar (x, t) =>
+        PVar (x, t) =>
         (box [p_typ env t,
               space,
               string "__uwr_",
diff --git a/src/compiler.sml b/src/compiler.sml
index e269c8b9..7580c5e4 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2012, 2014, Adam Chlipala
+(* Copyright (c) 2008-2012, 2014, 2016, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -412,6 +412,14 @@ fun inputCommentableLine inf =
 
 val lastUrp = ref ""
 
+structure SK = struct
+type ord_key = string
+val compare = String.compare
+end
+
+structure SS = BinarySetFn(SK)
+structure SM = BinaryMapFn(SK)
+
 fun parseUrp' accLibs fname =
     (lastUrp := fname;
      if not (Posix.FileSys.access (fname ^ ".urp", []) orelse Posix.FileSys.access (fname ^ "/lib.urp", []))
@@ -459,6 +467,7 @@ fun parseUrp' accLibs fname =
          let
              val pathmap = ref (!pathmap)
              val bigLibs = ref []
+             val libSet = ref SS.empty
 
              fun pu filename =
                  let
@@ -822,10 +831,19 @@ fun parseUrp' accLibs fname =
                                               fkind := {action = Settings.Deny, kind = kind, pattern = pattern} :: !fkind
                                           end
                                         | _ => ErrorMsg.error "Bad 'deny' syntax")
-                                   | "library" => if accLibs then
-                                                      libs := pu (libify (relify arg)) :: !libs
-                                                  else
-                                                      bigLibs := libify' arg :: !bigLibs
+                                   | "library" =>
+                                     if accLibs then
+                                         let
+                                             val arg = libify (relify arg)
+                                         in
+                                             if SS.member (!libSet, arg) then
+                                                 ()
+                                             else
+                                                 (libs := pu arg :: !libs;
+                                                  libSet := SS.add (!libSet, arg))
+                                         end
+                                     else
+                                         bigLibs := libify' arg :: !bigLibs
                                    | "path" =>
                                      (case String.fields (fn ch => ch = #"=") arg of
                                           [n, v] => ((pathmap := M.insert (!pathmap, n, OS.Path.mkAbsolute {path = v, relativeTo = dir}))
@@ -936,14 +954,6 @@ fun addModuleRoot (k, v) = moduleRoots :=
                                                 relativeTo = OS.FileSys.getDir ()},
                             v) :: !moduleRoots
 
-structure SK = struct
-type ord_key = string
-val compare = String.compare
-end
-
-structure SS = BinarySetFn(SK)
-structure SM = BinaryMapFn(SK)
-
 exception MissingFile of string
 
 val parse = {
diff --git a/src/elaborate.sml b/src/elaborate.sml
index 9765b090..6965adfd 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -1565,7 +1565,7 @@ fun elabPat (pAll as (p, loc), (env, bound)) =
         case p of
             L.PVar x =>
             let
-                val t = if SS.member (bound, x) then
+                val t = if x <> "_" andalso SS.member (bound, x) then
                             (expError env (DuplicatePatternVariable (loc, x));
                              terror)
                         else
diff --git a/src/jscomp.sml b/src/jscomp.sml
index d8c83b94..65a0fa3a 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -458,7 +458,7 @@ fun process (file : file) =
 
                         fun jsPat (p, _) =
                             case p of
-                                PVar _ => str "{c:\"v\"}"
+                                PVar _ => str "{/*hoho*/c:\"v\"}"
                               | PPrim p => strcat [str "{c:\"c\",v:",
                                                    jsPrim p,
                                                    str "}"]
diff --git a/src/reduce.sml b/src/reduce.sml
index 08040ad3..04cec168 100644
--- a/src/reduce.sml
+++ b/src/reduce.sml
@@ -755,7 +755,6 @@ fun kindConAndExp (namedC, namedE) =
                             end
 
                           | ECase (_, [((PRecord [], _), e)], _) => exp env e
-                          | ECase (_, [((PWild, _), e)], _) => exp env e
 
                           | ECase (e, pes, {disc, result}) =>
                             let