148 lines
4.9 KiB
Plaintext
148 lines
4.9 KiB
Plaintext
%if false
|
|
Copyright (c) 2009 ETH Zurich.
|
|
All rights reserved.
|
|
|
|
This file is distributed under the terms in the attached LICENSE file.
|
|
If you do not find this file, copies can be found by writing to:
|
|
ETH Zurich D-INFK, Universitaetstrasse 6, CH-8092 Zurich. Attn: Systems Group.
|
|
%endif
|
|
|
|
%include polycode.fmt
|
|
|
|
%if false
|
|
|
|
> module Constructs.Unions where
|
|
|
|
> import Data.Maybe
|
|
|
|
> import Constructs
|
|
> import PureExpressions
|
|
> import {-# SOURCE #-} Expressions
|
|
|
|
> import Semantics
|
|
|
|
> import IL.FoF.FoF
|
|
> import IL.FoF.Compile
|
|
|
|
%endif
|
|
|
|
\section{Unions Definition}
|
|
|
|
The |Union| constructs abstracts the @union@ data-type of C.
|
|
|
|
\subsection{Smart Constructors}
|
|
|
|
Hence, creating an union is available in four flavors, statically or
|
|
dynamically allocated, and anonymous or named.
|
|
|
|
> newStaticUnion :: String ->
|
|
> [(TypeExpr, String)] ->
|
|
> String ->
|
|
> Data ->
|
|
> FoFCode Loc
|
|
> newStaticUnion name fields field dat =
|
|
> inject (NewUnion Nothing StaticUnion name
|
|
> (map (\(s1,s2) -> (s2,s1)) fields)
|
|
> (field, dat)
|
|
> return)
|
|
>
|
|
> newStaticUnionN :: String ->
|
|
> String ->
|
|
> [(TypeExpr, String)] ->
|
|
> String ->
|
|
> Data ->
|
|
> FoFCode Loc
|
|
> newStaticUnionN nameU name fields field dat =
|
|
> inject (NewUnion (Just nameU) StaticUnion name
|
|
> (map (\(s1,s2) -> (s2,s1)) fields)
|
|
> (field, dat)
|
|
> return)
|
|
>
|
|
> newUnion :: String ->
|
|
> [(TypeExpr, String)] ->
|
|
> String ->
|
|
> Data ->
|
|
> FoFCode Loc
|
|
> newUnion name fields field dat =
|
|
> inject (NewUnion Nothing DynamicUnion
|
|
> name
|
|
> (map (\(s1,s2) -> (s2,s1)) fields)
|
|
> (field, dat)
|
|
> return)
|
|
>
|
|
> newUnionN :: String ->
|
|
> String ->
|
|
> [(TypeExpr, String)] ->
|
|
> String ->
|
|
> Data ->
|
|
> FoFCode Loc
|
|
> newUnionN nameU name fields field dat =
|
|
> inject (NewUnion (Just nameU) DynamicUnion
|
|
> name
|
|
> (map (\(s1,s2) -> (s2,s1)) fields)
|
|
> (field, dat)
|
|
> return)
|
|
|
|
Reading and writing follow the usual scheme:
|
|
|
|
> readUnion :: Loc -> String -> FoFCode Data
|
|
> readUnion l f = inject (ReadUnion l f return)
|
|
|
|
> writeUnion :: Loc -> String -> Data -> FoFCode ()
|
|
> writeUnion l f d = inject (WriteUnion l f d (return ()))
|
|
|
|
\subsection{Compile Instantiation}
|
|
|
|
As usual the difficulty of the compilation stands in not messing up
|
|
created and read types. Apart from that, it is a simple translation.
|
|
|
|
> compileUnions (NewUnion refName allocUnion nameU fields (initField, initData) r) binding =
|
|
> (FStatement newU cont,
|
|
> binding2)
|
|
> where typeUnion = TUnion DynamicUnion nameU fields
|
|
> (loc, binding1) = getFreshVar binding
|
|
> name = case refName of
|
|
> Nothing -> makeVarName Dynamic loc
|
|
> Just x -> Provided x
|
|
> ret = CLRef Dynamic typeUnion name
|
|
> (cont, binding2) = r ret binding1
|
|
> newU = FNewUnion name allocUnion nameU fields (initField, initData)
|
|
>
|
|
> compileUnions (ReadUnion ref@(CLRef _ typeU@(TUnion alloc
|
|
> nameU
|
|
> fields) xloc)
|
|
> field r) binding =
|
|
> (FStatement readU cont,
|
|
> binding2)
|
|
> where (loc, name, binding1) = heritVarName binding xloc
|
|
> typeField = fromJust $ field `lookup` fields
|
|
> origin = allocToOrigin alloc
|
|
> ret = CLRef origin (readOf typeField) name
|
|
> (cont, binding2) = r ret binding1
|
|
> readU = FReadUnion name ref field
|
|
> allocToOrigin StaticUnion = Local
|
|
> allocToOrigin DynamicUnion = Dynamic
|
|
>
|
|
> compileUnions (WriteUnion ref@(CLRef origin
|
|
> typ@(TUnion alloc _ fields)
|
|
> xloc)
|
|
> field
|
|
> value r) binding =
|
|
> (FStatement writeU cont,
|
|
> binding1)
|
|
> where (cont, binding1) = r binding
|
|
> writeU = FWriteUnion ref field value
|
|
|
|
|
|
\subsection{Run Instantiation}
|
|
|
|
This part has not been implemented yet. Hence, the interpreter will
|
|
blow up in presence of unions. To get an idea of the desired
|
|
implementation, take a look at the reference cells interpreter. It
|
|
should be similarly easy.
|
|
|
|
> runUnions (NewUnion _ a b c d r) heap = error "runUnions: not yet implemented"
|
|
> runUnions (ReadUnion a b r) heap = error "runUnions: not yet implemented"
|
|
> runUnions (WriteUnion a b c r) heap = error "runUnions: not yet implemented"
|
|
|