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

streamline generated code a little

Browse Source
This commit is contained in:
Steve Dunham
2026-03-16 21:56:03 -07:00
parent fe96f46534
commit 4ce5d470ba
2 changed files with 7 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
src/Lib/CompileJS.newt
View File

@@ -309,6 +309,8 @@ termToJS {e} env (CCase t alts) f =
getArgs (CConAlt _ _ _ args _) = args getArgs (CConAlt _ _ _ args _) = args
maybeCaseStmt : JSEnv -> JSExp -> List CAlt -> JSStmt e maybeCaseStmt : JSEnv -> JSExp -> List CAlt -> JSStmt e
-- deleteT23 does this...
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 u) :: Nil) = (termToJS (conAltEnv sc 0 env args) u f) maybeCaseStmt env sc ((CConAlt _ _ info args u) :: Nil) = (termToJS (conAltEnv sc 0 env args) u f)
maybeCaseStmt env sc alts@(CLitAlt _ _ :: _) = maybeCaseStmt env sc alts@(CLitAlt _ _ :: _) =

7
src/Lib/CompileScheme.newt
View File

@@ -65,8 +65,8 @@ scmName qn = scmIdent $ show qn
cexpToScm : SCEnv → CExp → String cexpToScm : SCEnv → CExp → String
withVar : SCEnv → CExp → (String → String) → String withVar : SCEnv → CExp → (String → String) → String
-- withVar env (CBnd _) f = ? -- don't rebind a variable
-- withVar env (CLit _) f = ? withVar env (CBnd n) f = f $ getEnv n env
withVar env t f = let nm = "wv$\{show $ length' env}" withVar env t f = let nm = "wv$\{show $ length' env}"
in "(let ((\{nm} \{cexpToScm env t})) \{f nm})" in "(let ((\{nm} \{cexpToScm env t})) \{f nm})"
@@ -123,6 +123,9 @@ cexpToScm env (CCase sc alts) = do
doAlt nm (CLitAlt lit body) = "((\{scmLit lit}) \{cexpToScm env body})" doAlt nm (CLitAlt lit body) = "((\{scmLit lit}) \{cexpToScm env body})"
doCase : String → List CAlt → String doCase : String → List CAlt → String
-- I'm not sure the case tree should be generating this, c.f. deleteT23
doCase nm (CDefAlt body :: Nil) = cexpToScm env body
doCase nm (CConAlt tag cname _ args body :: Nil) = conAlt env nm Lin args 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})"