7b4fb2a · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Constructors don't need completely independent tags

7b4fb2aEdwin Brady14 years ago

src/IRTS/Compiler.hs+2−2

@@ -34,7 +34,7 @@ compile target f tm

34 hdrs <- getHdrs

35 let defs = defsIn ++ [(MN 0 "runMain", maindef)]

36 -- iputStrLn $ showSep "\n" (map show defs)

37− let (nexttag, tagged) = addTags 0 (liftAll defs)

37+ let (nexttag, tagged) = addTags 65536 (liftAll defs)

38 let ctxtIn = addAlist tagged emptyContext

39 let defuns = defunctionalise nexttag ctxtIn

40 -- iputStrLn $ showSep "\n" (map show (toAlist defuns))

@@ -100,7 +100,7 @@ mkLDecl n (Function tm _) = do e <- ir tm

100 return (declArgs [] n e)

101mkLDecl n (CaseOp _ _ pats _ _ args sc) = do e <- ir (args, sc)

102 return (declArgs [] n e)

103−mkLDecl n (TyDecl (DCon t a) _) = return $ LConstructor n (-1) a

103+mkLDecl n (TyDecl (DCon t a) _) = return $ LConstructor n t a

104mkLDecl n (TyDecl (TCon t a) _) = return $ LConstructor n (-1) a

105mkLDecl n _ = return (LFun n [] (LError ("Impossible declaration " ++ show n)))

106

src/IRTS/Lang.hs+3−1

@@ -60,8 +60,10 @@ type LDefs = Ctxt LDecl

61addTags :: Int -> [(Name, LDecl)] -> (Int, [(Name, LDecl)])

62addTags i ds = tag i ds []

63− where tag i ((n, LConstructor n' t a) : as) acc

63+ where tag i ((n, LConstructor n' (-1) a) : as) acc

64 = tag (i + 1) as ((n, LConstructor n' i a) : acc)

65+ tag i ((n, LConstructor n' t a) : as) acc

66+ = tag i as ((n, LConstructor n' t a) : acc)

65 tag i (x : as) acc = tag i as (x : acc)

67 tag i (x : as) acc = tag i as (x : acc)

66 tag i [] acc = (i, reverse acc)

68 tag i [] acc = (i, reverse acc)