Semantics.hs 19 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
-- Copyright (c) 2013, Kenton Varda <temporal@gmail.com>
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
--
-- 1. Redistributions of source code must retain the above copyright notice, this
--    list of conditions and the following disclaimer.
-- 2. Redistributions in binary form must reproduce the above copyright notice,
--    this list of conditions and the following disclaimer in the documentation
--    and/or other materials provided with the distribution.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-- ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
-- (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
-- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
-- ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

module Semantics where

import qualified Data.Map as Map
import qualified Data.List as List
Kenton Varda's avatar
Kenton Varda committed
28
import qualified Data.Maybe as Maybe
29 30 31 32 33
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Word (Word8, Word16, Word32, Word64)
import Data.Char (chr)
import Text.Printf(printf)
import Control.Monad(join)
Kenton Varda's avatar
Kenton Varda committed
34
import Util(delimit)
35

36 37 38 39 40 41 42
-- Field counts are 8-bit, therefore there cannot be more than 255 fields, therefore the max field
-- number is 254.
maxFieldNumber = 254 :: Integer

-- Limiting method counts is not as important technically, but obviously it would be insane to have
-- anywhere near 2^16 methods.
maxMethodNumber = 65534 :: Integer
Kenton Varda's avatar
Kenton Varda committed
43

44 45 46 47 48 49 50
type ByteString = [Word8]

data Desc = DescFile FileDesc
          | DescAlias AliasDesc
          | DescConstant ConstantDesc
          | DescEnum EnumDesc
          | DescEnumValue EnumValueDesc
Kenton Varda's avatar
Kenton Varda committed
51
          | DescStruct StructDesc
Kenton Varda's avatar
Kenton Varda committed
52
          | DescUnion UnionDesc
53 54 55 56 57 58 59 60 61 62 63 64
          | DescField FieldDesc
          | DescInterface InterfaceDesc
          | DescMethod MethodDesc
          | DescOption OptionDesc
          | DescBuiltinType BuiltinType
          | DescBuiltinList

descName (DescFile      _) = "(top-level)"
descName (DescAlias     d) = aliasName d
descName (DescConstant  d) = constantName d
descName (DescEnum      d) = enumName d
descName (DescEnumValue d) = enumValueName d
Kenton Varda's avatar
Kenton Varda committed
65
descName (DescStruct    d) = structName d
Kenton Varda's avatar
Kenton Varda committed
66
descName (DescUnion     d) = unionName d
67 68 69 70 71 72 73 74 75 76 77
descName (DescField     d) = fieldName d
descName (DescInterface d) = interfaceName d
descName (DescMethod    d) = methodName d
descName (DescOption    d) = optionName d
descName (DescBuiltinType d) = builtinTypeName d
descName DescBuiltinList = "List"

descParent (DescFile      _) = error "File descriptor has no parent."
descParent (DescAlias     d) = aliasParent d
descParent (DescConstant  d) = constantParent d
descParent (DescEnum      d) = enumParent d
Kenton Varda's avatar
Kenton Varda committed
78
descParent (DescEnumValue d) = DescEnum (enumValueParent d)
Kenton Varda's avatar
Kenton Varda committed
79
descParent (DescStruct    d) = structParent d
Kenton Varda's avatar
Kenton Varda committed
80 81
descParent (DescUnion     d) = DescStruct (unionParent d)
descParent (DescField     d) = DescStruct (fieldParent d)
82
descParent (DescInterface d) = interfaceParent d
Kenton Varda's avatar
Kenton Varda committed
83
descParent (DescMethod    d) = DescInterface (methodParent d)
84 85 86 87 88 89 90 91 92 93 94 95 96
descParent (DescOption    d) = optionParent d
descParent (DescBuiltinType _) = error "Builtin type has no parent."
descParent DescBuiltinList = error "Builtin type has no parent."

type MemberMap = Map.Map String (Maybe Desc)

lookupMember :: String -> MemberMap -> Maybe Desc
lookupMember name members = join (Map.lookup name members)

data BuiltinType = BuiltinVoid | BuiltinBool
                 | BuiltinInt8 | BuiltinInt16 | BuiltinInt32 | BuiltinInt64
                 | BuiltinUInt8 | BuiltinUInt16 | BuiltinUInt32 | BuiltinUInt64
                 | BuiltinFloat32 | BuiltinFloat64
Kenton Varda's avatar
Kenton Varda committed
97
                 | BuiltinText | BuiltinData
98 99 100 101 102 103
                 deriving (Show, Enum, Bounded, Eq)

builtinTypes = [minBound::BuiltinType .. maxBound::BuiltinType]

-- Get in-language name of type.
builtinTypeName :: BuiltinType -> String
Kenton Varda's avatar
Kenton Varda committed
104
builtinTypeName = Maybe.fromJust . List.stripPrefix "Builtin" . show
105 106 107 108 109 110 111 112 113 114 115 116 117 118

data ValueDesc = VoidDesc
               | BoolDesc Bool
               | Int8Desc Int8
               | Int16Desc Int16
               | Int32Desc Int32
               | Int64Desc Int64
               | UInt8Desc Word8
               | UInt16Desc Word16
               | UInt32Desc Word32
               | UInt64Desc Word64
               | Float32Desc Float
               | Float64Desc Double
               | TextDesc String
Kenton Varda's avatar
Kenton Varda committed
119 120 121 122
               | DataDesc ByteString
               | EnumValueValueDesc EnumValueDesc
               | StructValueDesc [(FieldDesc, ValueDesc)]
               | ListDesc [ValueDesc]
123 124
               deriving (Show)

125
valueString VoidDesc = "void"
126 127 128 129 130 131 132 133 134 135 136 137
valueString (BoolDesc    b) = if b then "true" else "false"
valueString (Int8Desc    i) = show i
valueString (Int16Desc   i) = show i
valueString (Int32Desc   i) = show i
valueString (Int64Desc   i) = show i
valueString (UInt8Desc   i) = show i
valueString (UInt16Desc  i) = show i
valueString (UInt32Desc  i) = show i
valueString (UInt64Desc  i) = show i
valueString (Float32Desc x) = show x
valueString (Float64Desc x) = show x
valueString (TextDesc    s) = show s
Kenton Varda's avatar
Kenton Varda committed
138 139 140 141 142
valueString (DataDesc    s) = show (map (chr . fromIntegral) s)
valueString (EnumValueValueDesc v) = enumValueName v
valueString (StructValueDesc l) = "(" ++  delimit ", " (map assignmentString l) ++ ")" where
    assignmentString (field, value) = fieldName field ++ " = " ++ valueString value
valueString (ListDesc l) = "[" ++ delimit ", " (map valueString l) ++ "]" where
143 144 145

data TypeDesc = BuiltinType BuiltinType
              | EnumType EnumDesc
Kenton Varda's avatar
Kenton Varda committed
146
              | StructType StructDesc
147 148 149
              | InterfaceType InterfaceDesc
              | ListType TypeDesc

150 151 152 153 154 155 156 157 158
data PackingState = PackingState
    { packingHole1 :: Integer
    , packingHole8 :: Integer
    , packingHole16 :: Integer
    , packingHole32 :: Integer
    , packingDataSize :: Integer
    , packingReferenceCount :: Integer
    }

159 160
packingSize PackingState { packingDataSize = ds, packingReferenceCount = rc } = ds + rc

161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176
-- Represents the current packing state of a union.  The parameters are:
-- - The offset of a 64-bit word in the data segment allocated to the union.
-- - The offset of a reference allocated to the union.
-- - The offset of a smaller piece of the data segment allocated to the union.  Such a smaller
--   piece exists if one field in the union has lower number than the union itself -- in this case,
--   this is the piece that had been allocated to that field, and is now retroactively part of the
--   union.
data UnionPackingState = UnionPackingState
    { unionPackDataOffset :: Maybe Integer
    , unionPackReferenceOffset :: Maybe Integer
    , unionPackRetroactiveSlot :: Maybe (Integer, FieldSize)
    }

data FieldSize = Size0 | Size1 | Size8 | Size16 | Size32 | Size64 | SizeReference
               | SizeInlineComposite Integer Integer

177 178 179 180
isDataFieldSize SizeReference = False
isDataFieldSize (SizeInlineComposite _ _) = False
isDataFieldSize _ = True

181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231
fieldSize (BuiltinType BuiltinVoid) = Size0
fieldSize (BuiltinType BuiltinBool) = Size1
fieldSize (BuiltinType BuiltinInt8) = Size8
fieldSize (BuiltinType BuiltinInt16) = Size16
fieldSize (BuiltinType BuiltinInt32) = Size32
fieldSize (BuiltinType BuiltinInt64) = Size64
fieldSize (BuiltinType BuiltinUInt8) = Size8
fieldSize (BuiltinType BuiltinUInt16) = Size16
fieldSize (BuiltinType BuiltinUInt32) = Size32
fieldSize (BuiltinType BuiltinUInt64) = Size64
fieldSize (BuiltinType BuiltinFloat32) = Size32
fieldSize (BuiltinType BuiltinFloat64) = Size64
fieldSize (BuiltinType BuiltinText) = SizeReference
fieldSize (BuiltinType BuiltinData) = SizeReference
fieldSize (EnumType _) = Size16  -- TODO: ??
fieldSize (StructType _) = SizeReference
fieldSize (InterfaceType _) = SizeReference
fieldSize (ListType _) = SizeReference

fieldValueSize VoidDesc = Size0
fieldValueSize (BoolDesc _) = Size1
fieldValueSize (Int8Desc _) = Size8
fieldValueSize (Int16Desc _) = Size16
fieldValueSize (Int32Desc _) = Size32
fieldValueSize (Int64Desc _) = Size64
fieldValueSize (UInt8Desc _) = Size8
fieldValueSize (UInt16Desc _) = Size16
fieldValueSize (UInt32Desc _) = Size32
fieldValueSize (UInt64Desc _) = Size64
fieldValueSize (Float32Desc _) = Size32
fieldValueSize (Float64Desc _) = Size64
fieldValueSize (TextDesc _) = SizeReference
fieldValueSize (DataDesc _) = SizeReference
fieldValueSize (EnumValueValueDesc _) = Size16
fieldValueSize (StructValueDesc _) = SizeReference
fieldValueSize (ListDesc _) = SizeReference

elementSize (StructType StructDesc { structPacking =
        PackingState { packingDataSize = ds, packingReferenceCount = rc } }) =
    SizeInlineComposite ds rc
elementSize t = fieldSize t

sizeInBits Size0 = 0
sizeInBits Size1 = 1
sizeInBits Size8 = 8
sizeInBits Size16 = 16
sizeInBits Size32 = 32
sizeInBits Size64 = 64
sizeInBits SizeReference = 64
sizeInBits (SizeInlineComposite d r) = (d + r) * 64

232 233 234 235
-- Render the type descriptor's name as a string, appropriate for use in the given scope.
typeName :: Desc -> TypeDesc -> String
typeName _ (BuiltinType t) = builtinTypeName t  -- TODO:  Check for shadowing.
typeName scope (EnumType desc) = descQualifiedName scope (DescEnum desc)
Kenton Varda's avatar
Kenton Varda committed
236
typeName scope (StructType desc) = descQualifiedName scope (DescStruct desc)
237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263
typeName scope (InterfaceType desc) = descQualifiedName scope (DescInterface desc)
typeName scope (ListType t) = "List(" ++ typeName scope t ++ ")"

-- Computes the qualified name for the given descriptor within the given scope.
-- At present the scope is only used to determine whether the target is in the same file.  If
-- not, an "import" expression is used.
-- This could be made fancier in a couple ways:
-- 1) Drop the common prefix between scope and desc to form a minimal relative name.  Note that
--    we'll need to check for shadowing.
-- 2) Examine aliases visible in the current scope to see if they refer to a prefix of the target
--    symbol, and use them if so.  A particularly important case of this is imports -- typically
--    the import will have an alias in the file scope.
descQualifiedName :: Desc -> Desc -> String
descQualifiedName (DescFile scope) (DescFile desc) =
    if fileName scope == fileName desc
        then ""
        else printf "import \"%s\"" (fileName desc)
