Skip to content

Commit 0adbf44

Browse files
committed
feat: enable match to handle direct recursion
We need to indirect implicitly casted pointers to structs back to their values in order for match to work similarly for recursive types as it does for non-recursive types.
1 parent c01106b commit 0adbf44

File tree

1 file changed

+23
-11
lines changed

1 file changed

+23
-11
lines changed

src/Emit.hs

Lines changed: 23 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -384,17 +384,29 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
384384
emitCaseMatcher :: (String, String) -> String -> XObj -> Integer -> State EmitterState ()
385385
emitCaseMatcher (periodOrArrow, ampersandOrNot) caseName (XObj (Sym path _) _ t) index =
386386
let Just tt = t
387-
in appendToSrc
388-
( addIndent indent' ++ tyToCLambdaFix tt ++ " " ++ pathToC path ++ " = "
389-
++ ampersandOrNot
390-
++ tempVarToAvoidClash
391-
++ periodOrArrow
392-
++ "u."
393-
++ mangle caseName
394-
++ ".member"
395-
++ show index
396-
++ ";\n"
397-
)
387+
in if tt == exprTy
388+
then appendToSrc
389+
( addIndent indent' ++ tyToCLambdaFix tt ++ " " ++ pathToC path ++ " = "
390+
++ "*"
391+
++ tempVarToAvoidClash
392+
++ periodOrArrow
393+
++ "u."
394+
++ mangle caseName
395+
++ ".member"
396+
++ show index
397+
++ ";\n"
398+
)
399+
else appendToSrc
400+
( addIndent indent' ++ tyToCLambdaFix tt ++ " " ++ pathToC path ++ " = "
401+
++ ampersandOrNot
402+
++ tempVarToAvoidClash
403+
++ periodOrArrow
404+
++ "u."
405+
++ mangle caseName
406+
++ ".member"
407+
++ show index
408+
++ ";\n"
409+
)
398410
emitCaseMatcher periodOrArrow caseName (XObj (Lst (XObj (Sym (SymPath _ innerCaseName) _) _ _ : xs)) _ _) index =
399411
zipWithM_ (\x i -> emitCaseMatcher periodOrArrow (caseName ++ ".member" ++ show i ++ ".u." ++ removeSuffix innerCaseName) x index) xs ([0 ..] :: [Int])
400412
emitCaseMatcher _ _ xobj _ =

0 commit comments

Comments
 (0)