Constraints and Monads

As discussed last night, I've hit a problem with the type for decoding
SEQUENCE.

1. I have a function for decoding INTEGER.

> > (MonadError [Char] (t1 BG.BitGet), MonadTrans t1, Monad t) =>
> > t IntegerConstraint -> Bool -> t IntegerConstraint -> t (t1 BG.BitGet InfInteger)

As you can see the constraints live inside a monad as they may fail.

2. I have an auxialliary function for SEQUENCE. It takes a bit map and a
SEQUENCE and returns either an error or action (which when evaluated
will decode the bits). Note that the monad has become concrete as m =
Either String.

> > fromSequenceAuz :: (MonadTrans t, MonadError [Char] (t BG.BitGet)) => [Bool] -> Sequence a -> Either String (t BG.BitGet a)

In other words, this is

> > fromSequenceAuz :: (MonadTrans t, MonadError [Char] (t BG.BitGet)) => [Bool] -> Sequence a -> m (t BG.BitGet a)

but there'd probably need to be some extra constraints on m.

3. I have a function which returns (an action which when run returns)
the bit mask

> > Int -> BG.BitGet [Bool]

4. Here's where I have a problem. I can't "extract" the bit map from the
BG.BitGet monad (what I mean by extract is x <- bitMask 3 for example)
until I have extracted the action to run the decoding (fromSequenceAuz).
But I can't run this until I have the bit map.

Having spent all day yesterday on this, I think the answer is that we
should run the constraint monad before even attempting decoding whereas
at the moment I try to delay the constraint monad and evaluate it at the
last possible moment. I think this is the right approach. After all we
know the constraints are valid or invalid before we start decoding so
there's no point in doing any decoding work only to find out that the
constraints were invalid in the first place.

This will also make the code simpler. For example, the type signature
for decoding INTEGER would now be

> > (MonadError [Char] (t1 BG.BitGet), MonadTrans t1, Monad t) =>
> > IntegerConstraint -> Bool -> IntegerConstraint -> (t1 BG.BitGet InfInteger)

and there would be one less level of "do <- " in the function definition.

I'm inclined to do something like this (although I haven't quite thought
it through)

> > forget :: (MonadTrans t, MonadError [Char] (t BG.BitGet)) => Either String (t BG.BitGet a) -> t BG.BitGet a
> > forget (Left e) = throwError e
> > forget (Right x) = x

So the constraint error percolates through the (transformed) BitGet
monad and no decoding actually gets done.

A further thought: currently the error monad for throwError is just a
string. I think it would be better to have our own error monad with e.g.

data OurError = ConstraintError String | DecodeError String

then we can distinguish what sort of error caused the failure.

Thoughts?

Haddock and HPC

I'm sure I cannot be using haddock correctly. Here's what I currently use to get it to work:

haddock -h Integer.hs -B /usr/lib/ghc-6.8.2 
--optghc=-i/home/dom/backup/asn15/binary-strict_0/src 
--optghc=-i/home/dom/backup/asn15/asn1            

And here's how I'm using HPC:

ghc-6.8.2 -fhpc Tests/Main.hs --make -i../binary-strict/src
rm Main.tix
hpc report Main
hpc markup Main

Object Class Experiment

If you type

prettyOC1 x

at the command line you get

Fixed Type Value Set Errors BOOLEAN
Information Object other function
Variable Type Value Set Supported Arguments {Type ArgumentType}
Fixed Type Value Set Alphabet IA5STRING
Variable Type Value result-if-error {Type ResultType}
Type ResultType
Fixed Type Value code INTEGER
Type ArgumentType

The code is in Example.hs in the darcs repository.

import Text.PrettyPrint

data ZeroTuple = ZeroTuple
data Tuple e es = Tuple e es

newtype IA5String = IA5String {unIA5String :: String}

data ASNType :: * -> * where
   BOOLEAN   :: ASNType Bool
   INTEGER   :: ASNType Integer
   IA5STRING :: ASNType IA5String

prettyType :: ASNType a -> Doc
prettyType BOOLEAN   = text "BOOLEAN"
prettyType INTEGER   = text "INTEGER"
prettyType IA5STRING = text "IA5STRING"