descQualifiedName (DescFile scope) desc = printf "%s.%s" parent (descName desc) where
    parent = descQualifiedName (DescFile scope) (descParent desc)
descQualifiedName scope desc = descQualifiedName (descParent scope) desc

data FileDesc = FileDesc
    { fileName :: String
    , fileImports :: [FileDesc]
    , fileAliases :: [AliasDesc]
    , fileConstants :: [ConstantDesc]
    , fileEnums :: [EnumDesc]
Kenton Varda's avatar
Kenton Varda committed
264
    , fileStructs :: [StructDesc]
265 266 267 268
    , fileInterfaces :: [InterfaceDesc]
    , fileOptions :: OptionMap
    , fileMemberMap :: MemberMap
    , fileImportMap :: Map.Map String FileDesc
Kenton Varda's avatar
Kenton Varda committed
269
    , fileStatements :: [CompiledStatement]
270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290
    }

data AliasDesc = AliasDesc
    { aliasName :: String
    , aliasParent :: Desc
    , aliasTarget :: Desc
    }

data ConstantDesc = ConstantDesc
    { constantName :: String
    , constantParent :: Desc
    , constantType :: TypeDesc
    , constantValue :: ValueDesc
    }

data EnumDesc = EnumDesc
    { enumName :: String
    , enumParent :: Desc
    , enumValues :: [EnumValueDesc]
    , enumOptions :: OptionMap
    , enumMemberMap :: MemberMap
Kenton Varda's avatar
Kenton Varda committed
291
    , enumStatements :: [CompiledStatement]
292 293 294 295
    }

