Commits

David Lazar committed 0e9fb08

Add the generic-k tool for converting Haskell values to and from K.

  • Participants

Comments (0)

Files changed (5)

File Data/Generics/K.hs

+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Generics.K
+-- Copyright   :  (c) David Lazar, 2011
+-- License     :  MIT
+--
+-- Maintainer  :  lazar6@illinois.edu
+-- Stability   :  experimental
+-- Portability :  unknown
+--
+-- Convert K terms to and from 'Data' values.
+-----------------------------------------------------------------------------
+
+module Data.Generics.K
+    ( toK
+    , fromK
+    ) where
+
+import Data.Generics.K.ToK (toK)
+import Data.Generics.K.FromK (fromK)

File Data/Generics/K/FromK.hs

+{-# LANGUAGE ScopedTypeVariables #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Generics.K.FromK
+-- Copyright   :  (c) David Lazar, 2011
+-- License     :  MIT
+--
+-- Maintainer  :  lazar6@illinois.edu
+-- Stability   :  experimental
+-- Portability :  unknown
+--
+-- Convert K terms to 'Data' values.
+-----------------------------------------------------------------------------
+
+module Data.Generics.K.FromK where
+
+import Data.Char (chr)
+import Data.Generics
+import Text.Printf
+import Language.K.Core.Syntax
+
+fromK :: (Data a) => K -> a
+fromK = defaultFromK
+    `extR` kToInt
+    `extR` kToInteger
+    `extR` kToBool
+    `extR` kToString
+    `extR` kToChar
+
+kToInt :: K -> Int
+kToInt (KApp (KInt i) []) = fromIntegral i
+
+kToInteger :: K -> Integer
+kToInteger (KApp (KInt i) []) = i
+
+kToBool :: K -> Bool
+kToBool (KApp (KBool b) []) = b
+
+kToString :: K -> String
+kToString (KApp (KString s) []) = s
+
+kToChar :: K -> Char
+kToChar (KApp (KInt i) []) = chr (fromIntegral i)
+
+defaultFromK :: forall a. (Data a) => K -> a
+defaultFromK (KApp (KLabel ((Syntax conStr) : _)) ks) =
+    let dataType = dataTypeOf (undefined :: a)
+        -- TODO: better error handling:
+        con = either error id $ str2con dataType conStr
+    in fromConstrK con ks
+
+
+-- There's probably a better way to do this:
+data KS x = KS { ks :: [K] , unKS :: x }
+
+fromConstrK :: (Data a) => Constr -> [K] -> a
+fromConstrK c ks = unKS $ gunfold s z c
+    where
+        s :: forall b r. Data b => KS (b -> r) -> KS r
+        s (KS (k:ks) f) = KS ks (f $ fromK k)
+
+        z :: forall r. r -> KS r
+        z = KS ks
+
+-- | Turn the given string into a constructor of the requested result type,
+-- failing in the monad if the string doesn't represent a constructor of this
+-- data type.
+str2con :: (Monad m) => DataType -> String -> m Constr
+str2con dataType conName =
+    case readConstr dataType conName of
+        Just con -> return con
+        Nothing  -> fail failString
+    where failString   = printf formatString (show conName) (show dataType)
+          formatString = "Failed to parse %s as a constructor of type %s."

File Data/Generics/K/ToK.hs

+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Generics.K.ToK
+-- Copyright   :  (c) David Lazar, 2011
+-- License     :  MIT
+--
+-- Maintainer  :  lazar6@illinois.edu
+-- Stability   :  experimental
+-- Portability :  unknown
+--
+-- Convert 'Data' values to K terms.
+-----------------------------------------------------------------------------
+
+module Data.Generics.K.ToK where
+
+import Data.Char (ord)
+import Data.Generics
+import Language.K.Core.Syntax
+import Language.K.Core.Pretty.KMode
+
+toK :: (Data a) => a -> K
+toK = defaultToK
+    `extQ` stringToK
+
+stringToK :: String -> K
+stringToK s = KApp (KString s) []
+
+defaultToK :: (Data a) => a -> K
+defaultToK a = KApp (toKLabel a) (gmapQ toK a)
+
+toKLabel :: (Data a) => a -> KLabel
+toKLabel = defaultToKLabel
+    `extQ` KInt         -- Integer
+    `extQ` KBool        -- Bool
+    `extQ` intToKLabel  -- Int
+    `extQ` charToKLabel -- Char
+
+intToKLabel :: Int -> KLabel
+intToKLabel = KInt . fromIntegral
+
+charToKLabel :: Char -> KLabel
+charToKLabel = KInt . fromIntegral . ord
+
+defaultToKLabel :: (Data a) => a -> KLabel
+defaultToKLabel a = KLabel $ Syntax ctor : replicate (glength a) Hole
+    where ctor = showConstr . toConstr $ a
+Copyright (c) 2011 David Lazar <lazar6@illinois.edu>
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.

File generic-k.cabal

+Name:               generic-k
+Version:            0.1.2
+Synopsis:           Lower and raise Haskell values into and out of the K semantic framework
+License:            MIT
+License-file:       LICENSE
+Author:             David Lazar
+Maintainer:         lazar6@illinois.edu
+Category:           Data
+Build-type:         Simple
+Cabal-version:      >=1.2
+
+Library
+  Exposed-modules:
+    Data.Generics.K
+    Data.Generics.K.ToK
+    Data.Generics.K.FromK
+
+  Build-depends: base >= 4 && < 5, syb, language-k >= 0.2.0