Permalink
Browse files

Made some more changes, code is better now.

  • Loading branch information...
tomlokhorst committed Aug 31, 2009
1 parent fb0abbd commit 40d631e9373a2e7e4b7ee30040270f530ab5202a
Showing with 34 additions and 38 deletions.
  1. +5 −14 src/AwesomePrelude.hs
  2. +23 −19 src/JsPrelude.hs
  3. +6 −5 src/Main.hs
View
@@ -10,8 +10,6 @@
module AwesomePrelude where
-import qualified Prelude as P
-
undefined :: a
undefined = undefined
@@ -20,7 +18,7 @@ class Bool f r | f -> r where
false :: f
true :: f
-if' :: (Bool b r) => b -> r -> r -> r
+if' :: Bool b r => b -> r -> r -> r
if' p t f = bool f t p
(&&) :: Bool b b => b -> b -> b
@@ -29,11 +27,11 @@ if' p t f = bool f t p
(||) :: Bool b b => b -> b -> b
(||) x y = if' x x y
--- otherwise :: (Bool b b) => b
--- otherwise = true
+otherwise :: Bool b r => b
+otherwise = true
class Maybe f a r | f -> a, f -> r where
- maybe :: r -> (a -> r) -> f a -> r
+ maybe :: r -> (a -> r) -> f a -> r
nothing :: f a
just :: a -> f a
@@ -61,16 +59,9 @@ uncurry f t = tuple2 f t
not :: (Bool b b', Bool b' r) => b -> b'
not b = if' b false true
-class Eq a b where
+class Eq a b | a -> b where
(==), (/=) :: Bool b r => a -> a -> b
--- notis :: forall a b r. (Eq a, Bool b b, Bool b r) => a -> a -> b
--- notis x y = not (x == y :: b) :: b
-
--- notnot :: forall a b r. (Eq a, Bool b b, Bool b r) => a -> a -> b
--- notnot x y = not (x /= y :: b) :: b
-
-
-- class (Eq f) => Ordering f r | f -> r where
-- ordering :: r -> r -> r -> f -> r
View
@@ -10,41 +10,41 @@ module JsPrelude where
import AwesomePrelude
import qualified Prelude as P
-import Prelude hiding (Maybe, Either, Bool, Eq, (==), (&&), (++))
+--import Prelude hiding (Maybe, Either, Bool, Eq, (==), (&&), (++))
import Data.List
newtype JsC1 f a = JsC1 { unJsC1 :: Js (f a) }
newtype JsC2 f a b = JsC2 { unJsC2 :: Js (f a b) }
data Js a where
- Prim :: String -> Js a
+ Prim :: P.String -> Js a
App :: Js (a -> b) -> Js a -> Js b
- Destruct :: String -> Js f -> Js a
+ Destruct :: P.String -> Js f -> Js a
-prim :: String -> Js a -> Js b
+prim :: P.String -> Js a -> Js b
prim f a = Prim f `App` a
-prim2 :: String -> Js a -> Js b -> Js c
+prim2 :: P.String -> Js a -> Js b -> Js c
prim2 f a b = Prim f `App` a `App` b
-prim3 :: String -> Js a -> Js b -> Js c -> Js d
+prim3 :: P.String -> Js a -> Js b -> Js c -> Js d
prim3 f a b c = Prim f `App` a `App` b `App` c
-instance Show (Js a) where
+instance P.Show (Js a) where
show = showJs
-showJs :: Js a -> String
-showJs (Prim s) = s
-showJs (Destruct s x) = show (App (Prim s) x)
-showJs p@(App f x) = fun p P.++ "(" P.++ intercalate "," (args p) P.++ ")"
- where
- fun :: Js a -> String
- fun (App f _) = fun f
- fun x = showJs x
-
- args :: Js a -> [String]
- args (App f a) = args f P.++ [showJs a]
- args _ = []
+showJs :: Js a -> P.String
+showJs (Prim s) = s
+showJs (Destruct s x) = P.show (App (Prim s) x)
+showJs p@(App f x) = fun p P.++ "(" P.++ intercalate "," (args p) P.++ ")"
+ where
+ fun :: Js a -> P.String
+ fun (App f _) = fun f
+ fun x = showJs x
+
+ args :: Js a -> [P.String]
+ args (App f a) = args f P.++ [showJs a]
+ args _ = []
data JsBool
@@ -98,6 +98,10 @@ instance Eq (Js JsBool) (Js JsBool) where
(==) = jsEq
(/=) = jsNeq
+instance Eq (Js JsNumber) (Js JsBool) where
+ (==) = jsEq
+ (/=) = jsNeq
+
-- instance Num (Js JsNumber) where
-- (+) = prim2 "(function(a,b){return a+b})"
-- (*) = prim2 "(function(a,b){return a*b})"
View
@@ -12,13 +12,14 @@ import qualified Prelude as P
-- Switch between these two types to see the AwesomePrelude in action!
+f :: Js JsBool -> Js JsBool
+--f :: P.Bool -> P.Bool
+f x = not x && false || true
--- test :: Js JsBool
--- test :: P.Bool
--- test = not false && false || true
+test = f true
-kk :: Js JsBool
-kk = (not (true :: Js JsBool) :: Js JsBool)
+-- kk :: Js JsBool
+-- kk = (not (true :: Js JsBool) :: Js JsBool)

0 comments on commit 40d631e

Please sign in to comment.