diff options
| -rw-r--r-- | lib/js/urweb.js | 2 | ||||
| -rw-r--r-- | src/cjr.sml | 3 | ||||
| -rw-r--r-- | src/cjr_print.sml | 11 | ||||
| -rw-r--r-- | src/compiler.sml | 36 | ||||
| -rw-r--r-- | src/elaborate.sml | 2 | ||||
| -rw-r--r-- | src/jscomp.sml | 2 | ||||
| -rw-r--r-- | src/reduce.sml | 1 | ||||
| -rw-r--r-- | tests/library.urp | 1 | ||||
| -rw-r--r-- | tests/library2.urp | 1 | ||||
| -rw-r--r-- | tests/multilib.ur | 3 | ||||
| -rw-r--r-- | tests/multilib.urp | 5 |
11 files changed, 40 insertions, 27 deletions
diff --git a/lib/js/urweb.js b/lib/js/urweb.js index ac469f20..410a0e23 100644 --- a/lib/js/urweb.js +++ b/lib/js/urweb.js @@ -1848,7 +1848,7 @@ function execP(env, p, v) { } return env; default: - whine("Unknown Ur pattern kind" + p.c); + whine("Unknown Ur pattern kind " + p.c); } } 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 diff --git a/tests/library.urp b/tests/library.urp new file mode 100644 index 00000000..1c4d6fb2 --- /dev/null +++ b/tests/library.urp @@ -0,0 +1 @@ +script /bogus.js diff --git a/tests/library2.urp b/tests/library2.urp new file mode 100644 index 00000000..17b1ad55 --- /dev/null +++ b/tests/library2.urp @@ -0,0 +1 @@ +library library diff --git a/tests/multilib.ur b/tests/multilib.ur new file mode 100644 index 00000000..52c8cb30 --- /dev/null +++ b/tests/multilib.ur @@ -0,0 +1,3 @@ +fun main () : transaction page = return <xml><body> + <button onclick={fn _ => alert "AHA!"}>CLICK ME</button> +</body></xml> diff --git a/tests/multilib.urp b/tests/multilib.urp new file mode 100644 index 00000000..b33d66e4 --- /dev/null +++ b/tests/multilib.urp @@ -0,0 +1,5 @@ +library library +library library2 +rewrite all Multilib/* + +multilib |