data EnumValueDesc = EnumValueDesc
    { enumValueName :: String
Kenton Varda's avatar
Kenton Varda committed
296
    , enumValueParent :: EnumDesc
297 298
    , enumValueNumber :: Integer
    , enumValueOptions :: OptionMap
Kenton Varda's avatar
Kenton Varda committed
299
    , enumValueStatements :: [CompiledStatement]
300 301
    }

Kenton Varda's avatar
Kenton Varda committed
302 303 304
data StructDesc = StructDesc
    { structName :: String
    , structParent :: Desc
305
    , structPacking :: PackingState
Kenton Varda's avatar
Kenton Varda committed
306
    , structFields :: [FieldDesc]
307
    , structUnions :: [UnionDesc]
Kenton Varda's avatar
Kenton Varda committed
308 309 310 311 312 313 314
    , structNestedAliases :: [AliasDesc]
    , structNestedConstants :: [ConstantDesc]
    , structNestedEnums :: [EnumDesc]
    , structNestedStructs :: [StructDesc]
    , structNestedInterfaces :: [InterfaceDesc]
    , structOptions :: OptionMap
    , structMemberMap :: MemberMap
Kenton Varda's avatar
Kenton Varda committed
315
    , structStatements :: [CompiledStatement]
316 317 318 319 320 321

    -- Don't use these directly, use the members of FieldDesc and UnionDesc.
    -- These fields are exposed here only because I was too lazy to create a way to pass them on
    -- the side when compiling members of a struct.
    , structFieldPackingMap :: Map.Map Integer (Integer, PackingState)
    , structUnionPackingMap :: Map.Map Integer UnionPackingState
322 323
    }

