222d151 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Always include kinds in externs files

222d151Phil Freeman12 years ago

examples/passing/Proxy.pursnew file+7

compare with golang

unifiedsplit

@@ -0,0 +1,7 @@

1+module Main (Proxy1(), Proxy2()) where

3+data Proxy1 f a = Proxy1 (f a)

5+type Proxy2 f a = f a

7+main = Debug.Trace.trace "Done"

src/Language/PureScript/TypeChecker.hs+22−8

@@ -124,14 +124,15 @@ typeCheckAll mainModuleName moduleName exps = go

124 where

125 go :: [Declaration] -> Check [Declaration]

126 go [] = return []

127− go (d@(DataDeclaration dtype name args dctors) : rest) = do

127+ go (DataDeclaration dtype name args dctors : rest) = do

128 rethrow (strMsg ("Error in type constructor " ++ show name) <>) $ do

129 when (dtype == Newtype) $ checkNewtype dctors

130 checkDuplicateTypeArguments $ map fst args

131 ctorKind <- kindsOf True moduleName name args (concatMap snd dctors)

132+ let args' = args `withKinds` ctorKind

132− addDataType moduleName dtype name args dctors ctorKind

133+ addDataType moduleName dtype name args' dctors ctorKind

133 ds <- go rest

134 ds <- go rest

134− return $ d : ds

135+ return $ DataDeclaration dtype name args dctors : ds

135 where

136 where

136 checkNewtype :: [(ProperName, [Type])] -> Check ()

137 checkNewtype :: [(ProperName, [Type])] -> Check ()

137 checkNewtype [(_, [_])] = return ()

138 checkNewtype [(_, [_])] = return ()

@@ -144,10 +145,12 @@ typeCheckAll mainModuleName moduleName exps = go

144 (syn_ks, data_ks) <- kindsOfAll moduleName syns (map (\(_, name, args, dctors) -> (name, args, concatMap snd dctors)) dataDecls)

145 (syn_ks, data_ks) <- kindsOfAll moduleName syns (map (\(_, name, args, dctors) -> (name, args, concatMap snd dctors)) dataDecls)

145 forM_ (zip dataDecls data_ks) $ \((dtype, name, args, dctors), ctorKind) -> do

146 forM_ (zip dataDecls data_ks) $ \((dtype, name, args, dctors), ctorKind) -> do

146 checkDuplicateTypeArguments $ map fst args

147 checkDuplicateTypeArguments $ map fst args

148+ let args' = args `withKinds` ctorKind

147− addDataType moduleName dtype name args dctors ctorKind

149+ addDataType moduleName dtype name args' dctors ctorKind

148 forM_ (zip syns syn_ks) $ \((name, args, ty), kind) -> do

150 forM_ (zip syns syn_ks) $ \((name, args, ty), kind) -> do

149 checkDuplicateTypeArguments $ map fst args

151 checkDuplicateTypeArguments $ map fst args

152+ let args' = args `withKinds` kind

150− addTypeSynonym moduleName name args ty kind

153+ addTypeSynonym moduleName name args' ty kind

151 ds <- go rest

154 ds <- go rest

152 return $ d : ds

155 return $ d : ds

153 where

156 where

@@ -157,13 +160,14 @@ typeCheckAll mainModuleName moduleName exps = go

157 toDataDecl (DataDeclaration dtype nm args dctors) = Just (dtype, nm, args, dctors)

160 toDataDecl (DataDeclaration dtype nm args dctors) = Just (dtype, nm, args, dctors)

158 toDataDecl (PositionedDeclaration _ d') = toDataDecl d'

161 toDataDecl (PositionedDeclaration _ d') = toDataDecl d'

159 toDataDecl _ = Nothing

162 toDataDecl _ = Nothing

160− go (d@(TypeSynonymDeclaration name args ty) : rest) = do

163+ go (TypeSynonymDeclaration name args ty : rest) = do

161 rethrow (strMsg ("Error in type synonym " ++ show name) <>) $ do

164 rethrow (strMsg ("Error in type synonym " ++ show name) <>) $ do

162 checkDuplicateTypeArguments $ map fst args

165 checkDuplicateTypeArguments $ map fst args

163 kind <- kindsOf False moduleName name args [ty]

166 kind <- kindsOf False moduleName name args [ty]

167+ let args' = args `withKinds` kind

164− addTypeSynonym moduleName name args ty kind

168+ addTypeSynonym moduleName name args' ty kind

165 ds <- go rest

169 ds <- go rest

166− return $ d : ds

170+ return $ TypeSynonymDeclaration name args ty : ds

167 go (TypeDeclaration _ _ : _) = error "Type declarations should have been removed"

171 go (TypeDeclaration _ _ : _) = error "Type declarations should have been removed"

168 go (ValueDeclaration name nameKind [] Nothing val : rest) = do

172 go (ValueDeclaration name nameKind [] Nothing val : rest) = do

169 d <- rethrow (strMsg ("Error in declaration " ++ show name) <>) $ do

173 d <- rethrow (strMsg ("Error in declaration " ++ show name) <>) $ do

@@ -240,6 +244,16 @@ typeCheckAll mainModuleName moduleName exps = go

240 rethrowWithPosition pos $ do

244 rethrowWithPosition pos $ do

241 (d' : rest') <- go (d : rest)

245 (d' : rest') <- go (d : rest)

242 return (PositionedDeclaration pos d' : rest')

246 return (PositionedDeclaration pos d' : rest')

247+

248+ -- |

249+ -- This function adds the argument kinds for a type constructor so that they may appear in the externs file,

250+ -- extracted from the kind of the type constructor itself.

251+ --

252+ withKinds :: [(String, Maybe Kind)] -> Kind -> [(String, Maybe Kind)]

253+ withKinds [] _ = []

254+ withKinds (s@(_, Just _ ):ss) (FunKind _ k) = s : withKinds ss k

255+ withKinds ( (s, Nothing):ss) (FunKind k1 k2) = (s, Just k1) : withKinds ss k2

256+ withKinds _ _ = error "Invalid arguments to peelKinds"

243

257

244-- |

258-- |

245-- Type check an entire module and ensure all types and classes defined within the module that are

259-- Type check an entire module and ensure all types and classes defined within the module that are