tools/pas2c.hs
changeset 6845 3cbfc35f6c2e
parent 6843 59da15acb2f2
child 6853 affeaba0af71
equal deleted inserted replaced
6843:59da15acb2f2 6845:3cbfc35f6c2e
   392     case2C (e, p) = do
   392     case2C (e, p) = do
   393         ie <- mapM initExpr2C e
   393         ie <- mapM initExpr2C e
   394         ph <- phrase2C p
   394         ph <- phrase2C p
   395         return $ 
   395         return $ 
   396             text "case" <+> parens (hsep . punctuate (char ',') $ ie) <> char ':' <> nest 4 (ph $+$ text "break;")
   396             text "case" <+> parens (hsep . punctuate (char ',') $ ie) <> char ':' <> nest 4 (ph $+$ text "break;")
   397 phrase2C (WithBlock ref p) = do
   397 phrase2C wb@(WithBlock ref p) = do
   398     r <- ref2C ref 
   398     r <- ref2C ref 
   399     (BTRecord rs) <- gets lastType
   399     t <- gets lastType
   400     ph <- withRecordNamespace rs $ phrase2C $ wrapPhrase p
   400     case t of
   401     return $ text "namespace" <> parens r $$ ph
   401         (BTRecord rs) -> do
       
   402             ph <- withRecordNamespace rs $ phrase2C $ wrapPhrase p
       
   403             return $ text "namespace" <> parens r $$ ph
       
   404         a -> do
       
   405             ns <- gets currentScope
       
   406             error $ "'with' block referencing non-record type " ++ show a ++ "\n" ++ show wb ++ "\nnamespace: " ++ show (take 100 ns)
   402 phrase2C (ForCycle i' e1' e2' p) = do
   407 phrase2C (ForCycle i' e1' e2' p) = do
   403     i <- id2C IOLookup i'
   408     i <- id2C IOLookup i'
   404     e1 <- expr2C e1'
   409     e1 <- expr2C e1'
   405     e2 <- expr2C e2'
   410     e2 <- expr2C e2'
   406     ph <- phrase2C (wrapPhrase p)
   411     ph <- phrase2C (wrapPhrase p)
   446     es <- mapM expr2C exprs
   451     es <- mapM expr2C exprs
   447     r <- ref2C ref 
   452     r <- ref2C ref 
   448     t <- gets lastType
   453     t <- gets lastType
   449     ns <- gets currentScope
   454     ns <- gets currentScope
   450     case t of
   455     case t of
   451          (BTArray _ (BTArray _ t')) -> modify (\st -> st{lastType = t'})
   456          (BTArray _ ta@(BTArray _ t')) 
       
   457             | length exprs == 2 -> modify (\st -> st{lastType = t'})
       
   458             | otherwise -> modify (\st -> st{lastType = ta})
   452          (BTArray _ t') -> modify (\st -> st{lastType = t'})
   459          (BTArray _ t') -> modify (\st -> st{lastType = t'})
   453          (BTString) -> modify (\st -> st{lastType = BTChar})
   460          (BTString) -> modify (\st -> st{lastType = BTChar})
   454          a -> error $ "Getting element of " ++ show a ++ "\nReference: " ++ show ae ++ "\n" ++ show (take 100 ns)
   461          a -> error $ "Getting element of " ++ show a ++ "\nReference: " ++ show ae ++ "\n" ++ show (take 100 ns)
   455     return $ r <> (brackets . hcat) (punctuate comma es)
   462     return $ r <> (brackets . hcat) (punctuate comma es)
   456 ref2C (SimpleReference name) = id2C IOLookup name
   463 ref2C (SimpleReference name) = id2C IOLookup name