Skip to content

Commit 503caca

Browse files
paf31paf31
committed
Multi-let purescript#258 
1 parent f8da0b9 commit 503caca

32 files changed

+646
-630
lines changed

‎examples/passing/EmptyDataDecls.purs‎

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,6 @@ foreign import error
2525
\ throw msg;\
2626
\}" :: forall a. String -> a
2727

28-
main = let (Array xs) = cons 1 $ cons 2 $ cons 3 nil
29-
in if xs == [1, 2, 3]
30-
then Debug.Trace.trace "Done"
31-
else error "Failed"
28+
main = case cons 1 $ cons 2 $ cons 3 nil of
29+
Array [1, 2, 3] -> Debug.Trace.trace "Done"
30+
_ -> error "Failed"

‎examples/passing/Let.purs‎

Lines changed: 31 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -2,25 +2,50 @@ module Main where
22

33
import Prelude
44
import Control.Monad.Eff
5+
import Control.Monad.ST
56

6-
test1 x = let y = x + 1 in y
7+
test1 x = let
8+
y :: Number
9+
y = x + 1
10+
in y
711

812
test2 x y =
913
let x' = x + 1 in
1014
let y' = y + 1 in
1115
x' + y'
1216

13-
test3 x = let 1 = x in 2
14-
15-
test4 = let f x y z = x + y + z in
17+
test3 = let f x y z = x + y + z in
1618
f 1 2 3
1719

18-
test5 = let f x [y, z] = x y z in
20+
test4 = let f x [y, z] = x y z in
1921
f (+) [1, 2]
2022

23+
test5 = let
24+
f x | x > 0 = g (x / 2) + 1
25+
f x = 0
26+
g x = f (x - 1) + 1
27+
in g 10
28+
29+
test6 = runPure (runST (do
30+
r <- newSTRef 0
31+
(let
32+
go [] = readSTRef r
33+
go (n : ns) = do
34+
modifySTRef r ((+) n)
35+
go ns
36+
in go [1, 2, 3, 4, 5])
37+
))
38+
39+
test7 = let
40+
f :: forall a. a -> a
41+
f x = x
42+
in if f true then f 1 else f 2
43+
2144
main = do
2245
Debug.Trace.print (test1 1)
2346
Debug.Trace.print (test2 1 2)
24-
Debug.Trace.print (test3 1)
47+
Debug.Trace.print test3
2548
Debug.Trace.print test4
2649
Debug.Trace.print test5
50+
Debug.Trace.print test6
51+
Debug.Trace.print test7

‎examples/passing/MonadState.purs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -14,8 +14,8 @@ runState s (State f) = f s
1414

1515
instance monadState :: Prelude.Monad (State s) where
1616
return a = State $ \s -> Tuple s a
17-
(>>=) f g = State $ \s -> let (Tuple s1 a) = runState s f in
18-
runState s1 (g a)
17+
(>>=) f g = State $ \s -> case runState s f of
18+
Tuple s1 a -> runState s1 (g a)
1919

2020
instance monadStateState :: MonadState s (State s) where
2121
get = State (\s -> Tuple s s)

‎psci/Main.hs‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -161,7 +161,6 @@ quitMessage = "See ya!"
161161

162162
-- |
163163
-- Loads module, function, and file completions.
164-
-- TODO: filter names to only include exported decls
165164
--
166165
completion :: CompletionFunc (StateT PSCiState IO)
167166
completion = completeWord Nothing " \t\n\r" findCompletions

‎psci/Parser.hs‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -34,8 +34,7 @@ import qualified Language.PureScript as P
3434
-- we actually want the normal @let@.
3535
--
3636
psciLet :: Parsec String P.ParseState Command
37-
psciLet = Let <$> (P.Let <$> (P.reserved "let" *> P.indented *> (Left <$> P.parseBinder))
38-
<*> (P.indented *> P.reservedOp "=" *> P.parseValue))
37+
psciLet = Let <$> (P.Let <$> (P.reserved "let" *> P.indented *> many1 P.parseDeclaration))
3938

4039
-- |
4140
-- Parses PSCI metacommands or expressions input from the user.