Kenton Varda's avatar
Kenton Varda committed
324 325 326 327
data UnionDesc = UnionDesc
    { unionName :: String
    , unionParent :: StructDesc
    , unionNumber :: Integer
328 329 330 331 332
    , unionTagOffset :: Integer
    , unionTagPacking :: PackingState
    , unionDataOffset :: Maybe Integer
    , unionReferenceOffset :: Maybe Integer
    , unionRetroactiveSlot :: Maybe (Integer, FieldSize)
Kenton Varda's avatar
Kenton Varda committed
333 334 335 336 337
    , unionFields :: [FieldDesc]
    , unionOptions :: OptionMap
    , unionStatements :: [CompiledStatement]
    }

338 339
data FieldDesc = FieldDesc
    { fieldName :: String
Kenton Varda's avatar
Kenton Varda committed
340
    , fieldParent :: StructDesc
341
    , fieldNumber :: Integer
342 343
    , fieldOffset :: Integer
    , fieldPacking :: PackingState    -- PackingState for the struct *if* this were the final field.
Kenton Varda's avatar
Kenton Varda committed
344
    , fieldUnion :: Maybe UnionDesc
345 346 347
    , fieldType :: TypeDesc
    , fieldDefaultValue :: Maybe ValueDesc
    , fieldOptions :: OptionMap
Kenton Varda's avatar
Kenton Varda committed
348
    , fieldStatements :: [CompiledStatement]
349 350 351 352 353 354 355 356 357
    }