data UbjClass :: * where
   USingleton :: UbjClassComponent -> UbjClass
   UCons      :: UbjClassComponent -> UbjClass -> UbjClass

type FieldName = String
   
data UbjClassComponent :: * where
   UCFTV :: FieldName -> ASNType a -> UbjClassComponent
   UCIO  :: FieldName -> UbjClass -> UbjClassComponent

uF2 = UCFTV "code" INTEGER

uF = UCons (UCIO "another" uF) (USingleton uF2)

data ObjClass :: * -> * where
   Singleton :: ObjClassComponent a -> ObjClass a
   Cons      :: ObjClassComponent a -> ObjClass l -> ObjClass (Tuple a l)
   Lift      :: Mu a l -> ObjClass (Mu a l)

data ObjClassComponent :: * -> * where
   OCFTV :: FieldName -> ASNType a -> ObjClassComponent a
   OCIO  :: FieldName -> ObjClass a -> ObjClassComponent a

oF2 = OCFTV "code" INTEGER

oF = Lift (Inl (Cons (OCIO "another" oF) (Singleton oF2)))

oG = Lift (Inr (Cons oF2 (Singleton (OCIO "another" oG))))

oH = Lift (Inl (Cons (OCIO "another" oH) (Cons oF2 (Singleton oF2))))

oJ = Cons ((OCIO "bar") $ oH) (Singleton  . (OCIO "foo") $ oH) 

oK = Lift (Inr (Cons oF2 (Lift (Inl (Cons (OCIO "foo" oK) (Singleton oF2))))))

data Mu :: * -> * -> * where
   Inl :: ObjClass (Tuple (Mu a b) b) -> Mu a b
   Inr :: ObjClass (Tuple a (Mu a b)) -> Mu a b

prettyOCC :: ObjClassComponent a -> String
prettyOCC (OCFTV fn ty) = fn ++ " " ++ prettyASN ty
prettyOCC (OCIO fn oc)  = fn

prettyASN :: ASNType a -> String
prettyASN BOOLEAN = "BOOLEAN"
prettyASN INTEGER = "INTEGER"

prettyOC :: ObjClass a -> String
prettyOC (Singleton occ) = prettyOCC occ
prettyOC (Cons occ oc) = prettyOCC occ ++ " " ++ prettyOC oc
prettyOC (Lift mu) = prettyMu mu

prettyMu :: Mu a b -> String
prettyMu (Inl oc) = prettyOC oc
prettyMu (Inr oc) = prettyOC oc

data ObjClassComponent1 :: * -> * where
   OCType :: FieldName -> ObjClassComponent1 a
   OCFixedTypeValue :: FieldName -> ASNType a -> ObjClassComponent1 a
   OCVariableTypeValue :: FieldName -> ObjClassComponent1 a -> ObjClassComponent1 a
   OCFixedTypeValueSet :: FieldName -> ASNType a -> ObjClassComponent1 a
   OCVariableTypeValueSet :: FieldName -> ObjClassComponent1 a -> ObjClassComponent1 a
   OCInformationObject :: FieldName -> ObjClass1 a -> ObjClassComponent1 a

data ObjClass1 :: * -> * where
   Singleton1 :: ObjClassComponent1 a -> ObjClass1 a
   Cons1      :: ObjClassComponent1 a -> ObjClass1 l -> ObjClass1 (Tuple a l)
   Lift1      :: Mu1 a l -> ObjClass1 (Mu1 a l)

data Mu1 :: * -> * -> * where
   Inl1 :: ObjClass1 (Tuple (Mu1 a b) b) -> Mu1 a b
   Inr1 :: ObjClass1 (Tuple a (Mu1 a b)) -> Mu1 a b

{-

The definition in Haskell below is very similar to the one on page 314 in
Dubuisson which is reproduced below.

OTHER-FUNCTION ::= CLASS {
  &code                INTEGER (0..MAX) UNIQUE,
  &Alphabet            BMPString
    DEFAULT {Latin1 INTERSECTION Level1},
  &ArgumentType        ,
  &SupportedArguments &ArgumentType OPTIONAL,
  &ResultType          DEFAULT NULL,
  &result-if-error     &ResultType DEFAULT NULL,
  &associated-function OTHER-FUNCTION OPTIONAL,
  &Errors              ERROR DEFAULT
    {rejected-argument | memory-fault} }

-}

