tools/pas2c.hs
changeset 7055 4c495c8f02da
parent 7054 7e8fb07ef91c
child 7056 2884c7be6691
equal deleted inserted replaced
7054:7e8fb07ef91c 7055:4c495c8f02da
   754     i <- id2C IOLookup name
   754     i <- id2C IOLookup name
   755     t <- gets lastType
   755     t <- gets lastType
   756     case t of
   756     case t of
   757          BTFunction {} -> return $ i <> parens empty
   757          BTFunction {} -> return $ i <> parens empty
   758          _ -> return $ i
   758          _ -> return $ i
       
   759 ref2CF r@(RecordField (SimpleReference _) (SimpleReference _)) = do
       
   760     i <- ref2C r
       
   761     t <- gets lastType
       
   762     case t of
       
   763          BTFunction {} -> return $ i <> parens empty
       
   764          _ -> return $ i
   759 ref2CF r = ref2C r
   765 ref2CF r = ref2C r
   760 
   766 
   761 ref2C :: Reference -> State RenderState Doc
   767 ref2C :: Reference -> State RenderState Doc
   762 -- rewrite into proper form
   768 -- rewrite into proper form
   763 ref2C (RecordField ref1 (ArrayElement exprs ref2)) = ref2C $ ArrayElement exprs (RecordField ref1 ref2)
   769 ref2C (RecordField ref1 (ArrayElement exprs ref2)) = ref2C $ ArrayElement exprs (RecordField ref1 ref2)
   788 ref2C rf@(RecordField (Dereference ref1) ref2) = do
   794 ref2C rf@(RecordField (Dereference ref1) ref2) = do
   789     r1 <- ref2C ref1 
   795     r1 <- ref2C ref1 
   790     t <- fromPointer (show ref1) =<< gets lastType
   796     t <- fromPointer (show ref1) =<< gets lastType
   791     r2 <- case t of
   797     r2 <- case t of
   792         BTRecord _ rs -> withRecordNamespace "" rs $ ref2C ref2
   798         BTRecord _ rs -> withRecordNamespace "" rs $ ref2C ref2
   793         BTUnit -> withLastIdNamespace $ ref2CF ref2
   799         BTUnit -> error "What??"
   794         a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf
   800         a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf
   795     return $ 
   801     return $ 
   796         r1 <> text "->" <> r2
   802         r1 <> text "->" <> r2
   797 ref2C rf@(RecordField ref1 ref2) = do
   803 ref2C rf@(RecordField ref1 ref2) = do
   798     r1 <- ref2C ref1
   804     r1 <- ref2C ref1
   799     t <- gets lastType
   805     t <- gets lastType
   800     case t of
   806     case t of
   801         BTRecord _ rs -> do
   807         BTRecord _ rs -> do
   802             r2 <- withRecordNamespace "" rs $ ref2C ref2
   808             r2 <- withRecordNamespace "" rs $ ref2C ref2
   803             return $ r1 <> text "." <> r2
   809             return $ r1 <> text "." <> r2
   804         BTUnit -> withLastIdNamespace $ ref2CF ref2        
   810         BTUnit -> withLastIdNamespace $ ref2C ref2
   805         a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf
   811         a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf
   806 ref2C d@(Dereference ref) = do
   812 ref2C d@(Dereference ref) = do
   807     r <- ref2C ref
   813     r <- ref2C ref
   808     t <- fromPointer (show d) =<< gets lastType
   814     t <- fromPointer (show d) =<< gets lastType
   809     modify (\st -> st{lastType = t})
   815     modify (\st -> st{lastType = t})