Skip to content
Browse files

Added some helper functions, to remove warnings from Lang.JavaScript

  • Loading branch information...
1 parent 45d766d commit c5d58d3108e79e50ed858b7eadfe6138e3e66920 @tomlokhorst committed Sep 20, 2011
Showing with 37 additions and 22 deletions.
  1. +37 −22 src/Lang/JavaScript.hs
View
59 src/Lang/JavaScript.hs
@@ -24,56 +24,71 @@ instance AppFunC (Val JS) where
app f x = App f x
instance RecFunC (Val JS) where
- fix f = fun1 "fix" (\[v] -> "fix = arguments.callee, " ++ v ++ "(function (i) { return fix(" ++ v ++ ")(i) })") (lam f)
+ fix f = fun1 "fix" (fun1' (\v -> "fix = arguments.callee, " ++ v ++ "(function (i) { return fix(" ++ v ++ ")(i) })")) (lam f)
instance BoolC (Val JS) where
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
+ bool x y z = fun3 "bool" (fun3' (\f t b -> b ++ " ? " ++ t ++ "(/*force*/) : " ++ f ++ "(/*force*/)")) (lam (const x)) (lam (const y)) z
instance MaybeC (Val JS) where
nothing = Con "{ nothing : 1 }"
- just = fun1 "just" (\[x] -> "{ just : " ++ x ++ " }")
- maybe p q = fun3 "maybe" (\[n, j, m] -> m ++ ".nothing ? " ++ n ++ " : " ++ j ++ "(" ++ m ++ ".just)") p (lam q)
+ just = fun1 "just" (fun1' (\x -> "{ just : " ++ x ++ " }"))
+ maybe p q = fun3 "maybe" (fun3' (\n j m -> m ++ ".nothing ? " ++ n ++ " : " ++ j ++ "(" ++ m ++ ".just)")) p (lam q)
instance TupleC (Val JS) where
- mkTuple = fun2 "mkTuple" (\[a, b] -> "{ fst : " ++ a ++ ", snd : " ++ b ++ "}")
- tuple p q = fun2 "tuple" (\[f, t] -> f ++ "(" ++ t ++ ".fst, " ++ t ++ ".snd)") (lam2 p) q
+ mkTuple = fun2 "mkTuple" (fun2' (\a b -> "{ fst : " ++ a ++ ", snd : " ++ b ++ "}"))
+ tuple p q = fun2 "tuple" (fun2' (\f t -> f ++ "(" ++ t ++ ".fst, " ++ t ++ ".snd)")) (lam2 p) q
instance EitherC (Val JS) where
- left = fun1 "left" (\[l] -> "{ left : " ++ l ++ " }")
- right = fun1 "right" (\[r] -> "{ right : " ++ r ++ " }")
- either p q = fun3 "either" (\[l, r, e] -> e ++ ".left ? " ++ l ++ "(" ++ e ++ ".left) : " ++ r ++ "(" ++ e ++ ".right)") (lam p) (lam q)
+ left = fun1 "left" (fun1' (\l -> "{ left : " ++ l ++ " }"))
+ right = fun1 "right" (fun1' (\r -> "{ right : " ++ r ++ " }"))
+ either p q = fun3 "either" (fun3' (\l r e -> e ++ ".left ? " ++ l ++ "(" ++ e ++ ".left) : " ++ r ++ "(" ++ e ++ ".right)")) (lam p) (lam q)
instance ListC (Val JS) where
nil = Con "{ nil : 1 }"
- cons = fun2 "cons" (\[x, xs] -> "{ head : " ++ x ++ ", tail : " ++ xs ++ " }")
- list b f = fun3 "list" (\[n, c, xs] -> xs ++ ".nil ? " ++ n ++ " : " ++ c ++ "(" ++ xs ++ ".head)(" ++ xs ++ ".tail)") b (lam2 f)
+ cons = fun2 "cons" (fun2' (\x xs -> "{ head : " ++ x ++ ", tail : " ++ xs ++ " }"))
+ list b f = fun3 "list" (fun3' (\n c xs -> xs ++ ".nil ? " ++ n ++ " : " ++ c ++ "(" ++ xs ++ ".head)(" ++ xs ++ ".tail)")) b (lam2 f)
-- * JavaScript instances of AwesomePrelude type classes.
data Number
instance Num (Val JS) Number where
- (+) = fun2 "add" (\[a, b] -> a ++ " + " ++ b)
- (-) = fun2 "sub" (\[a, b] -> a ++ " - " ++ b)
- (*) = fun2 "mul" (\[a, b] -> a ++ " * " ++ b)
+ (+) = fun2 "add" (op " + ")
+ (-) = fun2 "sub" (op " - ")
+ (*) = fun2 "mul" (op " * ")
fromInteger x = Con (P.show x)
instance Eq (Val JS) Bool where
- (==) = fun2 "eq" (\[a, b] -> a ++ " == " ++ b)
- (/=) = fun2 "neq" (\[a, b] -> a ++ " /= " ++ b)
+ (==) = fun2 "eq" (op " == ")
+ (/=) = fun2 "neq" (op " /= ")
instance Eq (Val JS) Number where
- (==) = fun2 "eq" (\[a, b] -> a ++ " == " ++ b)
- (/=) = fun2 "neq" (\[a, b] -> a ++ " /= " ++ b)
+ (==) = fun2 "eq" (op " == ")
+ (/=) = fun2 "neq" (op " /= ")
instance (Eq (Val JS) a, Eq (Val JS) b) => Eq (Val JS) (a, b) where
- (==) = fun2 "eq" (\[a, b] -> a ++ " == " ++ b)
- (/=) = fun2 "neq" (\[a, b] -> a ++ " /= " ++ b)
+ (==) = fun2 "eq" (op " == ")
+ (/=) = fun2 "neq" (op " /= ")
instance Eq (Val JS) a => Eq (Val JS) [a] where
- (==) = fun2 "eq" (\[a, b] -> a ++ " == " ++ b)
- (/=) = fun2 "neq" (\[a, b] -> a ++ " /= " ++ b)
+ (==) = fun2 "eq" (op " == ")
+ (/=) = fun2 "neq" (op " /= ")
+
+op :: P.String -> [P.String] -> P.String
+op s = fun2' (\x y -> x ++ s ++ y)
+
+fun1' :: (P.String -> P.String) -> [P.String] -> P.String
+fun1' f [x] = f x
+fun1' _ _ = P.error "Lang.JavaScript.fun1': wrong number of arguments"
+
+fun2' :: (P.String -> P.String -> P.String) -> [P.String] -> P.String
+fun2' f [x, y] = f x y
+fun2' _ _ = P.error "Lang.JavaScript.fun2': wrong number of arguments"
+
+fun3' :: (P.String -> P.String -> P.String -> P.String) -> [P.String] -> P.String
+fun3' f [x, y, z] = f x y z
+fun3' _ _ = P.error "Lang.JavaScript.fun3': wrong number of arguments"

0 comments on commit c5d58d3

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