169 lines
6.1 KiB
Plaintext
169 lines
6.1 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.Structures where
|
|
|
|
> import Data.Maybe
|
|
|
|
> import Semantics
|
|
> import Constructs
|
|
> import PureExpressions
|
|
> import {-# SOURCE #-} Expressions
|
|
|
|
> import IL.FoF.FoF
|
|
> import IL.FoF.Compile
|
|
|
|
%endif
|
|
|
|
\section{Structures Definition}
|
|
|
|
The |Structure| construct allows you to mirror the @struct@ data-type
|
|
of C. It is composed by a |newStruct| combinator, to instantiate an
|
|
element of this type, a |readStruct| combinator, to read a field from
|
|
a structure, and a |writeStruct| combinator, to write into a field.
|
|
|
|
\subsection{Smart Constructors}
|
|
|
|
As often with instantiation operators, we can chose between statically
|
|
or dynamically allocating the value. Then, it is possible to chose
|
|
between an anonymous or a named value. All these choices are provided
|
|
by the following four combinators.
|
|
|
|
> newStaticStruct :: String ->
|
|
> [(TypeExpr, String, Data)] ->
|
|
> FoFCode Loc
|
|
> newStaticStruct name stt =
|
|
> inject (NewStruct Nothing StaticStruct name
|
|
> (map (\(t,n,v) -> (n,(t,v))) stt)
|
|
> return)
|
|
>
|
|
> newStaticStructN :: String ->
|
|
> String ->
|
|
> [(TypeExpr, String, Data)] ->
|
|
> FoFCode Loc
|
|
> newStaticStructN nameStr name stt =
|
|
> inject (NewStruct (Just nameStr) StaticStruct name
|
|
> (map (\(t,n,v) -> (n,(t,v))) stt)
|
|
> return)
|
|
>
|
|
> newStruct :: String ->
|
|
> [(TypeExpr, String, Data)] ->
|
|
> FoFCode Loc
|
|
> newStruct name stt =
|
|
> inject (NewStruct Nothing DynamicStruct name
|
|
> (map (\(t,n,v) -> (n,(t,v))) stt)
|
|
> return)
|
|
>
|
|
> newStructN :: String ->
|
|
> String ->
|
|
> [(TypeExpr, String, Data)] ->
|
|
> FoFCode Loc
|
|
> newStructN nameStr name stt =
|
|
> inject (NewStruct (Just nameStr) DynamicStruct name
|
|
> (map (\(t,n,v) -> (n,(t,v))) stt)
|
|
> return)
|
|
|
|
Follow the read and write combinators:
|
|
|
|
> readStruct :: Loc -> String -> FoFCode Data
|
|
> readStruct l f = inject (ReadStruct l f return)
|
|
>
|
|
> writeStruct :: Loc -> String -> Data -> FoFCode ()
|
|
> writeStruct l f d = inject (WriteStruct l f d (return ()))
|
|
|
|
\subsection{Compile Instantiation}
|
|
|
|
Apart from type handling, the compilation naturally follows the
|
|
definition. As often, computing the |CLRef| is a magic voodoo, which
|
|
is far from being provably correct.
|
|
|
|
> compileStructures (NewStruct refName allocStruct name fields r) binding =
|
|
> (FStatement newS cont,
|
|
> binding2)
|
|
> where (loc, binding1) = getFreshVar binding
|
|
> structName = case refName of
|
|
> Just x -> Provided x
|
|
> Nothing -> makeVarName Dynamic loc
|
|
> fieldsTypeStr = [ (field, typ)
|
|
> | (field,(typ,_)) <- fields]
|
|
> typeStr = TStruct DynamicStruct name fieldsTypeStr
|
|
> ret = CLRef Dynamic typeStr structName
|
|
> (cont, binding2) = r ret binding1
|
|
> newS = FNewStruct structName allocStruct name fields
|
|
>
|
|
> compileStructures (ReadStruct ref@(CLRef origin
|
|
> typ@(TStruct alloc name fields)
|
|
> xloc)
|
|
> field r) binding =
|
|
> (FStatement readS cont,
|
|
> binding2)
|
|
> where (loc, varName, binding1) = heritVarName binding xloc
|
|
> typeField = fromJust $ field `lookup` fields
|
|
> ret = CLRef (allocToOrigin alloc) (readOf typeField) varName
|
|
> (cont, binding2) = r ret binding1
|
|
> readS = FReadStruct varName ref field
|
|
> allocToOrigin StaticStruct = Local
|
|
> allocToOrigin DynamicStruct = Dynamic
|
|
>
|
|
> compileStructures (WriteStruct ref@(CLRef origin
|
|
> typ@(TStruct alloc name fields)
|
|
> xloc)
|
|
> field
|
|
> value r) binding =
|
|
> (FStatement writeS cont,
|
|
> binding1)
|
|
> where (cont, binding1) = r binding
|
|
> writeS = FWriteStruct ref field value
|
|
|
|
|
|
\subsection{Run Instantiation}
|
|
|
|
The interpreter follows with a dispatcher:
|
|
|
|
> runStructures (NewStruct _ a b c r) heap =
|
|
> uncurry r $ runNewStruct a b c heap
|
|
> runStructures (ReadStruct a b r) heap =
|
|
> uncurry r $ runReadStruct a b heap
|
|
> runStructures (WriteStruct a b c r) heap =
|
|
> r $ runWriteStruct a b c heap
|
|
|
|
And the per-construct implementation:
|
|
|
|
> runNewStruct :: AllocStruct ->
|
|
> String ->
|
|
> [(String, (TypeExpr,Data))] ->
|
|
> Heap -> (Loc, Heap)
|
|
> runNewStruct alloc name struct heap =
|
|
> let structT = map (\(x1,(x2,_)) -> (x1,x2)) struct in
|
|
> let structD = map (\(x1,(_,x2)) -> (x1,x2)) struct in
|
|
> let loc = freshLoc heap in
|
|
> let structs = strMap heap in
|
|
> let varName = makeVarName Local loc in
|
|
> let heap1 = heap { freshLoc = loc + 1 } in
|
|
> let heap2 = heap1 { strMap = (varName, structD) : structs } in
|
|
> (CLRef Local (TStruct alloc name structT) varName, heap2)
|
|
>
|
|
> runReadStruct :: Loc -> String -> Heap -> (Data, Heap)
|
|
> runReadStruct (CLRef _ _ location) field heap =
|
|
> let structs = strMap heap in
|
|
> let struct = fromJust $ location `lookup` structs in
|
|
> let val = fromJust $ field `lookup` struct in
|
|
> (val, heap)
|
|
>
|
|
> runWriteStruct :: Loc -> String -> Data -> Heap -> Heap
|
|
> runWriteStruct (CLRef _ _ location) field value heap =
|
|
> let structs = strMap heap in
|
|
> let struct = fromJust $ location `lookup` structs in
|
|
> let struct1 = (field, value) : struct in
|
|
> let structs1 = (location, struct1) : structs in
|
|
> heap { strMap = structs1 } |