data InterfaceDesc = InterfaceDesc
    { interfaceName :: String
    , interfaceParent :: Desc
    , interfaceMethods :: [MethodDesc]
    , interfaceNestedAliases :: [AliasDesc]
    , interfaceNestedConstants :: [ConstantDesc]
    , interfaceNestedEnums :: [EnumDesc]
Kenton Varda's avatar
Kenton Varda committed
358
    , interfaceNestedStructs :: [StructDesc]
359 360 361
    , interfaceNestedInterfaces :: [InterfaceDesc]
    , interfaceOptions :: OptionMap
    , interfaceMemberMap :: MemberMap
Kenton Varda's avatar
Kenton Varda committed
362
    , interfaceStatements :: [CompiledStatement]
363 364 365 366
    }

data MethodDesc = MethodDesc
    { methodName :: String
Kenton Varda's avatar
Kenton Varda committed
367
    , methodParent :: InterfaceDesc
368 369 370 371
    , methodNumber :: Integer
    , methodParams :: [(String, TypeDesc, Maybe ValueDesc)]
    , methodReturnType :: TypeDesc
    , methodOptions :: OptionMap
Kenton Varda's avatar
Kenton Varda committed
372
    , methodStatements :: [CompiledStatement]
373 374 375 376 377
    }

type OptionMap = Map.Map String OptionAssignmentDesc

data OptionAssignmentDesc = OptionAssignmentDesc
Kenton Varda's avatar
Kenton Varda committed
378 379
    { optionAssignmentParent :: Desc
    , optionAssignmentOption :: OptionDesc
380 381 382 383 384 385 386 387 388 389 390
    , optionAssignmentValue :: ValueDesc
    }

data OptionDesc = OptionDesc
    { optionName :: String
    , optionParent :: Desc
    , optionId :: String
    , optionType :: TypeDesc
    , optionDefaultValue :: Maybe ValueDesc
    }

Kenton Varda's avatar
Kenton Varda committed
391 392 393
data CompiledStatement = CompiledMember Desc
                       | CompiledOption OptionAssignmentDesc

394 395
-- TODO:  Print options as well as members.  Will be ugly-ish.
descToCode :: String -> Desc -> String
Kenton Varda's avatar
Kenton Varda committed
396
descToCode indent (DescFile desc) = concatMap (statementToCode indent) (fileStatements desc)
397 398 399 400 401 402 403
descToCode indent (DescAlias desc) = printf "%susing %s = %s;\n" indent
    (aliasName desc)
    (descQualifiedName (aliasParent desc) (aliasTarget desc))
descToCode indent (DescConstant desc) = printf "%sconst %s: %s = %s;\n" indent
    (constantName desc)
    (typeName (constantParent desc) (constantType desc))
    (valueString (constantValue desc))
Kenton Varda's avatar
Kenton Varda committed
404
descToCode indent (DescEnum desc) = printf "%senum %s%s" indent
405
    (enumName desc)
Kenton Varda's avatar
Kenton Varda committed
406 407 408 409
    (blockCode indent (enumStatements desc))
descToCode indent (DescEnumValue desc) = printf "%s%s = %d%s" indent
    (enumValueName desc) (enumValueNumber desc) (maybeBlockCode indent $ enumValueStatements desc)
descToCode indent (DescStruct desc) = printf "%sstruct %s%s" indent
Kenton Varda's avatar
Kenton Varda committed
410
    (structName desc)
Kenton Varda's avatar
Kenton Varda committed
411
    (blockCode indent (structStatements desc))
412
descToCode indent (DescField desc) = printf "%s%s@%d%s: %s%s;  # %s\n" indent
413
    (fieldName desc) (fieldNumber desc)