‎purescript.cabal‎

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -33,8 +33,8 @@ library
3333
Language.PureScript.Kinds
3434
Language.PureScript.Names
3535
Language.PureScript.Types
36-
Language.PureScript.Values
3736
Language.PureScript.Scope
37+
Language.PureScript.TypeClassDictionaries
3838
Language.PureScript.DeadCodeElimination
3939
Language.PureScript.Sugar
4040
Language.PureScript.ModuleDependencies
@@ -44,7 +44,6 @@ library
4444
Language.PureScript.Sugar.BindingGroups
4545
Language.PureScript.Sugar.Operators
4646
Language.PureScript.Sugar.TypeClasses
47-
Language.PureScript.Sugar.Let
4847
Language.PureScript.Sugar.Names
4948
Language.PureScript.CodeGen
5049
Language.PureScript.CodeGen.Common
@@ -65,7 +64,6 @@ library
6564
Language.PureScript.Parser.Kinds
6665
Language.PureScript.Parser.State
6766
Language.PureScript.Parser.Types
68-
Language.PureScript.Parser.Values
6967
Language.PureScript.Pretty
7068
Language.PureScript.Pretty.Common
7169
Language.PureScript.Pretty.JS

‎src/Language/PureScript.hs‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,6 @@
1515

1616
module Language.PureScript (module P, compile, compile', MonadMake(..), make) where
1717

18-
import Language.PureScript.Values as P
1918
import Language.PureScript.Types as P
2019
import Language.PureScript.Kinds as P
2120
import Language.PureScript.Declarations as P

‎src/Language/PureScript/CodeGen/Externs.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -24,10 +24,10 @@ import qualified Data.Map as M
2424

2525
import Control.Monad.Writer
2626

27+
import Language.PureScript.TypeClassDictionaries
2728
import Language.PureScript.Declarations
2829
import Language.PureScript.Pretty
2930
import Language.PureScript.Names
30-
import Language.PureScript.Values
3131
import Language.PureScript.Environment
3232

3333
-- |

‎src/Language/PureScript/CodeGen/JS.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -30,7 +30,6 @@ import Control.Monad (replicateM, forM)
3030

3131
import qualified Data.Map as M
3232

33-
import Language.PureScript.Values
3433
import Language.PureScript.Names
3534
import Language.PureScript.Scope
3635
import Language.PureScript.Declarations
@@ -134,6 +133,7 @@ valueToJs opts m e (Case values binders) = bindersToJs opts m e binders (map (va
134133
valueToJs opts m e (IfThenElse cond th el) = JSConditional (valueToJs opts m e cond) (valueToJs opts m e th) (valueToJs opts m e el)
135134
valueToJs opts m e (Accessor prop val) = JSAccessor prop (valueToJs opts m e val)
136135
valueToJs opts m e (App val arg) = JSApp (valueToJs opts m e val) [valueToJs opts m e arg]
136+
valueToJs opts m e (Let ds val) = JSApp (JSFunction Nothing [] (JSBlock (concat (mapMaybe (flip (declToJs opts m) e) ds) ++ [JSReturn $ valueToJs opts m e val]))) []
137137
valueToJs opts m e (Abs (Left arg) val) = JSFunction Nothing [identToJs arg] (JSBlock [JSReturn (valueToJs opts m (bindName m arg e) val)])
138138
valueToJs opts m e (TypedValue _ (Abs (Left arg) val) ty) | optionsPerformRuntimeTypeChecks opts = let arg' = identToJs arg in JSFunction Nothing [arg'] (JSBlock $ runtimeTypeChecks arg' ty ++ [JSReturn (valueToJs opts m e val)])
139139
valueToJs _ m _ (Var ident) = varToJs m ident

‎src/Language/PureScript/DeadCodeElimination.hs‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,6 @@ import Data.Generics
2323
import Data.Maybe (mapMaybe)
2424

2525
import Language.PureScript.Names
26-
import Language.PureScript.Values
2726
import Language.PureScript.Declarations
2827

2928
-- |

0 commit comments

Comments
 (0)