瀏覽代碼

ivory-backend: move unpack to a template file

Pat Hickey 9 年之前
父節點
當前提交
f32a3fb09c
共有 3 個文件被更改,包括 39 次插入32 次删除
  1. 4 0
      gidl.cabal
  2. 6 32
      src/Gidl/Backend/Ivory/Unpack.hs
  3. 29 0
      support/ivory/Unpack.hs.template

+ 4 - 0
gidl.cabal

@@ -8,6 +8,8 @@ copyright:           2015 Galois Inc
 build-type:          Simple
 cabal-version:       >=1.10
 
+data-files: support/ivory/Unpack.hs.template
+
 library
   exposed-modules:     Gidl,
                        Gidl.Parse,
@@ -28,6 +30,8 @@ library
                        Gidl.Backend.Ivory.Types,
                        Gidl.Backend.Ivory.Unpack
 
+  other-modules:       Paths_gidl
+
   build-depends:       base >=4.7 && <4.8,
                        hashable,
                        mainland-pretty,

+ 6 - 32
src/Gidl/Backend/Ivory/Unpack.hs

@@ -3,39 +3,13 @@ module Gidl.Backend.Ivory.Unpack where
 
 import Data.List (intercalate)
 import Ivory.Artifact
+import Ivory.Artifact.Template
+import qualified Paths_gidl as P
 
 unpackModule :: [String] -> Artifact
 unpackModule modulepath =
   artifactPath (intercalate "/" modulepath) $
-  artifactString "Unpack.hs" $
-  unlines
-    [ ""
-    , "{-# LANGUAGE DataKinds #-}"
-    , "{-# LANGUAGE RankNTypes #-}"
-    , "{-# LANGUAGE ScopedTypeVariables #-}"
-    , ""
-    , "module " ++ (intercalate "." modulepath) ++ ".Unpack where"
-    , ""
-    , "import Ivory.Language"
-    , "import Ivory.Serialize"
-    , "import Ivory.Stdlib"
-    , ""
-    , "unpackWithCallback :: forall n a s1 s2 r b s0"
-    , "                    . (ANat n, IvorySizeOf a, IvoryArea a, IvoryZero a, Packable a)"
-    , "                   => ConstRef s1 (Array n (Stored Uint8))"
-    , "                   -> Ref s2 (Stored Uint32)"
-    , "                   -> (ConstRef (Stack s0) a -> Ivory ('Effects r b (Scope s0)) IBool)"
-    , "                   -> Ivory ('Effects r b (Scope s0)) IBool"
-    , "unpackWithCallback arr offs k = do"
-    , "  o <- deref offs"
-    , "  rv <- local (ival false)"
-    , "  let sufficient_remaining = ((o + fromIntegral (packSize (packRep :: PackRep a))) <?"
-    , "                               arrayLen arr)"
-    , "  when sufficient_remaining $ do"
-    , "    v <- local izero"
-    , "    unpackFrom arr o v"
-    , "    offs += fromInteger (packSize (packRep :: PackRep a))"
-    , "    r <- k (constRef v)"
-    , "    store rv r"
-    , "  deref rv"
-    ]
+  artifactCabalFileTemplate P.getDataDir fname
+    [("module_path", intercalate "." modulepath )]
+  where
+  name = "support/ivory/Unpack.hs.template"

+ 29 - 0
support/ivory/Unpack.hs.template

@@ -0,0 +1,29 @@
+
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module $module_path$.Unpack where
+
+import Ivory.Language
+import Ivory.Serialize
+import Ivory.Stdlib
+
+unpackWithCallback :: forall n a s1 s2 r b s0
+                    . (ANat n, IvorySizeOf a, IvoryArea a, IvoryZero a, Packable a)
+                   => ConstRef s1 (Array n (Stored Uint8))
+                   -> Ref s2 (Stored Uint32)
+                   -> (ConstRef (Stack s0) a -> Ivory ('Effects r b (Scope s0)) IBool)
+                   -> Ivory ('Effects r b (Scope s0)) IBool
+unpackWithCallback arr offs k = do
+  o <- deref offs
+  rv <- local (ival false)
+  let sufficient_remaining = ((o + fromIntegral (packSize (packRep :: PackRep a))) <?
+                               arrayLen arr)
+  when sufficient_remaining \$ do
+    v <- local izero
+    unpackFrom arr o v
+    offs += fromInteger (packSize (packRep :: PackRep a))
+    r <- k (constRef v)
+    store rv r
+  deref rv