[<<][meta][>>][..]
Mon Dec 12 20:56:18 EST 2011

Deleted patch

Too much trouble getting it to work.  See patch belo.  I need to
figure out how to do this properly.  What are pointers, what are
arrays, what are primitives that support arithmetic & logic etc..  The
type structure really isn't trivial!

I guess the problem is really to make sure that mVar works for arrays
also, but currently Arrays are implemented differently, and typed as
Int -> ...

-- Reify Haskell type information as type tag.
mVar :: TypeOf (Code t) => (Code t) -> MCode (Code t)
mVar term = mVarTyped (typeOf term) term
  

tom@zoo:~/meta/dspm$ darcs wh
hunk ./dspm/Code.hs 50
-instance TMLprim t => TypeOf (Code t) where
-  typeOf _ = Type (primType (undefined :: t)) []
-
+instance TMLword t () => TypeOf (Code t) where
+  typeOf _ = Type name order where
+    (name, order, ()) = wordType (undefined :: t)
hunk ./dspm/Code.hs 55
-  typeOf _ = Type p (t:ts) where
-    Type p ts = typeOf (undefined :: Code t)
-    t = ()
+  typeOf _ = Type p (1 + o) where
+    Type p o = typeOf (undefined :: Code t)
hunk ./dspm/Code.hs 85
-mVar :: TypeOf (Code t) => (Code t) -> MCode (Code t)
-mVar term = mVarTyped (typeOf term) term
+-- mVar :: TypeOf (Code t) => (Code t) -> MCode (Code t)
+-- mVar term = mVarTyped (typeOf term) term
hunk ./dspm/Code.hs 88
+mVar :: TMLword t o => (Code t) -> MCode (Code t)
+mVar term = mVarTyped (Type name order) term where
+  (name, order, o) = wordType (undefined :: t)
+
hunk ./dspm/Code.hs 116
-cl t = Code . (Lit (Type t [])) . show
+cl t = Code . (Lit (Type t 0)) . show
+
+cop2 :: (TMLword i (), TMLword o ()) => Type -> TypedOp2 r i o
hunk ./dspm/Code.hs 122
-icop2 = cop2 (Type AInt [])   :: TypedOp2 r Tint Tint
-fcop2 = cop2 (Type AFloat []) :: TypedOp2 r Tfloat Tfloat
+icop2 = cop2 (Type AInt 0)   :: TypedOp2 r Tint Tint
+fcop2 = cop2 (Type AFloat 0) :: TypedOp2 r Tfloat Tfloat
hunk ./dspm/Code.hs 125
-ibcop2 = cop2 (Type ABool []) :: TypedOp2 r Tint Tbool
-fbcop2 = cop2 (Type ABool []) :: TypedOp2 r Tfloat Tbool
+ibcop2 = cop2 (Type ABool 0) :: TypedOp2 r Tint Tbool
+fbcop2 = cop2 (Type ABool 0) :: TypedOp2 r Tfloat Tbool
hunk ./dspm/Code.hs 129
-cconv typ nam (Code t) = mVar (Code $ Op (Type typ []) nam [t])
+cconv :: (TMLword i (), TMLword o ()) => [_$_]
+         TypeName -> String -> (Code i) -> MCode (Code o)
+         [_$_]
+cconv typ nam (Code t) = mVar (Code $ Op (Type typ 0) nam [t])
hunk ./dspm/Code.hs 187
-instance TMLprim t => StructPrim Term Code t where
+instance TypeOf (Code t) => StructPrim Term Code t where
hunk ./dspm/Code.hs 222
-    let ref         = Var (Type AVoid []) fName  -- Create a symbolic reference Term.
+    let ref         = Var (Type AVoid 0) fName   -- Create a symbolic reference Term.
hunk ./dspm/Code.hs 281
-  _get (Code (Ref a@(Var (Type base (dim:dims)) _))) (Code i) = [_$_]
-    mVarTyped (Type base dims) (Code $ Get a i)
+  _get (Code (Ref a@(Var (Type base order) _))) (Code i) = [_$_]
+    mVarTyped (Type base (order-1)) (Code $ Get a i)
hunk ./dspm/Code.hs 288
--- FIXME: Actually, an array is a TMLprim: it's a machine word
--- (pointer).  TMLprim is a bit of an awkward name.  It means
--- "non-divisable". Primitives can be stored in Atom leaf nodes of a
--- Struct binary tree.  This can use a better name.  Also, make this
--- more generic for all array representations.
+
+
+-- TypeOf is a bad name for a class of values that represent machine
+-- words, i.e. primitive types like integers and floats, and pointers
+-- to machine words.  Note that TMLprim only represents primitive
+-- types.
+  [_$_]
+-- FIXME: this is not recursive.  Why isn't this ACode (Code t) ?
hunk ./dspm/Code.hs 297
-instance TMLprim t => TMLprim (ACode t) where
-  primType _ = primType (undefined :: t)
+instance TypeOf (Code t) => TypeOf (ACode t) where
+  typeOf _ = Type prim (1 + order) where
+    Type prim order = typeOf (undefined :: (Code t))
hunk ./dspm/Effect.hs 24
-
-
hunk ./dspm/Effect.hs 57
+
+
+
hunk ./dspm/Loop.hs 37
-  _var :: TMLprim t =>
-          r t -> m (r t)
+  _var :: TMLprim t => r t -> m (r t)
hunk ./dspm/PrettyC.hs 51
-            (map (\_ -> CPtrDeclr [] ()) order)
+            (map (\_ -> CPtrDeclr [] ()) [1..order])
hunk ./dspm/PrettyC.hs 212
-  add a b = (Op (Type AInt []) "add" [a,b])  [_$_]
+  add a b = (Op (Type AInt 0) "add" [a,b])  [_$_]
hunk ./dspm/TML.hs 19
-           Tint, Tfloat, Tbool, Tvoid, TMLprim(..),
+           Tint, Tfloat, Tbool, Tvoid, TMLprim(..), TMLword(..),
hunk ./dspm/TML.hs 41
+{- Primitive data types + Pointers -}
+class TMLword t tag where [_$_]
+  wordType :: t -> (TypeName, Int, tag)
+  [_$_]
+type Suc x = ((),x)
+suc x = ((),x)
+
+instance TMLprim t => TMLword t () where
+  wordType _ = (primType (undefined :: t), 0, ())
+
+instance TMLword t tag => TMLword t (Suc tag) where  [_$_]
+  wordType _ = (name, order + 1, suc tag) where
+    (name, order, tag) = wordType (undefined :: t)
+
+
+  [_$_]
+
+
hunk ./dspm/Term.hs 75
-data Type   = Type TypeName [TypeDims]
+data Type   = Type TypeName Int



[Reply][About]
[<<][meta][>>][..]