From f3f9d737cfb986cdca8b0bff9723c5895334f971 Mon Sep 17 00:00:00 2001 From: Steve Dunham Date: Thu, 19 Mar 2026 22:08:23 -0700 Subject: [PATCH] also drop singleton cases for lit / default --- src/Lib/CompileJS.newt | 2 ++ src/Lib/CompileScheme.newt | 2 ++ src/Lib/ProcessModule.newt | 2 ++ 3 files changed, 6 insertions(+) diff --git a/src/Lib/CompileJS.newt b/src/Lib/CompileJS.newt index cc98753..618d049 100644 --- a/src/Lib/CompileJS.newt +++ b/src/Lib/CompileJS.newt @@ -313,6 +313,8 @@ termToJS {e} env (CCase t alts) f = maybeCaseStmt env sc (CDefAlt u :: Nil) = (termToJS env u f) -- If there is a single alt, assume it matched maybeCaseStmt env sc ((CConAlt _ _ info args qs u) :: Nil) = (termToJS (conAltEnv sc 0 env args) u f) + maybeCaseStmt env sc alts@(CLitAlt _ u :: Nil) = termToJS env u f + maybeCaseStmt env sc alts@(CDefAlt u :: Nil) = termToJS env u f maybeCaseStmt env sc alts@(CLitAlt _ _ :: _) = (JCase sc (map (termToJSAlt env sc) alts)) maybeCaseStmt env sc alts = case alts of diff --git a/src/Lib/CompileScheme.newt b/src/Lib/CompileScheme.newt index f94479a..3884cf0 100644 --- a/src/Lib/CompileScheme.newt +++ b/src/Lib/CompileScheme.newt @@ -170,6 +170,8 @@ cexpToScm env (CCase sc alts) = do (CLitAlt _ _ :: _) => fatalError "lit alt after nil" _ => fatalError "too many alts after cons" doCase nm (CConAlt tag cname _ args qs body :: Nil) = conAlt env nm Lin args body + doCase nm (CLitAlt _ body :: Nil) = cexpToScm env body + doCase nm (CDefAlt body :: Nil) = cexpToScm env body doCase nm alts@(CLitAlt _ _ :: _) = "(case \{nm} \{joinBy " " $ map (doAlt nm) alts})" -- doCase nm alts = "(case (vector-ref \{cexpToScm env sc} 0) \{joinBy " " $ map (doAlt nm) alts})" diff --git a/src/Lib/ProcessModule.newt b/src/Lib/ProcessModule.newt index 2684e09..c156752 100644 --- a/src/Lib/ProcessModule.newt +++ b/src/Lib/ProcessModule.newt @@ -186,5 +186,7 @@ invalidateModule modname = do go : SortedMap String (List String) → List String → SortedMap String ModContext → SortedMap String ModContext go deps Nil mods = mods go deps (name :: names) mods = + -- Have we hit this name already? + let (Just _) = lookupMap name mods | _ => go deps names mods in let ds = fromMaybe Nil $ lookupMap' name deps in go deps (ds ++ names) (deleteMap name mods)