3286eaf · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Fix #260

3286eafPhil Freeman13 years ago

src/Language/PureScript/Sugar/CaseDeclarations.hs+9−2

compare with golang

unifiedsplit

@@ -64,7 +64,10 @@ inSameGroup (ValueDeclaration ident1 _ _ _ _) (ValueDeclaration ident2 _ _ _ _)

64inSameGroup _ _ = False

66toDecls :: [Declaration] -> Either String [Declaration]

67−toDecls d@[ValueDeclaration _ _ [] Nothing _] = return d

67+toDecls [ValueDeclaration ident nameKind bs Nothing val] | all isVarBinder bs = do

68+ let args = map (\(VarBinder arg) -> arg) bs

69+ body = foldr (Abs . Left) val args

70+ return [ValueDeclaration ident nameKind [] Nothing body]

68toDecls ds@(ValueDeclaration ident _ bs _ _ : _) = do

71toDecls ds@(ValueDeclaration ident _ bs _ _ : _) = do

69 let tuples = map toTuple ds

72 let tuples = map toTuple ds

70 unless (all ((== length bs) . length . fst) tuples) $

73 unless (all ((== length bs) . length . fst) tuples) $

@@ -72,6 +75,10 @@ toDecls ds@(ValueDeclaration ident _ bs _ _ : _) = do

72 return [makeCaseDeclaration ident tuples]

75 return [makeCaseDeclaration ident tuples]

73toDecls ds = return ds

76toDecls ds = return ds

78+isVarBinder :: Binder -> Bool

79+isVarBinder (VarBinder _) = True

80+isVarBinder _ = False

81+

75toTuple :: Declaration -> ([Binder], (Maybe Guard, Value))

82toTuple :: Declaration -> ([Binder], (Maybe Guard, Value))

76toTuple (ValueDeclaration _ _ bs g val) = (bs, (g, val))

83toTuple (ValueDeclaration _ _ bs g val) = (bs, (g, val))

77toTuple _ = error "Not a value declaration"

84toTuple _ = error "Not a value declaration"

@@ -83,7 +90,7 @@ makeCaseDeclaration ident alternatives =

83 args = take argPattern $ unusedNames (ident, alternatives)

90 args = take argPattern $ unusedNames (ident, alternatives)

84 vars = map (Var . Qualified Nothing) args

91 vars = map (Var . Qualified Nothing) args

85 binders = [ CaseAlternative bs g val | (bs, (g, val)) <- alternatives ]

92 binders = [ CaseAlternative bs g val | (bs, (g, val)) <- alternatives ]

86− value = foldr (\arg ret -> Abs (Left arg) ret) (Case vars binders) args

93+ value = foldr (Abs . Left) (Case vars binders) args

87 in

94 in

88 ValueDeclaration ident Value [] Nothing value

95 ValueDeclaration ident Value [] Nothing value

src/Language/PureScript/Sugar/Let.hs+1

@@ -28,5 +28,6 @@ import Language.PureScript.Declarations

28desugarLetBindings :: [Module] -> [Module]

29desugarLetBindings = everywhere (mkT go)

30 where

31+ go (Let (VarBinder ident) value result) = App (Abs (Left ident) result) value

31 go (Let binder value result) = Case [value] [CaseAlternative [binder] Nothing result]

32 go (Let binder value result) = Case [value] [CaseAlternative [binder] Nothing result]

32 go other = other

33 go other = other