x1 = OCType "ArgumentType"
x2 = OCFixedTypeValue "code" INTEGER
x3 = OCType "ResultType"
x4 = OCVariableTypeValue "result-if-error" x3
x5 = OCFixedTypeValueSet "Alphabet" IA5STRING
x6 = OCVariableTypeValueSet "Supported Arguments" x1
x7 = OCFixedTypeValueSet "Errors" BOOLEAN

x = Lift1 (Inr1 (Cons1 x7 (Lift1 (Inl1 (Cons1 (OCInformationObject "other function" x) (Cons1 x6 (Cons1 x5 (Cons1 x4 (Cons1 x3 (Cons1 x2 (Singleton1 x1)))))))))))

printObjClassComp (OCType fn) = text "Type" <+> text fn
printObjClassComp (OCFixedTypeValue fn t) = text "Fixed Type Value" <+> text fn <+> prettyType t
printObjClassComp (OCVariableTypeValue fn c) = text "Variable Type Value" <+> text fn <+> braces (printObjClassComp c)
printObjClassComp (OCFixedTypeValueSet fn t) = text "Fixed Type Value Set" <+> text fn <+> prettyType t
printObjClassComp (OCVariableTypeValueSet fn c) = text "Variable Type Value Set" <+> text fn <+> braces (printObjClassComp c)
printObjClassComp (OCInformationObject fn oc)  = text "Information Object" <+> text fn

prettyOC1 :: ObjClass1 a -> Doc
prettyOC1 (Singleton1 occ) = printObjClassComp occ
prettyOC1 (Cons1 occ oc) = printObjClassComp occ $$ prettyOC1 oc
prettyOC1 (Lift1 mu) = prettyMu1 mu

prettyMu1 :: Mu1 a b -> Doc
prettyMu1 (Inl1 oc) = prettyOC1 oc
prettyMu1 (Inr1 oc) = prettyOC1 oc

Inter-operability Testing

Given that asn1c can't cope with entirely random (although legal) ASN.1, I've had to move away from using QuickCheck (for that particular purpose). I'm now going to use the unit tests to test inter-operability. Running main in Run.hs will:

• generate ASN.1


• run asn1c


• generate C to encode a value


• compile the C


• run the C (encoding the value)


• decode the value

I haven't yet put in code to check that the decoded value equals the original value.

It would be useful to be able to generate and encode values for multiple types rather than creating all the asn1c overhead for each type.

Upgrading System

As a test, I've generated some ASN.1 and C. Unfortunately, asn1c gives an error for PER encoding with this but not for BER encoding :-(

FooBar {1 2 3 4 5 6} DEFINITIONS ::=
 BEGIN
   Integer5 ::= INTEGER (-1..MAX)
   value1 Integer5 ::= 4096
 END

#include ?stdio.h>   /* for stdout */
#include  ?stdlib.h> /* for malloc () */
#include  ?assert.h> /* for run-time control */
#include ?integer5.h> /* Integer5 ASN.1 type */

/*
* This is a custom function which writes the
* encoded output into some FILE stream.
*/

static int
write_out(const void *buffer, size_t size, void *app_key) {
    FILE *out_fp = app_key;
    size_t wrote;
    wrote = fwrite(buffer, 1, size, out_fp);
    return (wrote == size) ? 0 : -1;
}

int main(int ac, char **av) {
 
 /* Encoder return value */
 asn_enc_rval_t ec;
 
 
 /* Declare a pointer to a Integer5 type */
 Integer5_t *integer5;
 
 /* Allocate an instance of  Integer5 */
 integer5 = calloc(1, sizeof(Integer5_t)); /* not malloc! */
 assert(integer5); /* Assume infinite memory */
 
 (*integer5) = 4097;
 
 if(ac < filename =" av[1];" fp =" fopen(filename," ec =" uper_encode(&asn_DEF_Integer5,integer5,write_out,fp);" encoded ="="">name : "unknown");
      exit(65); /* better, EX_DATAERR */
      } else {
      fprintf(stderr,"Created %s with PER encoded Integer5\n",filename);
      }
      fclose(fp);
 }
 /* Also print the constructed ???? XER encoded (XML) */
 xer_fprint(stdout,&asn_DEF_Integer5,integer5);
 return 0; /* Encoding finished successfully */
}

