Skip to content
Browse files

Start of Haskell language instance using Identiy wrapper.

  • Loading branch information...
1 parent 87f1fe6 commit 0683a532f9f1bd578cc2e34d504e8162fe420fd3 @tomlokhorst committed Feb 3, 2010
Showing with 27 additions and 77 deletions.
  1. +3 −1 AwesomePrelude.cabal
  2. +15 −68 src/Lang/Haskell.hs
  3. +9 −8 src/Lang/JavaScript.hs
View
4 AwesomePrelude.cabal
@@ -38,7 +38,9 @@ library
Generic.Data.Ord
Generic.Data.Tuple
Generic.Prelude,
- Lang.JavaScript
+ Lang.Haskell,
+ Lang.JavaScript,
+ Lang.Value
build-depends: base >= 3 && < 5,
containers >= 0.3 && < 0.4,
monads-fd >= 0.0.0.1 && < 0.0.1,
View
83 src/Lang/Haskell.hs
@@ -1,79 +1,26 @@
-{-# LANGUAGE
- FlexibleInstances
- , MultiParamTypeClasses
- , UndecidableInstances
- #-}
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}
module Lang.Haskell where
-import AwesomePrelude
+import Prelude ((++))
import qualified Prelude as P
-import Generic.Data.List
--- * Haskell instances for AwesomePrelude 'data types'
+import Generic.Prelude
-instance Fix a where
- fix f = f (fix f)
+-- Short, concise name for Identiy wrapper
+newtype Id a = Id { unId :: a }
+ deriving P.Show
-instance BoolC P.Bool where
- trueC = P.True
- falseC = P.False
+runHaskell :: Id a -> a
+runHaskell = unId
-instance BoolD P.Bool r where
- boolD f t x = if x then t else f
+-- * Haskell instances for AwesomePrelude 'data types'.
-instance Bool P.Bool r where
- bool f t x = if x then t else f
- true = P.True
- false = P.False
+instance NameC Id where
+ named s a = a -- drop name annotation, for now
-instance MaybeC P.Maybe a where
- nothingC = P.Nothing
- justC = P.Just
-
-instance MaybeD P.Maybe a r where
- maybeD = P.maybe
-
-instance Maybe P.Maybe a r where
- maybe = P.maybe
- nothing = P.Nothing
- just = P.Just
-
-instance Either P.Either a b r where
- either = P.either
- left = P.Left
- right = P.Right
-
-instance Tuple2 (,) a b r where
- tuple2 f (x, y) = f x y
- ctuple2 x y = (x, y)
-
--- instance Eq P.Ordering where
--- x == y = if x P.== y then true else false
---
--- instance Ordering P.Ordering r where
--- ordering x _ _ P.LT = x
--- ordering _ y _ P.EQ = y
--- ordering _ _ z P.GT = z
--- lt = P.LT
--- eq = P.EQ
--- gt = P.GT
-
-instance ListC [] a where
- nil = []
- cons = (:)
-
-instance ListD [] a r where
- listD x f [] = x
- listD x f (y:xs) = f y xs
-
--- * Haskell instances of AwesomePrelude 'type classes'
-
-instance Eq P.Bool P.Bool where
- (==) = (P.==)
- (/=) = (P./=)
-
-instance Eq P.Int P.Bool where
- (==) = (P.==)
- (/=) = (P./=)
+instance FunC Id where
+ lam f = Id (\x -> unId (f (Id x)))
+ fix f = f (fix f)
+ app (Id f) (Id x) = Id (f x)
View
17 src/Lang/JavaScript.hs
@@ -2,28 +2,29 @@
module Lang.JavaScript where
+import Prelude ((++))
+import qualified Prelude as P
+
import Generic.Prelude hiding ((++))
import Lang.Value
-import Prelude ((++))
-import qualified Prelude
data JS
type JavaScript a = Val JS a
--- * JavaScript instances for AwesomePrelude datatypes.
+-- * JavaScript instances for AwesomePrelude 'data types'.
instance NameC (Val JS) where
named s a = s `Name` a
instance FunC (Val JS) where
lam f = Lam f
fix f = fun1 "fix" (\[v] -> "fix = arguments.callee, " ++ v ++ "(function (i) { return fix(" ++ v ++ ")(i) })") (lam f)
- app f g = App f g
+ app f x = App f x
instance BoolC (Val JS) where
- true = Con "true"
- false = Con "false"
- bool x y z = fun3 "bool" (\[t, e, b] -> b ++ " ? " ++ t ++ "(/*force*/) : " ++ e ++ "(/*force*/)") (lam (const x)) (lam (const y)) z
+ false = Con "false"
+ true = Con "true"
+ bool x y z = fun3 "bool" (\[f, t, b] -> b ++ " ? " ++ t ++ "(/*force*/) : " ++ f ++ "(/*force*/)") (lam (const x)) (lam (const y)) z
data Number
@@ -32,7 +33,7 @@ instance Num (Val JS) Number where
(-) = fun2 "sub" (\[a, b] -> a ++ " - " ++ b)
(*) = fun2 "mul" (\[a, b] -> a ++ " * " ++ b)
(/) = fun2 "div" (\[a, b] -> a ++ " / " ++ b)
- fromInteger x = Con (Prelude.show x)
+ fromInteger x = Con (P.show x)
instance MaybeC (Val JS) where
nothing = Con "{ nothing : 1 }"

0 comments on commit 0683a53

Please sign in to comment.
Something went wrong with that request. Please try again.