summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2016-02-07 20:41:34 -0500
committerGravatar Adam Chlipala <adam@chlipala.net>2016-02-07 20:41:34 -0500
commit7b379c724999c4b415b1c3826db748450c7a6571 (patch)
tree08d7b9d994d351f9480e09f06170f3daf77e8549 /src
parent5579b84a97cb942fdfd4c4898793f9de95bc03d1 (diff)
Finish removing PWild; only load a library once, even if referenced multiple times in a .urp tree
Diffstat (limited to 'src')
-rw-r--r--src/cjr.sml3
-rw-r--r--src/cjr_print.sml11
-rw-r--r--src/compiler.sml36
-rw-r--r--src/elaborate.sml2
-rw-r--r--src/jscomp.sml2
-rw-r--r--src/reduce.sml1
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