Kenton Varda's avatar
Kenton Varda committed
414 415
    (case fieldUnion desc of { Nothing -> ""; Just u -> " in " ++ unionName u})
    (typeName (DescStruct (fieldParent desc)) (fieldType desc))
416
    (case fieldDefaultValue desc of { Nothing -> ""; Just v -> " = " ++ valueString v; })
417 418 419 420
    (case fieldSize $ fieldType desc of
        SizeReference -> printf "ref[%d]" $ fieldOffset desc
        SizeInlineComposite _ _ -> "??"
        s -> let
421
            bits = sizeInBits s
422 423 424 425
            offset = fieldOffset desc
            in printf "bits[%d, %d)" (offset * bits) ((offset + 1) * bits))
--    (maybeBlockCode indent $ fieldStatements desc)
descToCode indent (DescUnion desc) = printf "%sunion %s@%d;  # [%d, %d)\n" indent
Kenton Varda's avatar
Kenton Varda committed
426
    (unionName desc) (unionNumber desc)
427 428
    (unionTagOffset desc * 8) (unionTagOffset desc * 8 + 8)
--    (maybeBlockCode indent $ unionStatements desc)
Kenton Varda's avatar
Kenton Varda committed
429
descToCode indent (DescInterface desc) = printf "%sinterface %s%s" indent
430
    (interfaceName desc)
Kenton Varda's avatar
Kenton Varda committed
431 432
    (blockCode indent (interfaceStatements desc))
descToCode indent (DescMethod desc) = printf "%s%s@%d(%s): %s%s" indent
433
    (methodName desc) (methodNumber desc)
Kenton Varda's avatar
Kenton Varda committed
434
    (delimit ", " (map paramToCode (methodParams desc)))
Kenton Varda's avatar
Kenton Varda committed
435
    (typeName scope (methodReturnType desc))
Kenton Varda's avatar
Kenton Varda committed
436
    (maybeBlockCode indent $ methodStatements desc) where
Kenton Varda's avatar
Kenton Varda committed
437 438
        scope = DescInterface (methodParent desc)
        paramToCode (name, t, Nothing) = printf "%s: %s" name (typeName scope t)
439
        paramToCode (name, t, Just v) = printf "%s: %s = %s"
Kenton Varda's avatar
Kenton Varda committed
440
            name (typeName scope t) (valueString v)
441 442 443 444
descToCode _ (DescOption _) = error "options not implemented"
descToCode _ (DescBuiltinType _) = error "Can't print code for builtin type."
descToCode _ DescBuiltinList = error "Can't print code for builtin type."

Kenton Varda's avatar
Kenton Varda committed
445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460
statementToCode :: String -> CompiledStatement -> String
statementToCode indent (CompiledMember desc) = descToCode indent desc
statementToCode indent (CompiledOption desc) = printf "%s%s.%s = %s;\n" indent
    (descQualifiedName (optionAssignmentParent desc) $ optionParent $ optionAssignmentOption desc)
    (optionName $ optionAssignmentOption desc)
    (valueString (optionAssignmentValue desc))

maybeBlockCode :: String -> [CompiledStatement] -> String
maybeBlockCode _ [] = ";\n"
maybeBlockCode indent statements = blockCode indent statements

blockCode :: String -> [CompiledStatement] -> String
blockCode indent statements = printf " {\n%s%s}\n"
    (concatMap (statementToCode ("  " ++ indent)) statements)
    indent

461 462 463 464 465
instance Show FileDesc where { show desc = descToCode "" (DescFile desc) }
instance Show AliasDesc where { show desc = descToCode "" (DescAlias desc) }
instance Show ConstantDesc where { show desc = descToCode "" (DescConstant desc) }
instance Show EnumDesc where { show desc = descToCode "" (DescEnum desc) }
instance Show EnumValueDesc where { show desc = descToCode "" (DescEnumValue desc) }
Kenton Varda's avatar
Kenton Varda committed
466
instance Show StructDesc where { show desc = descToCode "" (DescStruct desc) }
467 468 469
instance Show FieldDesc where { show desc = descToCode "" (DescField desc) }
instance Show InterfaceDesc where { show desc = descToCode "" (DescInterface desc) }
instance Show MethodDesc where { show desc = descToCode "" (DescMethod desc) }