Links und Funktionen
Sprachumschaltung

Navigationspfad
Sie sind hier: Startseite / Lehre / WS 2014/15 / Compilerbau / Material / Canon.hs


Inhaltsbereich

Canon.hs

Haskell source code icon Canon.hs — Haskell source code, 2 KB (2661 bytes)

Dateiinhalt

module Canon where

import Names
import Tree
import MachineSpecifics (Fragment(..))

canFragment :: (MonadNameGen m) => Fragment f Stm -> m (Fragment f [Stm])
canFragment (FragmentProc f s)
    = do ss <- canStm s
         return (FragmentProc f (reverse ss))

-- canonical exp
type StmExp = ([Stm], Exp)
-- [Stm] is the reversed list of stms
-- Exp does not contain eseq

-- operations for reversed lists
infixl -:-
(-:-) = flip (:)
infixl -++-
(-++-) = flip (++)

canExp' :: (MonadNameGen m) => Exp -> m StmExp
canExp' e = do (ss, e') <- canExp e
               case e' of
                 CALL _ _ -> do t <- nextTemp
                                return (ss -:- MOVE (TEMP t) e', TEMP t)
                 _ -> return (ss, e')

canExp :: (MonadNameGen m) => Exp -> m StmExp

canExp (BINOP o e1 e2)
    = do se1        <- canExp' e1
         (ss2, e2') <- canExp' e2
         (ss, e1')  <- appStms se1 ss2
         return (ss, BINOP o e1' e2')

canExp (MEM e)
    = do (ss, e1) <- canExp' e
         return (ss, MEM e1)

canExp (CALL f es)
    = do ses <- mapM canExp' (f:es)
         (ss, f':es') <- catSEs ses
         return (ss, CALL f' es')

canExp (ESEQ s e)
    = do ss1 <- canStm s
         (ss2, e') <- canExp e
         return (ss1 -++- ss2, e')

-- CONST, NAME, TEMP
canExp e = return ([], e)

canLExp :: (MonadNameGen m) => Exp -> m StmExp
canLExp = canExp'

canStm :: (MonadNameGen m) => Stm -> m [Stm]

canStm (MOVE e1 e2)
    = do (ss1, e1') <- canLExp e1
         (ss2, e2') <- canExp e2
         return (ss1 -++- ss2 -:- MOVE e1' e2')

canStm (EXP e)
    = do (ss, e') <- canExp e
         return (ss -:- EXP e')

canStm (JUMP e ls)
    = do (ss, e') <- canExp' e
         return (ss -:- JUMP e' ls)

canStm (CJUMP o e1 e2 l1 l2)
    = do se1 <- canExp' e1
         (ss2, e2') <- canExp' e2
         (ss, e1') <- appStms se1 ss2
         return (ss -:- CJUMP o e1' e2' l1 l2)

canStm (SEQ s1 s2)
    = do ss1 <- canStm s1
         ss2 <- canStm s2
         return (ss1 -++- ss2)

canStm (LABEL l) = return [LABEL l]

canStm NOP = return []

appStm :: (MonadNameGen m) => StmExp -> Stm -> m StmExp
appStm (ss, e) s
   = do t <- nextTemp
        return ( ss -:- (MOVE (TEMP t) e) -:- s
               , TEMP t )

-- appStms: both stm lists reversed
appStms :: (MonadNameGen m) => StmExp -> [Stm] -> m StmExp
appStms se ss = foldr (\ s mse -> mse >>= \ se -> appStm se s)
                      (return se) ss

catSEs :: (MonadNameGen m) => [StmExp] -> m ([Stm], [Exp])
catSEs = foldr (\ se mses -> mses >>= \ (ss, es) ->
                  do (ss', e') <- appStms se ss
                     return (ss', e':es))
               (return ([],[]))

Artikelaktionen


Funktionsleiste