equal
deleted
inserted
replaced
303 tvar2C False (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name |
303 tvar2C False (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name |
304 |
304 |
305 tvar2C _ td@(TypeDeclaration i' t) = do |
305 tvar2C _ td@(TypeDeclaration i' t) = do |
306 i <- id2CTyped t i' |
306 i <- id2CTyped t i' |
307 tp <- type2C t |
307 tp <- type2C t |
308 return $ text "type" <+> i <+> tp <> semi |
308 return $ text "typedef" <+> i <+> tp <> semi |
309 |
309 |
310 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do |
310 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do |
311 t' <- type2C t |
311 t' <- type2C t |
312 i <- mapM (id2CTyped t) ids |
312 i <- mapM (id2CTyped t) ids |
313 ie <- initExpr mInitExpr |
313 ie <- initExpr mInitExpr |
333 e2 <- initExpr2C expr2 |
333 e2 <- initExpr2C expr2 |
334 return $ parens $ e1 <+> text (op2C op) <+> e2 |
334 return $ parens $ e1 <+> text (op2C op) <+> e2 |
335 initExpr2C (InitNumber s) = return $ text s |
335 initExpr2C (InitNumber s) = return $ text s |
336 initExpr2C (InitFloat s) = return $ text s |
336 initExpr2C (InitFloat s) = return $ text s |
337 initExpr2C (InitHexNumber s) = return $ text "0x" <> (text . map toLower $ s) |
337 initExpr2C (InitHexNumber s) = return $ text "0x" <> (text . map toLower $ s) |
|
338 initExpr2C (InitString [a]) = return . quotes $ text [a] |
338 initExpr2C (InitString s) = return $ doubleQuotes $ text s |
339 initExpr2C (InitString s) = return $ doubleQuotes $ text s |
339 initExpr2C (InitChar a) = return $ quotes $ text "\\x" <> text (showHex (read a) "") |
340 initExpr2C (InitChar a) = return $ quotes $ text "\\x" <> text (showHex (read a) "") |
340 initExpr2C (InitReference i) = id2C IOLookup i |
341 initExpr2C (InitReference i) = id2C IOLookup i |
341 initExpr2C (InitRecord fields) = do |
342 initExpr2C (InitRecord fields) = do |
342 (fs :: [Doc]) <- mapM (\(Identifier a _, b) -> liftM (text "." <> text a <+> equals <+>) $ initExpr2C b) fields |
343 (fs :: [Doc]) <- mapM (\(Identifier a _, b) -> liftM (text "." <> text a <+> equals <+>) $ initExpr2C b) fields |
346 initExpr2C (InitRange (Range i)) = id2C IOLookup i |
347 initExpr2C (InitRange (Range i)) = id2C IOLookup i |
347 initExpr2C (InitRange a) = return $ text "<<range>>" |
348 initExpr2C (InitRange a) = return $ text "<<range>>" |
348 initExpr2C (InitSet []) = return $ text "0" |
349 initExpr2C (InitSet []) = return $ text "0" |
349 initExpr2C (InitSet a) = return $ text "<<set>>" |
350 initExpr2C (InitSet a) = return $ text "<<set>>" |
350 initExpr2C (BuiltInFunction {}) = return $ text "<<built-in function>>" |
351 initExpr2C (BuiltInFunction {}) = return $ text "<<built-in function>>" |
351 initExpr2C a = error $ "Don't know how to render " ++ show a |
352 initExpr2C a = error $ "initExpr2C: don't know how to render " ++ show a |
352 |
353 |
|
354 range2C :: InitExpression -> State RenderState [Doc] |
|
355 range2C (InitString [a]) = return [quotes $ text [a]] |
|
356 range2C (InitRange (Range i)) = liftM (flip (:) []) $ id2C IOLookup i |
|
357 range2C (InitRange (RangeFromTo (InitString [a]) (InitString [b]))) = return $ map (\i -> quotes $ text [i]) [a..b] |
|
358 |
|
359 range2C a = liftM (flip (:) []) $ initExpr2C a |
353 |
360 |
354 type2C :: TypeDecl -> State RenderState Doc |
361 type2C :: TypeDecl -> State RenderState Doc |
355 type2C (SimpleType i) = id2C IOLookup i |
362 type2C (SimpleType i) = id2C IOLookup i |
356 type2C t = do |
363 type2C t = do |
357 r <- type2C' t |
364 r <- type2C' t |
413 p <- phrase2C $ wrapPhrase phrase |
420 p <- phrase2C $ wrapPhrase phrase |
414 return $ text "while" <> parens e $$ p |
421 return $ text "while" <> parens e $$ p |
415 phrase2C (SwitchCase expr cases mphrase) = do |
422 phrase2C (SwitchCase expr cases mphrase) = do |
416 e <- expr2C expr |
423 e <- expr2C expr |
417 cs <- mapM case2C cases |
424 cs <- mapM case2C cases |
418 return $ |
425 d <- dflt |
419 text "switch" <> parens e <> text "of" $+$ (nest 4 . vcat) cs |
426 return $ |
|
427 text "switch" <> parens e <> text "of" $+$ braces (nest 4 . vcat $ cs ++ d) |
420 where |
428 where |
421 case2C :: ([InitExpression], Phrase) -> State RenderState Doc |
429 case2C :: ([InitExpression], Phrase) -> State RenderState Doc |
422 case2C (e, p) = do |
430 case2C (e, p) = do |
423 ie <- mapM initExpr2C e |
431 ies <- mapM range2C e |
424 ph <- phrase2C p |
432 ph <- phrase2C p |
425 return $ |
433 return $ |
426 text "case" <+> parens (hsep . punctuate (char ',') $ ie) <> char ':' <> nest 4 (ph $+$ text "break;") |
434 vcat (map (\i -> text "case" <+> i <> colon) . concat $ ies) <> nest 4 (ph $+$ text "break;") |
|
435 dflt | isNothing mphrase = return [] |
|
436 | otherwise = do |
|
437 ph <- mapM phrase2C $ fromJust mphrase |
|
438 return [text "default:" <+> nest 4 (vcat ph)] |
|
439 |
427 phrase2C wb@(WithBlock ref p) = do |
440 phrase2C wb@(WithBlock ref p) = do |
428 r <- ref2C ref |
441 r <- ref2C ref |
429 t <- gets lastType |
442 t <- gets lastType |
430 case t of |
443 case t of |
431 (BTRecord rs) -> withRecordNamespace (render r ++ ".") rs $ phrase2C $ wrapPhrase p |
444 (BTRecord rs) -> withRecordNamespace (render r ++ ".") rs $ phrase2C $ wrapPhrase p |
448 phrase2C NOP = return $ text ";" |
461 phrase2C NOP = return $ text ";" |
449 |
462 |
450 |
463 |
451 wrapPhrase p@(Phrases _) = p |
464 wrapPhrase p@(Phrases _) = p |
452 wrapPhrase p = Phrases [p] |
465 wrapPhrase p = Phrases [p] |
453 |
|
454 |
466 |
455 expr2C :: Expression -> State RenderState Doc |
467 expr2C :: Expression -> State RenderState Doc |
456 expr2C (Expression s) = return $ text s |
468 expr2C (Expression s) = return $ text s |
457 expr2C (BinOp op expr1 expr2) = do |
469 expr2C (BinOp op expr1 expr2) = do |
458 e1 <- expr2C expr1 |
470 e1 <- expr2C expr1 |
466 ("|", BTBool) -> return $ parens $ e1 <+> text "||" <+> e2 |
478 ("|", BTBool) -> return $ parens $ e1 <+> text "||" <+> e2 |
467 (o, _) -> return $ parens $ e1 <+> text o <+> e2 |
479 (o, _) -> return $ parens $ e1 <+> text o <+> e2 |
468 expr2C (NumberLiteral s) = return $ text s |
480 expr2C (NumberLiteral s) = return $ text s |
469 expr2C (FloatLiteral s) = return $ text s |
481 expr2C (FloatLiteral s) = return $ text s |
470 expr2C (HexNumber s) = return $ text "0x" <> (text . map toLower $ s) |
482 expr2C (HexNumber s) = return $ text "0x" <> (text . map toLower $ s) |
|
483 expr2C (StringLiteral [a]) = return . quotes $ text [a] |
471 expr2C (StringLiteral s) = return $ doubleQuotes $ text s |
484 expr2C (StringLiteral s) = return $ doubleQuotes $ text s |
472 expr2C (Reference ref) = ref2C ref |
485 expr2C (Reference ref) = ref2C ref |
473 expr2C (PrefixOp op expr) = liftM (text (op2C op) <>) (expr2C expr) |
486 expr2C (PrefixOp op expr) = liftM (text (op2C op) <>) (expr2C expr) |
474 expr2C Null = return $ text "NULL" |
487 expr2C Null = return $ text "NULL" |
475 expr2C (BuiltInFunCall params ref) = do |
488 expr2C (BuiltInFunCall params ref) = do |