git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Initial commit for noops branch #161
f4c6711Phil Freeman
libraries/prelude/prelude.purs+173−20
compare with golang
unifiedsplit
@@ -40,10 +40,170 @@ module Prelude where
40 show true = "true"
40 show true = "true"
41 show false = "false"
41 show false = "false"
42
42
43+ foreign import showNumber "function numberToString(n) {\
44+ \ return n.toString();\
45+ \}" :: Number -> String
46+
47+ instance Prelude.Show Number where
48+ show = showNumber
49+
50+ class Read a where
51+ read :: String -> a
52+
53+ instance Read String where
54+ read s = s
55+
56+ instance Read Boolean where
57+ read "true" = true
58+ read _ = false
59+
43 class Monad m where
60 class Monad m where
44 ret :: forall a. a -> m a
61 ret :: forall a. a -> m a
45 (>>=) :: forall a b. m a -> (a -> m b) -> m b
62 (>>=) :: forall a b. m a -> (a -> m b) -> m b
46
63
64+ class Num a where
65+ (+) :: a -> a -> a
66+ (-) :: a -> a -> a
67+ (*) :: a -> a -> a
68+ (/) :: a -> a -> a
69+ (%) :: a -> a -> a
70+ negate :: a -> a
71+
72+ foreign import addNumber "" :: Number -> Number -> Number
73+
74+ foreign import subNumber "" :: Number -> Number -> Number
75+
76+ foreign import mulNumber "" :: Number -> Number -> Number
77+
78+ foreign import divNumber "" :: Number -> Number -> Number
79+
80+ foreign import modNumber "" :: Number -> Number -> Number
81+
82+ foreign import negateNumber "" :: Number -> Number
83+
84+ instance Num Number where
85+ (+) = addNumber
86+ (-) = subNumber
87+ (*) = mulNumber
88+ (/) = divNumber
89+ (%) = modNumber
90+ negate = negateNumber
91+
92+ class Eq a where
93+ (==) :: a -> a -> Boolean
94+ (/=) :: a -> a -> Boolean
95+
96+ -- Referential equality
97+ data Ref a = Ref a
98+
99+ foreign import refEq "" :: forall a. Ref a -> Ref a -> Boolean
100+
101+ foreign import refIneq "" :: forall a. Ref a -> Ref a -> Boolean
102+
103+ foreign import unsafeRefEq "" :: forall a. a -> a -> Boolean
104+
105+ foreign import unsafeRefIneq "" :: forall a. a -> a -> Boolean
106+
107+ instance Eq (Ref a) where
108+ (==) = refEq
109+ (/=) = refIneq
110+
111+ instance Eq String where
112+ (==) = unsafeRefEq
113+ (/=) = unsafeRefIneq
114+
115+ instance Eq Number where
116+ (==) = unsafeRefEq
117+ (/=) = unsafeRefIneq
118+
119+ instance Eq Boolean where
120+ (==) = unsafeRefEq
121+ (/=) = unsafeRefIneq
122+
123+ instance (Eq a) => Eq [a] where
124+ (==) = unsafeRefEq
125+ (/=) = unsafeRefIneq
126+
127+ class Ord a where
128+ (<) :: a -> a -> Boolean
129+ (>) :: a -> a -> Boolean
130+ (<=) :: a -> a -> Boolean
131+ (>=) :: a -> a -> Boolean
132+
133+ foreign import numLess "" :: Number -> Number -> Boolean
134+
135+ foreign import numLessEq "" :: Number -> Number -> Boolean
136+
137+ foreign import numGreater "" :: Number -> Number -> Boolean
138+
139+ foreign import numGreaterEq "" :: Number -> Number -> Boolean
140+
141+ instance Ord Number where
142+ (<) = numLess
143+ (>) = numGreater
144+ (<=) = numLessEq
145+ (>=) = numGreaterEq
146+
147+ class Bits b where
148+ (<<) :: b -> Number -> b
149+ (>>) :: b -> Number -> b
150+ (>>>) :: b -> Number -> b
151+ (&) :: b -> b -> b
152+ (|) :: b -> b -> b
153+ (^) :: b -> b -> b
154+ complement :: b -> b
155+
156+ foreign import numShl "" :: Number -> Number -> Number
157+
158+ foreign import numShr "" :: Number -> Number -> Number
159+
160+ foreign import numZfShr "" :: Number -> Number -> Number
161+
162+ foreign import numAnd "" :: Number -> Number -> Number
163+
164+ foreign import numOr "" :: Number -> Number -> Number
165+
166+ foreign import numXor "" :: Number -> Number -> Number
167+
168+ foreign import numComplement "" :: Number -> Number
169+
170+ instance Bits Number where
171+ (<<) = numShl
172+ (>>) = numShr
173+ (>>>) = numZfShr
174+ (&) = numAnd
175+ (|) = numOr
176+ (^) = numXor
177+ complement = numComplement
178+
179+ foreign import (!!) "function $bang$bang(xs) {\
180+ \ return function(n) {\
181+ \ return xs[n];\
182+ \ };\
183+ \}" :: forall a. [a] -> Number -> a
184+
185+ class BoolLike b where
186+ (&&) :: b -> b -> b
187+ (||) :: b -> b -> b
188+ not :: b -> b
189+
190+ foreign import boolAnd "" :: Boolean -> Boolean -> Boolean
191+
192+ foreign import boolOr "" :: Boolean -> Boolean -> Boolean
193+
194+ foreign import boolNot "" :: Boolean -> Boolean
195+
196+ instance BoolLike Boolean where
197+ (&&) = boolAnd
198+ (||) = boolOr
199+ not = boolNot
200+
201+ foreign import (++) "function $plus$plus(s1) {\
202+ \ return function(s2) {\
203+ \ return s1 + s2;\
204+ \ };\
205+ \}" :: String -> String -> String
206+
47module Maybe where
207module Maybe where
48
208
49 data Maybe a = Nothing | Just a
209 data Maybe a = Nothing | Just a
@@ -65,11 +225,11 @@ module Either where
65
225
66 either :: forall a b c. (a -> c) -> (b -> c) -> Either a b -> c
226 either :: forall a b c. (a -> c) -> (b -> c) -> Either a b -> c
67 either f _ (Left a) = f a
227 either f _ (Left a) = f a
68− either _ g (Right b) = g b
228+ either _ g (Right b) = g b
69
229
70 instance Prelude.Monad (Either e) where
230 instance Prelude.Monad (Either e) where
71 ret = Right
231 ret = Right
72− (>>=) = either (\e _ -> Left e) (\a f -> f a)
232+ (>>=) = either (\e _ -> Left e) (\a f -> f a)
73
233
74module Arrays where
234module Arrays where
75
235
@@ -92,7 +252,7 @@ module Arrays where
92
252
93 map :: forall a b. (a -> b) -> [a] -> [b]
253 map :: forall a b. (a -> b) -> [a] -> [b]
94 map _ [] = []
254 map _ [] = []
95− map f (x:xs) = f x : map f xs
255+ map f (x:xs) = f x : map f xs
96
256
97 foldr :: forall a b. (a -> b -> a) -> a -> [b] -> a
257 foldr :: forall a b. (a -> b -> a) -> a -> [b] -> a
98 foldr f a (b : bs) = f (foldr f a bs) b
258 foldr f a (b : bs) = f (foldr f a bs) b
@@ -194,7 +354,7 @@ module Arrays where
194
354
195 empty :: forall a. [a] -> Boolean
355 empty :: forall a. [a] -> Boolean
196 empty [] = true
356 empty [] = true
197− empty _ = false
357+ empty _ = false
198
358
199 range :: Number -> Number -> [Number]
359 range :: Number -> Number -> [Number]
200 range lo hi = {
360 range lo hi = {
@@ -382,12 +542,6 @@ module Global where
382 \ };\
542 \ };\
383 \}" :: Number -> Number -> String
543 \}" :: Number -> Number -> String
384
544
385− foreign import numberToString "function numberToString(n) {\
386− \ return n.toString();\
387− \}" :: Number -> String
388−
389− foreign import isNaN :: Number -> Boolean
390−
391 foreign import isFinite :: Number -> Boolean
545 foreign import isFinite :: Number -> Boolean
392
546
393 foreign import parseFloat :: String -> Number
547 foreign import parseFloat :: String -> Number
@@ -402,8 +556,7 @@ module Global where
402
556
403 foreign import decodeURI :: String -> String
557 foreign import decodeURI :: String -> String
404
558
405− instance Prelude.Show Number where
559+ foreign import isNaN :: Number -> Boolean
406− show = numberToString
407
560
408module Math where
561module Math where
409
562
@@ -493,7 +646,7 @@ module Eff where
493 \ return f(a())(); \
646 \ return f(a())(); \
494 \ }; \
647 \ }; \
495 \ }; \
648 \ }; \
496− \}" :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b
649+ \}" :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b
497
650
498 type Pure a = forall e. Eff e a
651 type Pure a = forall e. Eff e a
499
652
@@ -544,11 +697,11 @@ module Errors where
544module IORef where
697module IORef where
545
698
546 import Eff
699 import Eff
547−
700+
548 foreign import data Ref :: !
701 foreign import data Ref :: !
549−
702+
550 foreign import data IORef :: * -> *
703 foreign import data IORef :: * -> *
551−
704+
552 foreign import newIORef "function newIORef(val) {\
705 foreign import newIORef "function newIORef(val) {\
553 \ return function () {\
706 \ return function () {\
554 \ return { value: val };\
707 \ return { value: val };\
@@ -582,9 +735,9 @@ module Trace where
582
735
583 import Prelude
736 import Prelude
584 import Eff
737 import Eff
585−
738+
586 foreign import data Trace :: !
739 foreign import data Trace :: !
587−
740+
588 foreign import trace "function trace(s) { \
741 foreign import trace "function trace(s) { \
589 \ return function() { \
742 \ return function() { \
590 \ console.log(s); \
743 \ console.log(s); \
@@ -593,7 +746,7 @@ module Trace where
593 \}" :: forall r. String -> Eff (trace :: Trace | r) {}
746 \}" :: forall r. String -> Eff (trace :: Trace | r) {}
594
747
595 print :: forall a r. (Prelude.Show a) => a -> Eff (trace :: Trace | r) {}
748 print :: forall a r. (Prelude.Show a) => a -> Eff (trace :: Trace | r) {}
596− print o = trace (show o)
749+ print o = trace (show o)
597
750
598module ST where
751module ST where
599
752
@@ -630,7 +783,7 @@ module ST where
630 \ };\
783 \ };\
631 \ };\
784 \ };\
632 \}" :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) {}
785 \}" :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) {}
633−
786+
634 foreign import runST "function runST(f) {\
787 foreign import runST "function runST(f) {\
635 \ return f;\
788 \ return f;\
636 \}" :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a
789 \}" :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a
src/Language/PureScript/CodeGen/JS.hs−3
@@ -111,12 +111,9 @@ valueToJs opts m e (Block sts) = JSApp (JSFunction Nothing [] (JSBlock (map (sta
111valueToJs opts m e (Case values binders) = bindersToJs opts m e binders (map (valueToJs opts m e) values)
111valueToJs opts m e (Case values binders) = bindersToJs opts m e binders (map (valueToJs opts m e) values)
112valueToJs opts m e (IfThenElse cond th el) = JSConditional (valueToJs opts m e cond) (valueToJs opts m e th) (valueToJs opts m e el)
112valueToJs opts m e (IfThenElse cond th el) = JSConditional (valueToJs opts m e cond) (valueToJs opts m e th) (valueToJs opts m e el)
113valueToJs opts m e (Accessor prop val) = JSAccessor prop (valueToJs opts m e val)
113valueToJs opts m e (Accessor prop val) = JSAccessor prop (valueToJs opts m e val)
114−valueToJs opts m e (Indexer index val) = JSIndexer (valueToJs opts m e index) (valueToJs opts m e val)
115valueToJs opts m e (App val arg) = JSApp (valueToJs opts m e val) [valueToJs opts m e arg]
114valueToJs opts m e (App val arg) = JSApp (valueToJs opts m e val) [valueToJs opts m e arg]
116valueToJs opts m e (Abs arg val) = JSFunction Nothing [identToJs arg] (JSBlock [JSReturn (valueToJs opts m e val)])
115valueToJs opts m e (Abs arg val) = JSFunction Nothing [identToJs arg] (JSBlock [JSReturn (valueToJs opts m e val)])
117valueToJs opts m e (TypedValue _ (Abs arg val) ty) | optionsPerformRuntimeTypeChecks opts = let arg' = identToJs arg in JSFunction Nothing [arg'] (JSBlock $ runtimeTypeChecks arg' ty ++ [JSReturn (valueToJs opts m e val)])
116valueToJs opts m e (TypedValue _ (Abs arg val) ty) | optionsPerformRuntimeTypeChecks opts = let arg' = identToJs arg in JSFunction Nothing [arg'] (JSBlock $ runtimeTypeChecks arg' ty ++ [JSReturn (valueToJs opts m e val)])
118−valueToJs opts m e (Unary op val) = JSUnary op (valueToJs opts m e val)
119−valueToJs opts m e (Binary op v1 v2) = JSBinary op (valueToJs opts m e v1) (valueToJs opts m e v2)
120valueToJs _ m e (Var ident) = varToJs m e ident
117valueToJs _ m e (Var ident) = varToJs m e ident
121valueToJs opts m e (TypedValue _ val _) = valueToJs opts m e val
118valueToJs opts m e (TypedValue _ val _) = valueToJs opts m e val
122valueToJs _ _ _ (TypeClassDictionary _ _) = error "Type class dictionary was not replaced"
119valueToJs _ _ _ (TypeClassDictionary _ _) = error "Type class dictionary was not replaced"
src/Language/PureScript/CodeGen/JS/AST.hs+104−2
@@ -17,10 +17,112 @@
17
17
18module Language.PureScript.CodeGen.JS.AST where
18module Language.PureScript.CodeGen.JS.AST where
19
19
20−import Language.PureScript.Values
21−
22import Data.Data
20import Data.Data
23
21
22+
23+
24+-- |
25+-- Built-in unary operators
26+--
27+data UnaryOperator
28+ -- |
29+ -- Numeric negation
30+ --
31+ = Negate
32+ -- |
33+ -- Boolean negation
34+ --
35+ | Not
36+ -- |
37+ -- Bitwise negation
38+ --
39+ | BitwiseNot
40+ -- |
41+ -- Numeric unary \'plus\'
42+ --
43+ | Positive deriving (Show, Eq, Data, Typeable)
44+
45+-- |
46+-- Built-in binary operators
47+--
48+data BinaryOperator
49+ -- |
50+ -- Numeric addition
51+ --
52+ = Add
53+ -- |
54+ -- Numeric subtraction
55+ --
56+ | Subtract
57+ -- |
58+ -- Numeric multiplication
59+ --
60+ | Multiply
61+ -- |
62+ -- Numeric division
63+ --
64+ | Divide
65+ -- |
66+ -- Remainder
67+ --
68+ | Modulus
69+ -- |
70+ -- Generic equality test
71+ --
72+ | EqualTo
73+ -- |
74+ -- Generic inequality test
75+ --
76+ | NotEqualTo
77+ -- |
78+ -- Numeric less-than
79+ --
80+ | LessThan
81+ -- |
82+ -- Numeric less-than-or-equal
83+ --
84+ | LessThanOrEqualTo
85+ -- |
86+ -- Numeric greater-than
87+ --
88+ | GreaterThan
89+ -- |
90+ -- Numeric greater-than-or-equal
91+ --
92+ | GreaterThanOrEqualTo
93+ -- |
94+ -- Boolean and
95+ --
96+ | And
97+ -- |
98+ -- Boolean or
99+ --
100+ | Or
101+ -- |
102+ -- Bitwise and
103+ --
104+ | BitwiseAnd
105+ -- |
106+ -- Bitwise or
107+ --
108+ | BitwiseOr
109+ -- |
110+ -- Bitwise xor
111+ --
112+ | BitwiseXor
113+ -- |
114+ -- Bitwise left shift
115+ --
116+ | ShiftLeft
117+ -- |
118+ -- Bitwise right shift
119+ --
120+ | ShiftRight
121+ -- |
122+ -- Bitwise right shift with zero-fill
123+ --
124+ | ZeroFillShiftRight deriving (Show, Eq, Data, Typeable)
125+
24-- |
126-- |
25-- Data type for simplified Javascript expressions
127-- Data type for simplified Javascript expressions
26--
128--
src/Language/PureScript/Parser/Common.hs+3−16
@@ -82,18 +82,11 @@ reservedNames = [ "case"
82 , "null"
82 , "null"
83 , "undefined" ]
83 , "undefined" ]
84
84
85−-- |
86−-- A list of built-in operator names
87−--
88−builtInOperators :: [String]
89−builtInOperators = [ "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "<<", ">>>", ">>"
90− , "==", "!=", "&&", "||", "&", "^", "|", "!!", "!" ]
91−
92-- |
85-- |
93-- A list of reserved operators
86-- A list of reserved operators
94--
87--
95reservedOpNames :: [String]
88reservedOpNames :: [String]
96−reservedOpNames = builtInOperators ++ [ "=>", "->", "=", ".", "\\" ]
89+reservedOpNames = [ "=>", "->", "=", ".", "\\" ]
97
90
98-- |
91-- |
99-- Valid first characters for an identifier
92-- Valid first characters for an identifier
@@ -256,17 +249,11 @@ integerOrFloat :: P.Parsec String u (Either Integer Double)
256integerOrFloat = (Left <$> P.try (PT.natural tokenParser) <|>
249integerOrFloat = (Left <$> P.try (PT.natural tokenParser) <|>
257 Right <$> P.try (PT.float tokenParser)) P.<?> "number"
250 Right <$> P.try (PT.float tokenParser)) P.<?> "number"
258
251
259−-- |
260−-- Parse an operator or a built-in operator
261−--
262−operatorOrBuiltIn :: P.Parsec String u String
263−operatorOrBuiltIn = P.try operator <|> P.choice (map (\s -> P.try (reservedOp s) >> return s) builtInOperators)
264−
265-- |
252-- |
266-- Parse an identifier or parenthesized operator
253-- Parse an identifier or parenthesized operator
267--
254--
268parseIdent :: P.Parsec String ParseState Ident
255parseIdent :: P.Parsec String ParseState Ident
269−parseIdent = (Ident <$> identifier) <|> (Op <$> parens operatorOrBuiltIn)
256+parseIdent = (Ident <$> identifier) <|> (Op <$> parens operator)
270
257
271
258
272-- |
259-- |
@@ -374,7 +361,7 @@ buildPostfixParser fs first = do
374-- Parse an identifier in backticks or an operator
361-- Parse an identifier in backticks or an operator
375--
362--
376parseIdentInfix :: P.Parsec String ParseState (Qualified Ident)
363parseIdentInfix :: P.Parsec String ParseState (Qualified Ident)
377−parseIdentInfix = (P.between tick tick (parseQualified (Ident <$> identifier))) <|> parseQualified (Op <$> operatorOrBuiltIn)
364+parseIdentInfix = (P.between tick tick (parseQualified (Ident <$> identifier))) <|> parseQualified (Op <$> operator)
378
365
379-- |
366-- |
380-- Mark the current indentation level
367-- Mark the current indentation level
src/Language/PureScript/Parser/JS.hs−1
@@ -122,7 +122,6 @@ parseJS =
122 , [ binary Multiply "*" P.AssocLeft]
122 , [ binary Multiply "*" P.AssocLeft]
123 , [ binary Divide "/" P.AssocLeft]
123 , [ binary Divide "/" P.AssocLeft]
124 , [ binary Modulus "%" P.AssocLeft]
124 , [ binary Modulus "%" P.AssocLeft]
125− , [ binary Concat "+" P.AssocLeft]
126 , [ binary Add "+" P.AssocLeft]
125 , [ binary Add "+" P.AssocLeft]
127 , [ binary Subtract "-" P.AssocLeft]
126 , [ binary Subtract "-" P.AssocLeft]
128 , [ binary ShiftLeft "<<" P.AssocLeft]
127 , [ binary ShiftLeft "<<" P.AssocLeft]
src/Language/PureScript/Parser/Values.hs+1−5
@@ -155,11 +155,7 @@ parseValue =
155 postfixTable2 = [ \v -> P.try (C.indented *> indexersAndAccessors >>= return . flip App) <*> pure v
155 postfixTable2 = [ \v -> P.try (C.indented *> indexersAndAccessors >>= return . flip App) <*> pure v
156 , \v -> flip (TypedValue True) <$> (P.try (C.lexeme (C.indented *> P.string "::")) *> parsePolyType) <*> pure v
156 , \v -> flip (TypedValue True) <$> (P.try (C.lexeme (C.indented *> P.string "::")) *> parsePolyType) <*> pure v
157 ]
157 ]
158− operators = [ [ Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "!") >> return (Unary Not)
159− , Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "~") >> return (Unary BitwiseNot)
160− , Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "-") >> return (Unary Negate)
161− , Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "+") >> return id ]
162− , [ Infix (C.lexeme (P.try (C.indented *> C.parseIdentInfix P.<?> "operator") >>= \ident ->
158+ operators = [ [ Infix (C.lexeme (P.try (C.indented *> C.parseIdentInfix P.<?> "operator") >>= \ident ->
163 return (BinaryNoParens ident))) AssocRight ]
159 return (BinaryNoParens ident))) AssocRight ]
164 ]
160 ]
165
161
src/Language/PureScript/Pretty/JS.hs−1
@@ -239,7 +239,6 @@ prettyPrintJS' = A.runKleisli $ runPattern matchValue
239 , [ binary Multiply "*" ]
239 , [ binary Multiply "*" ]
240 , [ binary Divide "/" ]
240 , [ binary Divide "/" ]
241 , [ binary Modulus "%" ]
241 , [ binary Modulus "%" ]
242− , [ binary Concat "+" ]
243 , [ binary Add "+" ]
242 , [ binary Add "+" ]
244 , [ binary Subtract "-" ]
243 , [ binary Subtract "-" ]
245 , [ binary ShiftLeft "<<" ]
244 , [ binary ShiftLeft "<<" ]
src/Language/PureScript/Pretty/Values.hs−49
@@ -62,12 +62,6 @@ accessor = mkPattern match
62 match (Accessor prop val) = Just (prop, val)
62 match (Accessor prop val) = Just (prop, val)
63 match _ = Nothing
63 match _ = Nothing
64
64
65−indexer :: Pattern () Value (Value, Value)
66−indexer = mkPattern match
67− where
68− match (Indexer index val) = Just (index, val)
69− match _ = Nothing
70−
71objectUpdate :: Pattern () Value ([String], Value)
65objectUpdate :: Pattern () Value ([String], Value)
72objectUpdate = mkPattern match
66objectUpdate = mkPattern match
73 where
67 where
@@ -92,24 +86,6 @@ typed = mkPattern match
92 match (TypedValue _ val ty) = Just (ty, val)
86 match (TypedValue _ val ty) = Just (ty, val)
93 match _ = Nothing
87 match _ = Nothing
94
88
95−unary :: UnaryOperator -> String -> Operator () Value String
96−unary op str = Wrap match (++)
97− where
98− match :: Pattern () Value (String, Value)
99− match = mkPattern match'
100− where
101− match' (Unary op' val) | op' == op = Just (str, val)
102− match' _ = Nothing
103−
104−binary :: BinaryOperator -> String -> Operator () Value String
105−binary op str = AssocR match (\v1 v2 -> v1 ++ " " ++ str ++ " " ++ v2)
106− where
107− match :: Pattern () Value (Value, Value)
108− match = mkPattern match'
109− where
110− match' (Binary op' v1 v2) | op' == op = Just (v1, v2)
111− match' _ = Nothing
112−
113prettyPrintDoNotationElement :: DoNotationElement -> String
89prettyPrintDoNotationElement :: DoNotationElement -> String
114prettyPrintDoNotationElement (DoNotationValue val) = prettyPrintValue val
90prettyPrintDoNotationElement (DoNotationValue val) = prettyPrintValue val
115prettyPrintDoNotationElement (DoNotationBind binder val) = prettyPrintBinder binder ++ " <- " ++ prettyPrintValue val
91prettyPrintDoNotationElement (DoNotationBind binder val) = prettyPrintBinder binder ++ " <- " ++ prettyPrintValue val
@@ -131,31 +107,6 @@ prettyPrintValue = fromMaybe (error "Incomplete pattern") . pattern matchValue (
131 , [ Split lam $ \arg val -> "\\" ++ arg ++ " -> " ++ prettyPrintValue val ]
107 , [ Split lam $ \arg val -> "\\" ++ arg ++ " -> " ++ prettyPrintValue val ]
132 , [ Wrap ifThenElse $ \(th, el) cond -> cond ++ " ? " ++ prettyPrintValue th ++ " : " ++ prettyPrintValue el ]
108 , [ Wrap ifThenElse $ \(th, el) cond -> cond ++ " ? " ++ prettyPrintValue th ++ " : " ++ prettyPrintValue el ]
133 , [ Wrap typed $ \ty val -> val ++ " :: " ++ prettyPrintType ty ]
109 , [ Wrap typed $ \ty val -> val ++ " :: " ++ prettyPrintType ty ]
134− , [ AssocR indexer (\index val -> val ++ " !! " ++ index) ]
135− , [ binary LessThan "<" ]
136− , [ binary LessThanOrEqualTo "<=" ]
137− , [ binary GreaterThan ">" ]
138− , [ binary GreaterThanOrEqualTo ">=" ]
139− , [ unary Not "!" ]
140− , [ unary BitwiseNot "~" ]
141− , [ unary Negate "-" ]
142− , [ unary Positive "+" ]
143− , [ binary Multiply "*" ]
144− , [ binary Divide "/" ]
145− , [ binary Modulus "%" ]
146− , [ binary Concat "++" ]
147− , [ binary Add "+" ]
148− , [ binary Subtract "-" ]
149− , [ binary ShiftLeft "<<" ]
150− , [ binary ShiftRight ">>" ]
151− , [ binary ZeroFillShiftRight ">>>" ]
152− , [ binary EqualTo "==" ]
153− , [ binary NotEqualTo "!=" ]
154− , [ binary BitwiseAnd "&" ]
155− , [ binary BitwiseXor "^" ]
156− , [ binary BitwiseOr "|" ]
157− , [ binary And "&&" ]
158− , [ binary Or "||" ]
159 ]
110 ]
160
111
161prettyPrintBinderAtom :: Pattern () Binder String
112prettyPrintBinderAtom :: Pattern () Binder String
src/Language/PureScript/Sugar/Operators.hs+1−25
@@ -60,7 +60,7 @@ customOperatorTable fixities =
60 let
60 let
61 applyUserOp name t1 t2 = App (App (Var name) t1) t2
61 applyUserOp name t1 t2 = App (App (Var name) t1) t2
62 userOps = map (\(name, Fixity a p) -> (name, applyUserOp name, p, a)) . M.toList $ fixities
62 userOps = map (\(name, Fixity a p) -> (name, applyUserOp name, p, a)) . M.toList $ fixities
63− sorted = sortBy (compare `on` (\(_, _, p, _) -> p)) (userOps ++ builtIns)
63+ sorted = sortBy (compare `on` (\(_, _, p, _) -> p)) userOps
64 groups = groupBy ((==) `on` (\(_, _, p, _) -> p)) sorted
64 groups = groupBy ((==) `on` (\(_, _, p, _) -> p)) sorted
65 in
65 in
66 map (map (\(name, f, _, a) -> (name, f, a))) groups
66 map (map (\(name, f, _, a) -> (name, f, a))) groups
@@ -111,27 +111,3 @@ collectFixities m moduleName (_:ds) = collectFixities m moduleName ds
111globalOp :: String -> Qualified Ident
111globalOp :: String -> Qualified Ident
112globalOp = Qualified Nothing . Op
112globalOp = Qualified Nothing . Op
113
113
114−builtIns :: [(Qualified Ident, Value -> Value -> Value, Precedence, Associativity)]
115−builtIns = [ (globalOp "<", Binary LessThan, 3, Infixl)
116− , (globalOp "<=", Binary LessThanOrEqualTo, 3, Infixl)
117− , (globalOp ">", Binary GreaterThan, 3, Infixl)
118− , (globalOp ">=", Binary GreaterThanOrEqualTo, 3, Infixl)
119− , (globalOp "!!", flip Indexer, 4, Infixl)
120− , (globalOp "*", Binary Multiply, 5, Infixl)
121− , (globalOp "/", Binary Divide, 5, Infixl)
122− , (globalOp "%", Binary Modulus, 5, Infixl)
123− , (globalOp "++", Binary Concat, 6, Infixr)
124− , (globalOp "+", Binary Add, 7, Infixl)
125− , (globalOp "-", Binary Subtract, 7, Infixl)
126− , (globalOp "<<", Binary ShiftLeft, 8, Infixl)
127− , (globalOp ">>", Binary ShiftRight, 8, Infixl)
128− , (globalOp ">>>", Binary ZeroFillShiftRight, 8, Infixl)
129− , (globalOp "==", Binary EqualTo, 9, Infixl)
130− , (globalOp "!=", Binary NotEqualTo, 9, Infixl)
131− , (globalOp "&", Binary BitwiseAnd, 10, Infixl)
132− , (globalOp "^", Binary BitwiseXor, 10, Infixl)
133− , (globalOp "|", Binary BitwiseOr, 10, Infixl)
134− , (globalOp "&&", Binary And, 11, Infixr)
135− , (globalOp "||", Binary Or, 11, Infixr)
136− ]
137−
src/Language/PureScript/TypeChecker/Types.hs−114
@@ -388,13 +388,6 @@ infer' (ArrayLiteral vals) = do
388 els <- fresh
388 els <- fresh
389 forM_ ts $ \(TypedValue _ _ t) -> els ?= TypeApp tyArray t
389 forM_ ts $ \(TypedValue _ _ t) -> els ?= TypeApp tyArray t
390 return $ TypedValue True (ArrayLiteral ts) els
390 return $ TypedValue True (ArrayLiteral ts) els
391−infer' (Unary op val) = do
392− v <- infer val
393− inferUnary op v
394−infer' (Binary op left right) = do
395− v1 <- infer left
396− v2 <- infer right
397− inferBinary op v1 v2
398infer' (ObjectLiteral ps) = do
391infer' (ObjectLiteral ps) = do
399 ensureNoDuplicateProperties ps
392 ensureNoDuplicateProperties ps
400 ts <- mapM (infer . snd) ps
393 ts <- mapM (infer . snd) ps
@@ -409,11 +402,6 @@ infer' (ObjectUpdate o ps) = do
409 oldTys <- zip (map fst ps) <$> replicateM (length ps) fresh
402 oldTys <- zip (map fst ps) <$> replicateM (length ps) fresh
410 o' <- check o $ Object $ rowFromList (oldTys, row)
403 o' <- check o $ Object $ rowFromList (oldTys, row)
411 return $ TypedValue True (ObjectUpdate o' newVals) $ Object $ rowFromList (newTys, row)
404 return $ TypedValue True (ObjectUpdate o' newVals) $ Object $ rowFromList (newTys, row)
412−infer' (Indexer index val) = do
413− el <- fresh
414− index' <- check index tyNumber
415− val' <- check val (TypeApp tyArray el)
416− return $ TypedValue True (Indexer (TypedValue True index' tyNumber) (TypedValue True val' (TypeApp tyArray el))) el
417infer' (Accessor prop val) = do
405infer' (Accessor prop val) = do
418 typed@(TypedValue _ _ objTy) <- infer val
406 typed@(TypedValue _ _ objTy) <- infer val
419 propTy <- inferProperty objTy prop
407 propTy <- inferProperty objTy prop
@@ -492,102 +480,6 @@ inferProperty (ForAll ident ty) prop = do
492 inferProperty replaced prop
480 inferProperty replaced prop
493inferProperty _ _ = return Nothing
481inferProperty _ _ = return Nothing
494
482
495−-- |
496−-- Infer the type of a unary operator application
497−--
498−inferUnary :: UnaryOperator -> Value -> UnifyT Check Value
499−inferUnary op (TypedValue _ val valTy) =
500− case fromMaybe (error "Invalid operator") $ lookup op unaryOps of
501− (valTy', resTy) -> do
502− valTy' ?= valTy
503− return $ TypedValue True (Unary op val) resTy
504−inferUnary _ _ = error "Invalid arguments to inferUnary"
505−
506−-- |
507−-- Check the type of a unary operator application
508−--
509−checkUnary :: UnaryOperator -> Value -> Type -> UnifyT Check Value
510−checkUnary op val res =
511− case fromMaybe (error "Invalid operator") $ lookup op unaryOps of
512− (valTy, resTy) -> do
513− res ?= resTy
514− val' <- check val valTy
515− return $ Unary op val'
516−
517−-- |
518−-- Built-in unary operators
519−--
520−unaryOps :: [(UnaryOperator, (Type, Type))]
521−unaryOps = [ (Negate, (tyNumber, tyNumber))
522− , (Not, (tyBoolean, tyBoolean))
523− , (BitwiseNot, (tyNumber, tyNumber))
524− ]
525−
526−-- |
527−-- Infer the type of a binary operator application
528−--
529−inferBinary :: BinaryOperator -> Value -> Value -> UnifyT Check Value
530−inferBinary op left@(TypedValue _ _ leftTy) right@(TypedValue _ _ rightTy) | isEqualityTest op = do
531− leftTy ?= rightTy
532− return $ TypedValue True (Binary op left right) tyBoolean
533−inferBinary op left@(TypedValue _ _ leftTy) right@(TypedValue _ _ rightTy) =
534− case fromMaybe (error "Invalid operator") $ lookup op binaryOps of
535− (valTy, resTy) -> do
536− leftTy ?= valTy
537− rightTy ?= valTy
538− return $ TypedValue True (Binary op left right) resTy
539−inferBinary _ _ _ = error "Invalid arguments to inferBinary"
540−
541−-- |
542−-- Check the type of a binary operator application
543−--
544−checkBinary :: BinaryOperator -> Value -> Value -> Type -> UnifyT Check Value
545−checkBinary op left right res | isEqualityTest op = do
546− res ?= tyBoolean
547− left'@(TypedValue _ _ t1) <- infer left
548− right'@(TypedValue _ _ t2) <- infer right
549− t1 ?= t2
550− return $ Binary op left' right'
551−checkBinary op left right res =
552− case fromMaybe (error "Invalid operator") $ lookup op binaryOps of
553− (valTy, resTy) -> do
554− res ?= resTy
555− left' <- check left valTy
556− right' <- check right valTy
557− return $ Binary op left' right'
558−
559−-- |
560−-- Check if a @BinaryOperator@ is an equality test
561−--
562−isEqualityTest :: BinaryOperator -> Bool
563−isEqualityTest EqualTo = True
564−isEqualityTest NotEqualTo = True
565−isEqualityTest _ = False
566−
567−-- |
568−-- Built-in binary operators
569−--
570−binaryOps :: [(BinaryOperator, (Type, Type))]
571−binaryOps = [ (Add, (tyNumber, tyNumber))
572− , (Subtract, (tyNumber, tyNumber))
573− , (Multiply, (tyNumber, tyNumber))
574− , (Divide, (tyNumber, tyNumber))
575− , (Modulus, (tyNumber, tyNumber))
576− , (BitwiseAnd, (tyNumber, tyNumber))
577− , (BitwiseOr, (tyNumber, tyNumber))
578− , (BitwiseXor, (tyNumber, tyNumber))
579− , (ShiftRight, (tyNumber, tyNumber))
580− , (ZeroFillShiftRight, (tyNumber, tyNumber))
581− , (And, (tyBoolean, tyBoolean))
582− , (Or, (tyBoolean, tyBoolean))
583− , (Concat, (tyString, tyString))
584− , (Modulus, (tyNumber, tyNumber))
585− , (LessThan, (tyNumber, tyBoolean))
586− , (LessThanOrEqualTo, (tyNumber, tyBoolean))
587− , (GreaterThan, (tyNumber, tyBoolean))
588− , (GreaterThanOrEqualTo, (tyNumber, tyBoolean))
589− ]
590−
591-- |
483-- |
592-- Infer the types of variables brought into scope by a binder
484-- Infer the types of variables brought into scope by a binder
593--
485--
@@ -795,13 +687,7 @@ check' val u@(TUnknown _) = do
795check' v@(NumericLiteral _) t | t == tyNumber = return v
687check' v@(NumericLiteral _) t | t == tyNumber = return v
796check' v@(StringLiteral _) t | t == tyString = return v
688check' v@(StringLiteral _) t | t == tyString = return v
797check' v@(BooleanLiteral _) t | t == tyBoolean = return v
689check' v@(BooleanLiteral _) t | t == tyBoolean = return v
798−check' (Unary op val) ty = checkUnary op val ty
799−check' (Binary op left right) ty = checkBinary op left right ty
800check' (ArrayLiteral vals) (TypeApp a ty) | a == tyArray = ArrayLiteral <$> forM vals (\val -> check val ty)
690check' (ArrayLiteral vals) (TypeApp a ty) | a == tyArray = ArrayLiteral <$> forM vals (\val -> check val ty)
801−check' (Indexer index vals) ty = do
802− index' <- check index tyNumber
803− vals' <- check vals (TypeApp tyArray ty)
804− return $ Indexer index' vals'
805check' (Abs arg ret) (TypeApp (TypeApp t argTy) retTy) | t == tyFunction = do
691check' (Abs arg ret) (TypeApp (TypeApp t argTy) retTy) | t == tyFunction = do
806 Just moduleName <- checkCurrentModule <$> get
692 Just moduleName <- checkCurrentModule <$> get
807 ret' <- bindLocalVariables moduleName [(arg, argTy)] $ check ret retTy
693 ret' <- bindLocalVariables moduleName [(arg, argTy)] $ check ret retTy
src/Language/PureScript/Values.hs−118
@@ -27,112 +27,6 @@ import Data.Data
27--
27--
28type Guard = Value
28type Guard = Value
29
29
30−-- |
31−-- Built-in unary operators
32−--
33−data UnaryOperator
34− -- |
35− -- Numeric negation
36− --
37− = Negate
38− -- |
39− -- Boolean negation
40− --
41− | Not
42− -- |
43− -- Bitwise negation
44− --
45− | BitwiseNot
46− -- |
47− -- Numeric unary \'plus\'
48− --
49− | Positive deriving (Show, Eq, Data, Typeable)
50−
51−-- |
52−-- Built-in binary operators
53−--
54−data BinaryOperator
55− -- |
56− -- Numeric addition
57− --
58− = Add
59− -- |
60− -- Numeric subtraction
61− --
62− | Subtract
63− -- |
64− -- Numeric multiplication
65− --
66− | Multiply
67− -- |
68− -- Numeric division
69− --
70− | Divide
71− -- |
72− -- Remainder
73− --
74− | Modulus
75− -- |
76− -- Generic equality test
77− --
78− | EqualTo
79− -- |
80− -- Generic inequality test
81− --
82− | NotEqualTo
83− -- |
84− -- Numeric less-than
85− --
86− | LessThan
87− -- |
88− -- Numeric less-than-or-equal
89− --
90− | LessThanOrEqualTo
91− -- |
92− -- Numeric greater-than
93− --
94− | GreaterThan
95− -- |
96− -- Numeric greater-than-or-equal
97− --
98− | GreaterThanOrEqualTo
99− -- |
100− -- Boolean and
101− --
102− | And
103− -- |
104− -- Boolean or
105− --
106− | Or
107− -- |
108− -- Bitwise and
109− --
110− | BitwiseAnd
111− -- |
112− -- Bitwise or
113− --
114− | BitwiseOr
115− -- |
116− -- Bitwise xor
117− --
118− | BitwiseXor
119− -- |
120− -- Bitwise left shift
121− --
122− | ShiftLeft
123− -- |
124− -- Bitwise right shift
125− --
126− | ShiftRight
127− -- |
128− -- Bitwise right shift with zero-fill
129− --
130− | ZeroFillShiftRight
131− -- |
132− -- String concatenation
133− --
134− | Concat deriving (Show, Eq, Data, Typeable)
135−
136-- |
30-- |
137-- Data type for values
31-- Data type for values
138--
32--
@@ -150,14 +44,6 @@ data Value
150 --
44 --
151 | BooleanLiteral Bool
45 | BooleanLiteral Bool
152 -- |
46 -- |
153− -- Unary operator application
154− --
155− | Unary UnaryOperator Value
156− -- |
157− -- Binary operator application
158− --
159− | Binary BinaryOperator Value Value
160− -- |
161 -- Binary operator application. During the rebracketing phase of desugaring, this data constructor
47 -- Binary operator application. During the rebracketing phase of desugaring, this data constructor
162 -- will be removed.
48 -- will be removed.
163 --
49 --
@@ -172,10 +58,6 @@ data Value
172 --
58 --
173 | ArrayLiteral [Value]
59 | ArrayLiteral [Value]
174 -- |
60 -- |
175− -- An array indexing expression
176− --
177− | Indexer Value Value
178− -- |
179 -- An object literal
61 -- An object literal
180 --
62 --
181 | ObjectLiteral [(String, Value)]
63 | ObjectLiteral [(String, Value)]