tools/pas2c.hs
changeset 6834 2af81d3b176d
parent 6827 a0e152e68337
child 6835 00b2fd32305d
equal deleted inserted replaced
6833:a4f75b36d70d 6834:2af81d3b176d
   223 resolveType (RangeType _) = return $ BTInt
   223 resolveType (RangeType _) = return $ BTInt
   224 resolveType (Set t) = liftM BTSet $ resolveType t
   224 resolveType (Set t) = liftM BTSet $ resolveType t
   225 --resolveType UnknownType = return BTUnknown    
   225 --resolveType UnknownType = return BTUnknown    
   226 resolveType a = error $ "resolveType: " ++ show a
   226 resolveType a = error $ "resolveType: " ++ show a
   227     
   227     
   228     
   228 
       
   229 fromPointer :: BaseType -> State RenderState BaseType    
       
   230 fromPointer (BTPointerTo t) = f t
       
   231     where
       
   232         f (BTUnresolved s) = do
       
   233             v <- gets $ find (\(a, _) -> a == s) . currentScope
       
   234             if isJust v then
       
   235                 f . snd . snd . fromJust $ v
       
   236                 else
       
   237                 error $ "Unknown type " ++ show t
       
   238         f t = return t
       
   239 fromPointer t = error $ "Dereferencing from non-pointer type " ++ show t
       
   240 
       
   241 
   229 tvar2C :: Bool -> TypeVarDeclaration -> State RenderState Doc
   242 tvar2C :: Bool -> TypeVarDeclaration -> State RenderState Doc
   230 tvar2C _ (FunctionDeclaration name returnType params Nothing) = do
   243 tvar2C _ (FunctionDeclaration name returnType params Nothing) = do
   231     t <- type2C returnType 
   244     t <- type2C returnType 
   232     p <- liftM hcat $ mapM (tvar2C False) params
   245     p <- liftM hcat $ mapM (tvar2C False) params
   233     n <- id2C IOInsert name
   246     n <- id2C IOInsert name
   417         a -> error $ "dereferencing from " ++ show a ++ " - " ++ show rf
   430         a -> error $ "dereferencing from " ++ show a ++ " - " ++ show rf
   418     return $ 
   431     return $ 
   419         r1 <> text "." <> r2
   432         r1 <> text "." <> r2
   420 ref2C (Dereference ref) = do
   433 ref2C (Dereference ref) = do
   421     r <- ref2C ref
   434     r <- ref2C ref
   422     t <- gets lastType
   435     t <- fromPointer =<< gets lastType
   423     case t of
   436     modify (\st -> st{lastType = t})
   424          (BTPointerTo t') -> modify (\st -> st{lastType = t'})
       
   425          a -> error $ "Dereferencing from non-pointer type " ++ show a
       
   426     return $ (parens $ text "*") <> r
   437     return $ (parens $ text "*") <> r
   427 ref2C (FunCall params ref) = do
   438 ref2C (FunCall params ref) = do
   428     ps <- liftM (parens . hsep . punctuate (char ',')) $ mapM expr2C params
   439     ps <- liftM (parens . hsep . punctuate (char ',')) $ mapM expr2C params
   429     r <- ref2C ref
   440     r <- ref2C ref
   430     t <- gets lastType
   441     t <- gets lastType