BackendK3: Minor tweaks, more math

diff --git a/src/Dyna/BackendK3/AST.hs b/src/Dyna/BackendK3/AST.hs
index e6620e1e65c01d93404f8b26b5c17de914179eae..53cc1ed6911c36cb0bc2c733a146b13c5f8e970e 100644 (file)
--- a/src/Dyna/BackendK3/AST.hs
+++ b/src/Dyna/BackendK3/AST.hs
@@ -52,6 +52,10 @@ data Ann a where
   AFunDep :: (RTupled fs, RTE fs ~ a, RTR fs ~ FunDepSpec)
           => fs -> Ann (CTE r t a)
 
+  -- XXX Declare an additional index
+  -- AIndex :: (RTupled fs, RTE fs ~ a, RTR fs ~ FunDepSpec)
+  --        => fs -> Ann (CTE r t a)
+
   -- | An "Exactly-One-Of" annotation, used to convey variants (i.e. sums)
   --   to K3.
   AOneOf  :: (RTupled mv, RTR mv ~ Maybe) => Ann mv
@@ -350,11 +354,22 @@ instance BiNum Int Int where
   biadd = (+)
   bimul = (*)
 
+instance BiNum Int Float where 
+  type BNTF Int Float = Float
+  biadd a b = ((fromIntegral a) + b)
+  bimul a b = ((fromIntegral a) * b)
+
 instance BiNum Float Float where
   type BNTF Float Float = Float
   biadd = (+)
   bimul = (*)
 
+instance BiNum Float Int where 
+  type BNTF Float Int = Float
+  biadd a b = (a + (fromIntegral b))
+  bimul a b = (a * (fromIntegral b))
+
+
   -- XXX More
 
 ------------------------------------------------------------------------}}}

diff --git a/src/Dyna/BackendK3/Render.hs b/src/Dyna/BackendK3/Render.hs
index 4617438fc93cd41661b130d9609d3bfbffc46248..fbb19f7ca78ed1752a754175a7d1def3c5e743ae 100644 (file)
--- a/src/Dyna/BackendK3/Render.hs
+++ b/src/Dyna/BackendK3/Render.hs
@@ -71,7 +71,7 @@ instance K3Ty (AsK3Ty e) where
   tColl CTBag  (AsK3Ty ta) = AsK3Ty$ encBag   ta
   tColl CTList (AsK3Ty ta) = AsK3Ty$ brackets ta
 
-  tFun (AsK3Ty ta) (AsK3Ty tb) = AsK3Ty$ ta <+> "->" <+> tb
+  tFun (AsK3Ty ta) (AsK3Ty tb) = AsK3Ty$ ta `above` ("->" <+> tb)
 
   tRef (AsK3Ty ta) = AsK3Ty$ "ref" <+> ta
 
@@ -257,8 +257,7 @@ shd :: Decl (AsK3Ty e) (AsK3 e) t -> Doc e
 shd (Decl (Var name) tipe body) =
      "declare "
   <> text name
-  <> space <> colon <> space
-  <> unAsK3Ty tipe
+  <+> align (colon <+> unAsK3Ty tipe)
   <> case body of
        Nothing -> empty
        Just b  -> space <> equals `aboveBreak` (indent 2 $ unAsK3 b 0)

diff --git a/src/Dyna/ParserHS/Parser.hs b/src/Dyna/ParserHS/Parser.hs
index 7069b47b9a635a3d1ee9f0eadba146463a3f7745..72176d97d93b1b03344b03513d758a2b71067023 100644 (file)
--- a/src/Dyna/ParserHS/Parser.hs
+++ b/src/Dyna/ParserHS/Parser.hs
@@ -15,7 +15,7 @@
 --
 --   * Doesn't handle shared subgoals ("whenever ... { ... }")
 
--- Header material                                                      {{{
+{-   Header material -} --                                              {{{
 
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE NoMonomorphismRestriction #-}