232 tvs <- mapM f (concat $ tv : fromMaybe [] mtvs) |
232 tvs <- mapM f (concat $ tv : fromMaybe [] mtvs) |
233 return . BTRecord . concat $ tvs |
233 return . BTRecord . concat $ tvs |
234 where |
234 where |
235 f :: TypeVarDeclaration -> State RenderState [(String, BaseType)] |
235 f :: TypeVarDeclaration -> State RenderState [(String, BaseType)] |
236 f (VarDeclaration _ (ids, td) _) = mapM (\(Identifier i _) -> liftM ((,) i) $ resolveType td) ids |
236 f (VarDeclaration _ (ids, td) _) = mapM (\(Identifier i _) -> liftM ((,) i) $ resolveType td) ids |
237 resolveType (ArrayDecl (Just _) t) = liftM (BTArray BTInt) $ resolveType t |
237 resolveType (ArrayDecl (Just i) t) = do |
238 resolveType (ArrayDecl Nothing t) = liftM (BTArray BTInt) $ resolveType t |
238 t' <- resolveType t |
|
239 return $ BTArray i BTInt t' |
|
240 resolveType (ArrayDecl Nothing t) = liftM (BTArray RangeInfinite BTInt) $ resolveType t |
239 resolveType (FunctionType t _) = liftM BTFunction $ resolveType t |
241 resolveType (FunctionType t _) = liftM BTFunction $ resolveType t |
240 resolveType (DeriveType (InitHexNumber _)) = return BTInt |
242 resolveType (DeriveType (InitHexNumber _)) = return BTInt |
241 resolveType (DeriveType (InitNumber _)) = return BTInt |
243 resolveType (DeriveType (InitNumber _)) = return BTInt |
242 resolveType (DeriveType (InitFloat _)) = return BTFloat |
244 resolveType (DeriveType (InitFloat _)) = return BTFloat |
243 resolveType (DeriveType (InitString _)) = return BTString |
245 resolveType (DeriveType (InitString _)) = return BTString |
380 BTInt -> case i' of |
382 BTInt -> case i' of |
381 "byte" -> return $ int 256 |
383 "byte" -> return $ int 256 |
382 _ -> error $ "InitRange identifier: " ++ i' |
384 _ -> error $ "InitRange identifier: " ++ i' |
383 _ -> error $ "InitRange: " ++ show r |
385 _ -> error $ "InitRange: " ++ show r |
384 initExpr2C (InitRange (RangeFromTo (InitNumber "0") r)) = initExpr2C $ BuiltInFunction "succ" [r] |
386 initExpr2C (InitRange (RangeFromTo (InitNumber "0") r)) = initExpr2C $ BuiltInFunction "succ" [r] |
|
387 initExpr2C (InitRange (RangeFromTo (InitChar "0") (InitChar r))) = initExpr2C $ BuiltInFunction "succ" [InitNumber r] |
385 initExpr2C (InitRange a) = error $ show a --return $ text "<<range>>" |
388 initExpr2C (InitRange a) = error $ show a --return $ text "<<range>>" |
386 initExpr2C (InitSet []) = return $ text "0" |
389 initExpr2C (InitSet []) = return $ text "0" |
387 initExpr2C (InitSet a) = return $ text "<<set>>" |
390 initExpr2C (InitSet a) = return $ text "<<set>>" |
388 initExpr2C (BuiltInFunction "low" [InitReference e]) = return $ |
391 initExpr2C (BuiltInFunction "low" [InitReference e]) = return $ |
389 case e of |
392 case e of |
390 (Identifier "LongInt" _) -> int (-2^31) |
393 (Identifier "LongInt" _) -> int (-2^31) |
391 _ -> error $ show e |
394 (Identifier "SmallInt" _) -> int (-2^15) |
|
395 _ -> error $ "BuiltInFunction 'low': " ++ show e |
|
396 initExpr2C (BuiltInFunction "high" [e]) = do |
|
397 initExpr2C e |
|
398 t <- gets lastType |
|
399 case t of |
|
400 (BTArray i _ _) -> initExpr2C $ BuiltInFunction "pred" [InitRange i] |
|
401 a -> error $ "BuiltInFunction 'high': " ++ show a |
|
402 initExpr2C (BuiltInFunction "succ" [BuiltInFunction "pred" [e]]) = initExpr2C e |
|
403 initExpr2C (BuiltInFunction "pred" [BuiltInFunction "succ" [e]]) = initExpr2C e |
392 initExpr2C (BuiltInFunction "succ" [e]) = liftM (<> text " + 1") $ initExpr2C e |
404 initExpr2C (BuiltInFunction "succ" [e]) = liftM (<> text " + 1") $ initExpr2C e |
393 initExpr2C (BuiltInFunction "pred" [e]) = liftM (<> text " - 1") $ initExpr2C e |
405 initExpr2C (BuiltInFunction "pred" [e]) = liftM (<> text " - 1") $ initExpr2C e |
394 initExpr2C b@(BuiltInFunction _ _) = error $ show b |
406 initExpr2C b@(BuiltInFunction _ _) = error $ show b |
395 initExpr2C a = error $ "initExpr2C: don't know how to render " ++ show a |
407 initExpr2C a = error $ "initExpr2C: don't know how to render " ++ show a |
396 |
408 |
571 es <- mapM expr2C exprs |
583 es <- mapM expr2C exprs |
572 r <- ref2C ref |
584 r <- ref2C ref |
573 t <- gets lastType |
585 t <- gets lastType |
574 ns <- gets currentScope |
586 ns <- gets currentScope |
575 case t of |
587 case t of |
576 (BTArray _ t') -> modify (\st -> st{lastType = t'}) |
588 (BTArray _ _ t') -> modify (\st -> st{lastType = t'}) |
577 (BTString) -> modify (\st -> st{lastType = BTChar}) |
589 (BTString) -> modify (\st -> st{lastType = BTChar}) |
578 (BTPointerTo t) -> do |
590 (BTPointerTo t) -> do |
579 t'' <- fromPointer (show t) =<< gets lastType |
591 t'' <- fromPointer (show t) =<< gets lastType |
580 case t'' of |
592 case t'' of |
581 BTChar -> modify (\st -> st{lastType = BTChar}) |
593 BTChar -> modify (\st -> st{lastType = BTChar}) |