dunham/newt
1
0
Fork 0
Code Issues Pull Requests Actions 1 Packages Projects Releases Wiki Activity

also drop singleton cases for lit / default

Browse Source
This commit is contained in:
Steve Dunham
2026-03-19 22:08:23 -07:00
parent cfdddbb002
commit f3f9d737cf
3 changed files with 6 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
src/Lib/CompileJS.newt
View File

@@ -313,6 +313,8 @@ termToJS {e} env (CCase t alts) f =
maybeCaseStmt env sc (CDefAlt u :: Nil) = (termToJS env u f) maybeCaseStmt env sc (CDefAlt u :: Nil) = (termToJS env u f)
-- If there is a single alt, assume it matched -- 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 ((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 _ _ :: _) = maybeCaseStmt env sc alts@(CLitAlt _ _ :: _) =
(JCase sc (map (termToJSAlt env sc) alts)) (JCase sc (map (termToJSAlt env sc) alts))
maybeCaseStmt env sc alts = case alts of maybeCaseStmt env sc alts = case alts of

2
src/Lib/CompileScheme.newt
View File

@@ -170,6 +170,8 @@ cexpToScm env (CCase sc alts) = do
(CLitAlt _ _ :: _) => fatalError "lit alt after nil" (CLitAlt _ _ :: _) => fatalError "lit alt after nil"
_ => fatalError "too many alts after cons" _ => fatalError "too many alts after cons"
doCase nm (CConAlt tag cname _ args qs body :: Nil) = conAlt env nm Lin args body 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@(CLitAlt _ _ :: _) = "(case \{nm} \{joinBy " " $ map (doAlt nm) alts})"
-- --
doCase nm alts = "(case (vector-ref \{cexpToScm env sc} 0) \{joinBy " " $ map (doAlt nm) alts})" doCase nm alts = "(case (vector-ref \{cexpToScm env sc} 0) \{joinBy " " $ map (doAlt nm) alts})"

2
src/Lib/ProcessModule.newt
View File

@@ -186,5 +186,7 @@ invalidateModule modname = do
go : SortedMap String (List String) → List String → SortedMap String ModContext → SortedMap String ModContext go : SortedMap String (List String) → List String → SortedMap String ModContext → SortedMap String ModContext
go deps Nil mods = mods go deps Nil mods = mods
go deps (name :: names) 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 let ds = fromMaybe Nil $ lookupMap' name deps in
go deps (ds ++ names) (deleteMap name mods) go deps (ds ++ names) (deleteMap name mods)