We may need this:

dom@heisenberg:~/asn15/asn1> darcs whatsnew
{
hunk ./UnitTest.lhs 33
+import qualified Data.Binary.Strict.Util   as BU
+
+bar = BU.hexDump
+bax = BU.hexDumpString
}

ASN.1 Library Starts to Use Bytestrings

You'll need this to make the latest Constrained.lhs compile.

LaTeX in Blog

This seems quite straightforward but given some of the characters get turned into ASCII(?), it might be hard to edit.

Binary Put

*Main> let (_,r,_,_) = runBitPut (ennb (2^33-4,2^33-1)) in r
Chunk "00000000  ff ff ff fe 00                                    .....\n" Empty
*Main> let (_,r,_,_) = runBitPut (bar (reverse (encodeNNBIntBits (2^33-4,2^33-1)))) in r
Chunk "00000000  ff ff ff fe 00                                    .....\n" Empty
*Main>

I've been monkeying around with writing (and reading) ByteStrings as
these are much more efficient than what we are using now ([Word8] where
each Word8 is 0 or 1.

We should be able to write e.g this

let (_,r,_,_) = runBitPut (bar (reverse (encodeNNBIntBits
(233-1,233-1)))) in r

to a file. Note that ennb (ByteString equivalent of encodeNNBIntBits) is
actually a bit simpler.

I stole some of the code from Adam Langley. I'll try and email him this
week to suggest adding e.g. writeN to his library.

module Main where

import qualified Data.ByteString as B
import Data.Word
import Data.Bits
import IO
import Data.List

import qualified Data.Binary.Strict.BitGet as BG

import qualified Data.ByteString.Char8 as BC
import Data.ByteString.Internal (w2c)
import qualified Data.ByteString.Lazy.Char8 as BLC

import Text.Printf (printf)


t :: (Eq a, Show a) => [Word8] -> BG.BitGet a -> a -> Bool
t bytes m v = if result == v then True else error (show (bytes, v, result)) where
  Right result = BG.runBitGet (B.pack bytes) m

foos 0 = return []
foos n =
   do x <- BG.getBit
      xs <- foos (n-1)
      return (x:xs)

foos8 0 = return []
foos8 n =
   do x <- BG.getWord8
      xs <- foos8 (n-1)
      return (x:xs)

test =
   do h <- openFile "foobarbaz" ReadMode
      b <- B.hGetContents h
      let ebms = test2 b 
      case ebms of
         Left s    -> return s
         Right bms -> return (concat ((map (show . B.unpack) bms)))

test1 =
   do bm1 <- BG.getRightByteString 2
      bm2 <- BG.getRightByteString 2
      return [bm1,bm2]
      
test2 bs = BG.runBitGet bs test1
      
data S = S {-# UNPACK #-} !B.ByteString  -- ^ output
           {-# UNPACK #-} !Word8  -- ^ bit offset in current byte
           {-# UNPACK #-} !Word8  -- ^ current byte

newtype PutBit a = PutBit { unPut :: S -> (a,S) }

instance Functor PutBit where
   fmap f m = PutBit (\s -> let (a,s') = unPut m s in (f a,s'))

instance Monad PutBit where
   return a = PutBit (\s -> (a,s))
   m >>= k = PutBit (\s -> let (a,s')  = unPut m s in unPut (k a) s')

get :: PutBit S
get = PutBit (\s -> (s,s))

put :: S -> PutBit ()
put s = PutBit (const ((), s))

writeN :: Word8 -> PutBit ()
writeN n =
   do S bytes boff curr <- get
      let bit = n .&. 0x01
          newCurr = curr .|. (shiftL bit (fromIntegral boff))
          newBoff = boff + 1
      if newBoff == 9
         then put (S (B.cons curr bytes) 1 bit)
         else put (S bytes newBoff newCurr)

foo = do writeN 1
         writeN 0
         writeN 1
         writeN 0
         writeN 1
         writeN 0
         writeN 1
         writeN 0
         writeN 1
         writeN 0
         writeN 1
         writeN 0
         writeN 1

bar [] = return ()
bar (x:xs) = do writeN x
                bar xs

runBitPut m =
   let (_,s) = unPut m (S B.empty 0 0) 
       (S bytes boff curr) = s
       allBits = B.cons curr bytes
   in 
      (hexDumpString allBits,hexDumpString (leftShift (fromIntegral (8-boff)) allBits),boff,curr)

leftShift :: Int -> B.ByteString -> B.ByteString
leftShift 0 = id
leftShift n = snd . B.mapAccumR f 0 where
  f acc b = (b `shiftR` (8 - n), (b `shiftL` n) .|. acc)
 
ennb :: (Integer,Integer) -> PutBit ()
ennb = mUnfoldr h

h (_,0) = Nothing
h (0,w) = Just (0, (0, w `div` 2))
h (n,w) = Just (fromIntegral (n `mod` 2), (n `div` 2, w `div` 2))
 
mUnfoldr f b =
   case f b of
      Just (a,new_b) -> do writeN a
                           mUnfoldr f new_b
      Nothing -> return ()

type BitStream = [Word8]

encodeNNBIntOctets :: Integer -> BitStream
encodeNNBIntOctets =
   reverse . (map fromInteger) . flip (curry (unfoldr (uncurry g))) 8 where
      g 0 0 = Nothing
      g 0 p = Just (0,(0,p-1))
      g n 0 = Just (n `mod` 2,(n `div` 2,7))
      g n p = Just (n `mod` 2,(n `div` 2,p-1))

      
encodeNNBIntBits :: (Integer, Integer) -> BitStream
encodeNNBIntBits
    = reverse . (map fromInteger) . unfoldr h
      where
        h (_,0) = Nothing
        h (0,w) = Just (0, (0, w `div` 2))
        h (n,w) = Just (n `mod` 2, (n `div` 2, w `div` 2))

hexDumpString :: B.ByteString -> BLC.ByteString
hexDumpString = BLC.fromChunks . dumpLine (0 :: Int) where
  dumpLine offset bs
    | B.null bs = []
    | otherwise = line : (dumpLine (offset + 16) $ B.drop 16 bs) where
        line = s $ a ++ b ++ "  " ++ c ++ padding ++ right ++ newline
        s = BC.pack
        a = printf "%08x  " offset
        b = concat $ intersperse " " $ map (printf "%02x") $ B.unpack $ B.take 8 bs
        c = concat $ intersperse " " $ map (printf "%02x") $ B.unpack $ B.take 8 $ B.drop 8 bs
        padding = replicate paddingSize ' '
        paddingSize = 2 + (16 - (min 16 $ B.length bs)) * 3 - if B.length bs <= 8 then 1 else 0
        right = map safeChar $ B.unpack $ B.take 16 bs
        newline = "\n"
        safeChar c
          | c >= 32 && c <= 126 = w2c c
          | otherwise = '.'

The C being generated from this for the constrained BIT STRINGs is incorrect. The unused bits look distinctly squiffy.

FooBar {1 2 3 4 5 6} DEFINITIONS ::=
  BEGIN
    Type1 ::= CHOICE {element0 INTEGER}
    value1 Type1 ::= element0:1
    Type2 ::= BIT STRING (SIZE (1..2)) (SIZE (2..2))
    value2 Type2 ::= '01'B
    Type3 ::= INTEGER
    value3 Type3 ::= 3
    Type4 ::= BIT STRING
    value4 Type4 ::= '001'B
    Type5 ::= BIT STRING (SIZE (3..6)) (SIZE (6..6)) (SIZE (6..6))
    value5 Type5 ::= '010101'B
    Type6 ::= SEQUENCE {element1 BIT STRING (SIZE (3..3)) (SIZE (3..3)) (SIZE (3..3)),
                        element2 SEQUENCE {},
                        element3 CHOICE {element4 INTEGER}}
    value6 Type6 ::= {element1 '000'B,
                      element2 {},
                      element3 element4:0}
    Type7 ::= SEQUENCE {}
    value7 Type7 ::= {}
    Type8 ::= CHOICE {element5 [0] IMPLICIT SEQUENCE {element6 [1] IMPLICIT INTEGER},
                      element7 INTEGER}
    value8 Type8 ::= element5:{element6 2}
    Type9 ::= INTEGER
    value9 Type9 ::= -2
    Type10 ::= BIT STRING
    value10 Type10 ::= '0011'B
  END

  (*type1).present = Type1_PR_element0;
  (*type1).choice.element0 = 1;
   
   
  (*type2).buf = calloc (1, 1); /* 1 bytes */
  assert((*type2).buf);
  (*type2).size = 1;
  (*type2).buf[0] = 64;
  (*type2).bits_unused = 2; /* Trim unused bits */
   
  (*type3) = 3;
   
   
  (*type4).buf = calloc (1, 1); /* 1 bytes */
  assert((*type4).buf);
  (*type4).size = 1;
  (*type4).buf[0] = 32;
  (*type4).bits_unused = 3; /* Trim unused bits */
   
   
  (*type5).buf = calloc (1, 1); /* 1 bytes */
  assert((*type5).buf);
  (*type5).size = 1;
  (*type5).buf[0] = 84;
  (*type5).bits_unused = 6; /* Trim unused bits */
   
   
  (*type6).element1.buf = calloc (1, 1); /* 1 bytes */
  assert((*type6).element1.buf);
  (*type6).element1.size = 1;
  (*type6).element1.buf[0] = 0;
  (*type6).element1.bits_unused = 3; /* Trim unused bits */
  (*type6).element3.present = element3_PR_element4;
  (*type6).element3.choice.element4 = 0;
   
   
  (*type8).present = Type8_PR_element5;
  (*type8).choice.element5.element6 = 2;
   
  (*type9) = -2;
   
   
  (*type10).buf = calloc (1, 1); /* 1 bytes */
  assert((*type10).buf);
  (*type10).size = 1;
  (*type10).buf[0] = 48;
  (*type10).bits_unused = 4; /* Trim unused bits */

Now Generating C and ASN.1 for a Complete Random Module

We can now generate a random ASN.1 module, print out the ASN.1, generate C for it which after a bit of manipulation compiles having first run asn1c on the ASN.1. The next step is to generate the .asn1 and .c files automatically so there's no need for manual manipulation.

*Asn1cTest> quickC
FooBar {1 2 3 4 5 6} DEFINITIONS ::=
BEGIN
  Type1 ::= SEQUENCE {}
  value1 Type1 ::= {}
  Type2 ::= INTEGER
  value2 Type2 ::= -2
  Type3 ::= SEQUENCE {element0 CHOICE {element1 INTEGER},
                      element2 SEQUENCE {}}
  value3 Type3 ::= {element0 element1:1,
                    element2 {}}
  Type4 ::= CHOICE {element3 INTEGER}
  value4 Type4 ::= element3:4
  Type5 ::= SEQUENCE {}
  value5 Type5 ::= {}
  Type6 ::= INTEGER
  value6 Type6 ::= -2
  Type7 ::= INTEGER
  value7 Type7 ::= 3
  Type8 ::= SEQUENCE {element4 BIT STRING (SIZE (4..7)) (SIZE (4..6)) (SIZE (5..5)) (SIZE (5..5))}
  value8 Type8 ::= {element4 '01110'B}
  Type9 ::= INTEGER
  value9 Type9 ::= -3
  Type10 ::= SEQUENCE {}
  value10 Type10 ::= {}
END
Type1 ::= {}
Type2 ::= -2
Type3 ::= {element0 element1:1,
         element2 {}}
Type4 ::= element3:4
Type5 ::= {}
Type6 ::= -2
Type7 ::= 3
Type8 ::= {element4 '01110'B}
Type9 ::= -3
Type10 ::= {}
#include  /* Type1 ASN.1 type */
#include  /* Type2 ASN.1 type */
#include  /* Type3 ASN.1 type */
#include  /* Type4 ASN.1 type */
#include  /* Type5 ASN.1 type */
#include  /* Type6 ASN.1 type */
#include  /* Type7 ASN.1 type */
#include  /* Type8 ASN.1 type */
#include  /* Type9 ASN.1 type */
#include  /* Type10 ASN.1 type */

/* Declare a pointer to a Type1 type */
Type1_t *type1;

/* Allocate an instance of  Type1 */
type1 = calloc(1, sizeof(Type1_t)); /* not malloc! */
assert(type1); /* Assume infinite memory */

/* Declare a pointer to a Type2 type */
Type2_t *type2;

/* Allocate an instance of  Type2 */
type2 = calloc(1, sizeof(Type2_t)); /* not malloc! */
assert(type2); /* Assume infinite memory */

/* Declare a pointer to a Type3 type */
Type3_t *type3;

/* Allocate an instance of  Type3 */
type3 = calloc(1, sizeof(Type3_t)); /* not malloc! */
assert(type3); /* Assume infinite memory */

/* Declare a pointer to a Type4 type */
Type4_t *type4;

/* Allocate an instance of  Type4 */
type4 = calloc(1, sizeof(Type4_t)); /* not malloc! */
assert(type4); /* Assume infinite memory */

/* Declare a pointer to a Type5 type */
Type5_t *type5;

/* Allocate an instance of  Type5 */
type5 = calloc(1, sizeof(Type5_t)); /* not malloc! */
assert(type5); /* Assume infinite memory */

/* Declare a pointer to a Type6 type */
Type6_t *type6;

/* Allocate an instance of  Type6 */
type6 = calloc(1, sizeof(Type6_t)); /* not malloc! */
assert(type6); /* Assume infinite memory */

/* Declare a pointer to a Type7 type */
Type7_t *type7;

/* Allocate an instance of  Type7 */
type7 = calloc(1, sizeof(Type7_t)); /* not malloc! */
assert(type7); /* Assume infinite memory */

/* Declare a pointer to a Type8 type */
Type8_t *type8;

/* Allocate an instance of  Type8 */
type8 = calloc(1, sizeof(Type8_t)); /* not malloc! */
assert(type8); /* Assume infinite memory */

/* Declare a pointer to a Type9 type */
Type9_t *type9;

/* Allocate an instance of  Type9 */
type9 = calloc(1, sizeof(Type9_t)); /* not malloc! */
assert(type9); /* Assume infinite memory */

/* Declare a pointer to a Type10 type */
Type10_t *type10;

/* Allocate an instance of  Type10 */
type10 = calloc(1, sizeof(Type10_t)); /* not malloc! */
assert(type10); /* Assume infinite memory */

(*type2) = -2;

(*type3).element0.present = element0_PR_element1;
(*type3).element0.choice.element1 = 1;

(*type4).present = Type4_PR_element3;
(*type4).choice.element3 = 4;


(*type6) = -2;

(*type7) = 3;


(*type8).element4.buf = calloc (1, 1); /* 1 bytes */
assert((*type8).element4.buf);
(*type8).element4.size = 1;
(*type8).element4.buf[0] = 112;
(*type8).element4.bits_unused = 5; /* Trim unused bits */

(*type9) = -3;

Generating Memory Allocation for C Variables for the ASN.1 Types

There's now a function to generate the C memory allocation code for type assignments.

*Asn1cTest> declareTypePointer (TYPEASS "Type12" Nothing type12)

/* Declare a pointer to a Type12 type */
Type12_t *type12;

/* Allocate an instance of  Type12 */
type12 = calloc(1, sizeof(Type12_t)); /* not malloc! */
assert(type12); /* Assume infinite memory */

There's also a function to generate random type assignments and values but the formatting is not quite right for pretty / show. This may not matter (at the moment) as the next step is to generate C code to assign values to the C form of the ASN.1 types.

*Asn1cTest> genModule''
[Type1 ::= CHOICE {i INTEGER}: Type1 ::= i:1,
Type2 ::= CHOICE {xc INTEGER}: Type2 ::= xc:1,
Type3 ::= SEQUENCE {}: Type3 ::= {},
Type4 ::= CHOICE {k [1] IMPLICIT INTEGER,
                  h INTEGER}: Type4 ::= h:4,
Type5 ::= SEQUENCE {}: Type5 ::= {},
Type6 ::= CHOICE {a [5] IMPLICIT SEQUENCE {m [-3] IMPLICIT INTEGER},
                  m INTEGER}: Type6 ::= m:-3,
Type7 ::= BIT STRING (SIZE (5..6)) (SIZE (6..6)) (SIZE (6..6)): Type7 ::= '001110'B,
Type8 ::= BIT STRING: Type8 ::= '0010'B,
Type9 ::= INTEGER: Type9 ::= -9,
Type10 ::= INTEGER: Type10 ::= 6]

Phil's TexPertise

I've published Phil's response here so it's searchable for future reference. I couldn't publish it as a comment as blogger rejected something in the text below as a comment but strangely seems to accept it as a post.

Dom --- Have you thought of using either fancyvrb.sty or listings.sty ? fancyvrb is simpler but listings is very customizable. Rather than using the alltt package and embedding lots of LaTeX formatting you define a code environment that does what you want --- I choose the name ``code'' so that you can run your LaTeX as a Haskell literate script. Here's three ways of defining a code environment

(1) Using fancybox

\usepackage{fancybox}

\newenvironment{code}%
{\VerbatimEnvironment
\NMATcodesize%
\begin{Verbatim}}%
{\end{Verbatim}}


(2) Using fancyvrb

\usepackage{fancyvrb}

\DefineVerbatimEnvironment%
{code}{Verbatim}
{fontsize=\NMATcodesize}

% Typical usage
% \begin{code}[numbers=left,frame=lines,framesep=3mm,
% label={[Beginning of code]End of code}]
%
%
%
% \end{code}


(3) Using listings

\usepackage{listings}

\lstnewenvironment{code}[1][]
{\lstset{language=haskell,numbers=left,numberstyle=\tiny,float,#1}}
{}

The above example is from page 41 of the listings manual --- there is already a Haskell driver in the set of languages that listings comes with --- I couldn't see an ASN.1 language definition but it would be easier to define one than doing all the LaTeX embedding. I need to use listings to typeset my JavaScript notes.

Let me know if this helps.

Phil

Generate C Code for Multiple Types

The next immediate step is to:

1. Generate C code for multiple ASN.1 type definitions in a module.
2. Add some unit tests for generating C code so that any future modifications that affect C code generation are caught before a patch is committed.

Probably the steps after that are to:

1. Automate (script) testing against asn1c.
2. Add unit tests for e.g. enumerated types and component of types.
3. Beef up QuickCheck testing.
   

TeXpertise Needed

The paper Dan and I are writing a paper which contains or will contain: ASN.1, C and Haskell.

1. I've found a site that will generate LaTeX from ASN.1 and it looks pretty good.

2. I've found two things that might help with C

2a. A site which generates LaTeX from C. I don't think it looks particularly good but that could be cause I'm not using it properly.

2b. A LaTeX package which allows you to format C I get lots of errors "Non-PDF special ignored!" with this but it looks better than the LaTeX that (2a) generates.

3. I've no idea what to do about Haskell but I haven't done any research yet.

I thought I could put the the LaTeX and the pdf that pdflatex generates here but now I'm not so sure. Watch this space.

Testing Against asn1c in Windows

I've managed to install lcc and compile a program to encode ASN.1 (into XER as it happens) using asn1c. So we should be able to:

1. Generate random ASN.1 types and values (using the AST and QuickCheck).
2. Generate 'C' headers for the ASN.1 types using asn1c.
3. Generate a 'C' program to decode the ASN.1 values.
4. Compile the 'C' program (this is harder is Windows but lcc seems to do the trick after creating a cut down makefile - I think we will have to generate code to compile each 'C' program that asn1c generates - on Linux, all you have to do is gcc -I. -o test *.c or very nearly).
5. Run the 'C' program (using Haskell) to encode the ASN.1 values into PER.
   
6. Decode the values from PER using Haskell into values which match the ASN.1 types.

on Windows as well as on Linux.

It's not finished yet but I'm nearly there.