[<<][meta][>>][..]

Wed Dec 28 10:06:58 EST 2011

compilation without annotation

I'm not sure why, but writing it down in separate toplevel functions
like this makes it possible to infer the types:

  initExpr (L refs) loop = do
    s_packed <- _getp refs
    s <- _unpack s_packed
    _app loop (s, L $ lit 0)

  loopExpr (L refs, ((L arri, L arro), L arrn)) update loop = _lambda loopBody
    where
      loopBody (s, L n) = do
        i <- _get arri n
        (s', L o) <- update (s, L i)
        _set arro n o
        more <- lt n arrn
        _if more 
          (do
              n' <- add n (lit 1)
              _app loop (s', L n'))
          (do
              s_packed <- _pack s'
              _setp refs s_packed
              _exit)


  compile update = _lambda funBody where
    funBody sio@(s, io) =
      _letrec (loopExpr sio update)
              (initExpr s) 

  t14 = ctop $ term $ _def "fun" (compile f2)


So, trying to move from _get to _get' I'm getting stuck somewhere.
Trying to do this first instead to make it simpler: (arrays of structs)

 
      i <- _get arri n
      (s', L o) <- update (s, L i)
      _set arro n o

to

      i <- _get arri n
      (s', o) <- update (s, i)
      _set arro n o

But then I get into trouble due to a missing leaf wrapper L:

  /home/tom/meta/dspm/0test_TML_Sys.hs:335:42:
      Couldn't match expected type `Code t0'
                  with actual type `L (Code Tfloat)'
      Expected type: ((AC Tfloat, AC Tfloat), Code t0)
                     -> StateCont.SC
                          Code.CompState Term ((AC Tfloat, AC Tfloat), Code t1)
        Actual type: ((AC Tfloat, AC Tfloat), AC Tfloat)
                     -> StateCont.SC
                          Code.CompState Term ((AC Tfloat, AC Tfloat), AC Tfloat)
      In the first argument of `compile2', namely `f2'
      In the second argument of `_def', namely `(compile2 f2)'
  Failed, modules loaded: Type, TML, Sys, Term, Code, Loop, Effect, Struct, PrettyC, StateCont.


Ok, I see.  This needs unpack probably:


  loopExpr2 (L refs, ((L arri, L arro), L arrn)) update loop = _lambda loopBody
    where
      loopBody (s, L n) = do
        ip <- _get arri n
        i  <- _unpack ip
        (s', o) <- update (s, i)
        op <- _pack o
        _set arro n op
        more <- lt n arrn
        _if more 
          (do
              n' <- add n (lit 1)
              _app loop (s', L n'))
          (do
              s_packed <- _pack s'
              _setp refs s_packed
              _exit)

  initExpr2 (L refs) loop = do
    s_packed <- _getp refs
    s <- _unpack s_packed
    _app loop (s, L $ lit 0)

  compile2 update = _lambda funBody where
    funBody sio@(s, io) =
      _letrec (loopExpr2 sio update)
              (initExpr2 s) 

  t15 = ctop $ term $ _def "fun" (compile2 f2)


This generates proper code for I/O structs, but not proper C types:
what should be "struct tuple_f0" is actually "float":

  int fun(struct tuple_f0_f0 {
              float m0; float m1;
          } * a0,
          float * a1,
          float * a2,
          int a3)
  {
  ...    

              const float t8 = a1[a7];
              const float a9 = t8.m0;
              ...
              const float t12 = { t11 };
              a2[a7] = t12;
  ...
  }


I found this in Code.hs which is probably wrong:


  instance TypeOf (Code o) => TypeOf (Code (i -> MCode o)) where
    typeOf _ = typeOf (undefined :: (Code o))
  
No that's not it, it's the return type of functions.

This is probably it:

  instance TMLword t => TMLword (L t) where
    primType _ = primType (undefined :: t)

The type of a struct with one member is not the same as its member.
Looks like that was it.  Here's the updated version:


  instance (TMLword t1, TMLword t2) => TMLword (t1,t2) where
    primType _ = Type (AStruct $ ts1 ++ ts2) 0 where
      -- Tuples need to be made up of other tuples, L or () nodes which
      -- are always AStruct types.
      Type (AStruct ts1) 0 = primType (undefined :: t1)
      Type (AStruct ts2) 0 = primType (undefined :: t2)


  instance TMLword t => TMLword (L t) where
    -- This instance terminates the recursion on (,)
    primType _ = Type (AStruct [primType (undefined :: t)]) 0

  instance TMLword (L ()) where
    -- Empty fillers
    primType _ = Type (AStruct []) 0

[Reply][About]

[<<][meta][>>][..]