c7dce08 · elk · git.iko.soy

git.iko.soy/elk

Parameterized the AST for type annotations and variable types. Also rename Guid.hs to Unique.hs which reads a lot nicer.

commitc7dce081939216151d08e4d2b170afc03fcc59c8 authorevancz <info@elm-lang.org> dateThu 13 Jun 2013, 20:25 (13 years ago) parent459cf8e

13 files changed+113−105

compare with master

unifiedsplit

compiler/Guid.hs−19 compiler/Parse/Binop.hs+12−7 compiler/Parse/Expression.hs+15−15 compiler/Parse/Foreign.hs+3−3 compiler/Parse/Helpers.hs+2−2 compiler/Parse/Parser.hs+6−6 compiler/Parse/Pattern.hs+6−6 compiler/Parse/Type.hs+4−4 compiler/SourceSyntax/Declaration.hs+3−3 compiler/SourceSyntax/Expression.hs+26−24 compiler/SourceSyntax/Module.hs+5−4 compiler/SourceSyntax/Rename.hs+12−12 compiler/Unique.hs+19

compiler/Guid.hsdeleted−19

@@ -1,19 +0,0 @@

1−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2−module Guid (guid, set, run, runAt, GuidCounter) where

3−

4−import Control.Monad.State (evalState, State, get, put)

5−

6−-- Wrapper around State monad.

7−newtype GuidCounter a = GC { runGC :: State Int a }

8− deriving (Monad)

9−

10−-- Get the next GUID, incrementing the counter.

11−guid :: GuidCounter Int

12−guid = GC $ do n <- get

13− put (n + 1)

14− return n

15−

16−set n = GC (put n)

17−

18−run = runAt 0

19−runAt n x = evalState (runGC x) n

compiler/Parse/Binop.hs+12−7

@@ -35,10 +35,10 @@ opAssoc :: OpTable -> String -> Assoc

3535opAssoc table op = Map.findWithDefault R op dict

3636 where dict = Map.fromList (map (\(_,assoc,op) -> (op,assoc)) table)

3737

38−hasLevel :: OpTable -> Int -> (String,LExpr) -> Bool

38+hasLevel :: OpTable -> Int -> (String, LExpr t v) -> Bool

3939hasLevel table n (op,_) = opLevel table op == n

4040

41−binops :: OpTable -> IParser LExpr -> IParser String -> IParser LExpr

41+binops :: OpTable -> IParser (LExpr t v) -> IParser String -> IParser (LExpr t v)

4242binops table term anyOp =

4343 do e <- term

4444 split (table ++ preludeTable) 0 e =<< many nextOp

@@ -48,7 +48,11 @@ binops table term anyOp =

4848 whitespace ; e <- term

4949 return (op,e)

5050

51−split :: OpTable -> Int -> LExpr -> [(String, LExpr)] -> IParser LExpr

51+split :: OpTable

52+ -> Int

53+ -> LExpr t v

54+ -> [(String, LExpr t v)]

55+ -> IParser (LExpr t v)

5256split _ _ e [] = return e

5357split table n e eops = do

5458 assoc <- getAssoc table n eops

@@ -57,25 +61,26 @@ split table n e eops = do

5761 case assoc of R -> joinR es ops

5862 _ -> joinL es ops

5963

60−splitLevel :: OpTable -> Int -> LExpr -> [(String, LExpr)] -> [IParser LExpr]

64+splitLevel :: OpTable -> Int -> LExpr t v -> [(String, LExpr t v)]

65+ -> [IParser (LExpr t v)]

6166splitLevel table n e eops =

6267 case break (hasLevel table n) eops of

6368 (lops, (op,e'):rops) ->

6469 split table (n+1) e lops : splitLevel table n e' rops

6570 (lops, []) -> [ split table (n+1) e lops ]

6671

67−joinL :: [LExpr] -> [String] -> IParser LExpr

72+joinL :: [LExpr t v] -> [String] -> IParser (LExpr t v)

6873joinL [e] [] = return e

6974joinL (a:b:es) (op:ops) = joinL (merge a b (Binop op a b) : es) ops

7075joinL _ _ = fail "Ill-formed binary expression. Report a compiler bug."

7176

72−joinR :: [LExpr] -> [String] -> IParser LExpr

77+joinR :: [LExpr t v] -> [String] -> IParser (LExpr t v)

7378joinR [e] [] = return e

7479joinR (a:b:es) (op:ops) = do e <- joinR (b:es) ops

7580 return (merge a e (Binop op a e))

7681joinR _ _ = fail "Ill-formed binary expression. Report a compiler bug."

7782

78−getAssoc :: OpTable -> Int -> [(String,LExpr)] -> IParser Assoc

83+getAssoc :: OpTable -> Int -> [(String,LExpr t v)] -> IParser Assoc

7984getAssoc table n eops

8085 | all (==L) assocs = return L

8186 | all (==R) assocs = return R

compiler/Parse/Expression.hs+15−15

@@ -18,7 +18,7 @@ import qualified SourceSyntax.Literal as Literal

1818import SourceSyntax.Expression

1919import SourceSyntax.Declaration (Declaration(Definition))

2020

21−import Guid

21+import Unique

2222import Types.Types (Type (VarT), Scheme (Forall))

2323

2424import System.IO.Unsafe

@@ -26,14 +26,14 @@ import System.IO.Unsafe

2626

2727-------- Basic Terms --------

2828

29−varTerm :: IParser Expr

29+varTerm :: IParser (Expr t v)

3030varTerm = toVar <$> var <?> "variable"

3131

3232toVar v = case v of "True" -> Literal (Literal.Boolean True)

3333 "False" -> Literal (Literal.Boolean False)

3434 _ -> Var v

3535

36−accessor :: IParser Expr

36+accessor :: IParser (Expr t v)

3737accessor = do

3838 start <- getPosition

3939 lbl <- try (string "." >> rLabel)

@@ -44,7 +44,7 @@ accessor = do

4444

4545-------- Complex Terms --------

4646

47−listTerm :: IParser Expr

47+listTerm :: IParser (Expr t v)

4848listTerm =

4949 (do { try $ string "[markdown|"

5050 ; md <- filter (/='\r') <$> manyTill anyChar (try $ string "|]")

@@ -56,7 +56,7 @@ listTerm =

5656 return e

5757 ])

5858

59−parensTerm :: IParser LExpr

59+parensTerm :: IParser (LExpr t v)

6060parensTerm = parens $ choice

6161 [ do start <- getPosition

6262 op <- try anyOp

@@ -79,7 +79,7 @@ parensTerm = parens $ choice

7979 _ -> Location.at start end (tuple es)

8080 ]

8181

82−recordTerm :: IParser LExpr

82+recordTerm :: IParser (LExpr t v)

8383recordTerm = brackets $ choice [ misc, addLocation record ]

8484 where field = do

8585 fDefs <- (:) <$> (PVar <$> rLabel) <*> spacePrefix Pattern.term

@@ -111,14 +111,14 @@ recordTerm = brackets $ choice [ misc, addLocation record ]

111111 Nothing -> try (insert record) <|> try (modify record)

112112

113113

114−term :: IParser LExpr

114+term :: IParser (LExpr t v)

115115term = addLocation (choice [ Literal <$> literal, listTerm, accessor ])

116116 <|> accessible (addLocation varTerm <|> parensTerm <|> recordTerm)

117117 <?> "basic term (4, x, 'c', etc.)"

118118

119119-------- Applications --------

120120

121−appExpr :: IParser LExpr

121+appExpr :: IParser (LExpr t v)

122122appExpr = do

123123 tlist <- spaceSep1 term

124124 return $ case tlist of

@@ -127,10 +127,10 @@ appExpr = do

127127

128128-------- Normal Expressions --------

129129

130−binaryExpr :: IParser LExpr

130+binaryExpr :: IParser (LExpr t v)

131131binaryExpr = binops [] appExpr anyOp

132132

133−ifExpr :: IParser Expr

133+ifExpr :: IParser (Expr t v)

134134ifExpr = reserved "if" >> whitespace >> (normal <|> multiIf)

135135 where

136136 normal = do

@@ -145,7 +145,7 @@ ifExpr = reserved "if" >> whitespace >> (normal <|> multiIf)

145145 b <- expr ; whitespace ; string "->" ; whitespace

146146 (,) b <$> expr

147147

148−lambdaExpr :: IParser LExpr

148+lambdaExpr :: IParser (LExpr t v)

149149lambdaExpr = do char '\\' <|> char '\x03BB' <?> "anonymous function"

150150 whitespace

151151 pats <- spaceSep1 Pattern.term

@@ -153,17 +153,17 @@ lambdaExpr = do char '\\' <|> char '\x03BB' <?> "anonymous function"

153153 e <- expr

154154 return . run $ Pattern.makeLambda pats e

155155

156−defSet :: IParser [Def]

156+defSet :: IParser [Def t v]

157157defSet = concat <$> block (do d <- anyDef ; whitespace ; return d)

158158

159−letExpr :: IParser Expr

159+letExpr :: IParser (Expr t v)

160160letExpr = do

161161 reserved "let" ; whitespace

162162 defs <- defSet

163163 whitespace ; reserved "in" ; whitespace

164164 Let defs <$> expr

165165

166−caseExpr :: IParser Expr

166+caseExpr :: IParser (Expr t v)

167167caseExpr = do

168168 reserved "case"; whitespace; e <- expr; whitespace; reserved "of"; whitespace

169169 Case e <$> (with <|> without)

@@ -189,7 +189,7 @@ funcDef = try (do p1 <- try Pattern.term ; infics p1 <|> func p1)

189189 return $ if o == '`' then [ PVar $ takeWhile (/='`') p, p1, p2 ]

190190 else [ PVar (o:p), p1, p2 ]

191191

192−assignExpr :: IParser [Def]

192+assignExpr :: IParser [Def t v]

193193assignExpr = withPos $ do

194194 fDefs <- funcDef

195195 whitespace

compiler/Parse/Foreign.hs+3−3

@@ -10,11 +10,11 @@ import Parse.Expression (term)

1010import Parse.Type

1111import Types.Types (signalOf)

1212

13−foreignDef :: IParser Declaration

13+foreignDef :: IParser (Declaration t v)

1414foreignDef = do try (reserved "foreign") ; whitespace

1515 importEvent <|> exportEvent

1616

17−exportEvent :: IParser Declaration

17+exportEvent :: IParser (Declaration t v)

1818exportEvent = do

1919 try (reserved "export") >> whitespace >> reserved "jsevent" >> whitespace

2020 js <- jsVar ; whitespace

@@ -26,7 +26,7 @@ exportEvent = do

2626 either error (return . ExportEvent js elm . signalOf) (toForeignType pt)

2727 _ -> error "When exporting events, the exported value must be a Signal."

2828

29−importEvent :: IParser Declaration

29+importEvent :: IParser (Declaration t v)

3030importEvent = do

3131 try (reserved "import") >> whitespace >> reserved "jsevent" >> whitespace

3232 js <- jsVar ; whitespace

compiler/Parse/Helpers.hs+2−2

@@ -124,14 +124,14 @@ parens = surround '(' ')' "paren"

124124brackets :: IParser a -> IParser a

125125brackets = surround '{' '}' "bracket"

126126

127−addLocation :: IParser Expr -> IParser LExpr

127+addLocation :: IParser (Expr t v) -> IParser (LExpr t v)

128128addLocation expr = do

129129 start <- getPosition

130130 e <- expr

131131 end <- getPosition

132132 return (Location.at start end e)

133133

134−accessible :: IParser LExpr -> IParser LExpr

134+accessible :: IParser (LExpr t v) -> IParser (LExpr t v)

135135accessible expr = do

136136 start <- getPosition

137137 ce@(L s t e) <- expr

compiler/Parse/Parser.hs+6−6

@@ -1,17 +1,17 @@

11module Parse.Parser (parseProgram, parseDependencies, parseInfix) where

3−import Ast

3+import SourceSyntax.Module

44import Control.Applicative ((<$>), (<*>))

55import Control.Monad

66import Data.Char (isSymbol, isDigit)

77import Data.List (foldl',intercalate)

88import Text.Parsec hiding (newline,spaces)

10−import Parse.Library

11−import Parse.Binops (infixStmt, OpTable)

12−import Parse.Expr

13−import Parse.Types

14−import Parse.Modules

10+import Parse.Helpers

11+import Parse.Binop (infixStmt, OpTable)

12+import Parse.Expression

13+import Parse.Type

14+import Parse.Module

1515import Parse.Foreign

1616

1717statement = choice (typeAlias:defs) <|> def <?> "datatype or variable definition"

compiler/Parse/Pattern.hs+6−6

@@ -5,7 +5,7 @@ import Control.Applicative ((<$>),(<*>),(*>),pure)

55import Control.Monad

66import Control.Monad.State

77import Data.Char (isUpper)

8−import Guid

8+import Unique

99import Text.Parsec hiding (newline,spaces,State)

1010import Text.Parsec.Indent

1111import Parse.Helpers

@@ -51,14 +51,14 @@ expr = do

5151 patterns <- consSep1 (patternConstructor <|> term)

5252 asPattern (foldr1 Pattern.cons patterns) <?> "pattern"

5353

54−makeLambda :: [Pattern] -> LExpr -> GuidCounter LExpr

54+makeLambda :: [Pattern] -> LExpr t v -> Unique (LExpr t v)

5555makeLambda pats body = go (reverse pats) body

5656 where go [] body = return body

5757 go (p:ps) body@(L t s _) = do

5858 (x,e) <- extract p body

5959 go ps (L t s $ Lambda x e)

6060

61−extract :: Pattern -> LExpr -> GuidCounter (String, LExpr)

61+extract :: Pattern -> LExpr t v -> Unique (String, LExpr t v)

6262extract pattern body@(L t s _) =

6363 let loc = L t s in

6464 let fn x e = (x,e) in

@@ -79,13 +79,13 @@ extract pattern body@(L t s _) =

7979 toDef f = FnDef f [] (loc $ Access (loc $ Var a) f)

8080 return . fn a . loc $ Let (map toDef fs) body

8181

82−extracts :: [Pattern] -> LExpr -> GuidCounter ([String], LExpr)

82+extracts :: [Pattern] -> LExpr t v -> Unique ([String], LExpr t v)

8383extracts ps body = go [] (reverse ps) body

8484 where go args [] body = return (args, body)

8585 go args (p:ps) body = do (x,e) <- extract p body

8686 go (x:args) ps e

8787

88−flatten :: [Pattern] -> LExpr -> GuidCounter (IParser [Def])

88+flatten :: [Pattern] -> LExpr t v -> Unique (IParser [Def t v])

8989flatten patterns exp@(L t s _) =

9090 let loc = L t s in

9191 case patterns of

@@ -100,7 +100,7 @@ flatten patterns exp@(L t s _) =

100100 _ -> return . fail $ "Pattern (" ++ unwords (map show patterns) ++

101101 ") cannot be used on the left-hand side of an assign statement."

102102

103−matchSingle :: Pattern -> LExpr -> Pattern -> GuidCounter [Def]

103+matchSingle :: Pattern -> LExpr t v -> Pattern -> Unique [Def t v]

104104matchSingle pat exp@(L t s _) p =

105105 let loc = L t s in

106106 case p of

compiler/Parse/Type.hs+4−4

@@ -12,7 +12,7 @@ import SourceSyntax.Expression

1212import SourceSyntax.Declaration

1313import Parse.Helpers

1414import Types.Types hiding (parens,string)

15−import Guid

15+import Unique

1616

1717data ParseType = VarPT String

1818 | LambdaPT ParseType ParseType

@@ -69,7 +69,7 @@ typeConstructor :: IParser (String, [ParseType])

6969typeConstructor = (,) <$> (capVar <?> "another type constructor")

7070 <*> spacePrefix (typeSimple <|> typeUnambiguous)

7171

72−typeAlias :: IParser [Declaration]

72+typeAlias :: IParser [Declaration t v]

7373typeAlias = do

7474 start <- getPosition

7575 reserved "type" <?> "type alias (type Point = {x:Int, y:Int})"

@@ -102,12 +102,12 @@ toConstructor start end alias (Just _) kvs =

102102 rec = foldl insert (Var "_ext_") (zip args (map (loc . Var) args))

103103 insert e (k,v) = Insert (loc e) k v

104104

105−annotation :: IParser Def

105+annotation :: IParser (Def t v)

106106annotation = TypeAnnotation <$> try start <*> (toType <$> typeExpr)

107107 where start = do v <- lowVar <|> parens symOp

108108 whitespace ; hasType ; whitespace ; return v

109109

110−datatype :: IParser Declaration

110+datatype :: IParser (Declaration t v)

111111datatype = do

112112 reserved "data" <?> "datatype definition (data T = A | B | ...)"

113113 forcedWS ; name <- capVar <?> "name of data-type" ; args <- spacePrefix lowVar

compiler/SourceSyntax/Declaration.hs+3−3

@@ -5,11 +5,11 @@ import Data.Data

55import qualified SourceSyntax.Expression as Expr

66import Types.Types

8−data Declaration

9− = Definition Expr.Def

8+data Declaration tipe var

9+ = Definition (Expr.Def tipe var)

1010 | Datatype String [X] [(String,[Type])]

1111 | TypeAlias String [X] Type

12− | ImportEvent String Expr.LExpr String Type

12+ | ImportEvent String (Expr.LExpr tipe var) String Type

1313 | ExportEvent String String Type

1414 | Fixity Assoc Int String

1515 deriving (Eq, Show, Data, Typeable)

compiler/SourceSyntax/Expression.hs+26−24

@@ -10,29 +10,31 @@ import qualified SourceSyntax.Pattern as Pattern

1010import qualified SourceSyntax.Literal as Literal

1111import Types.Types

1212

13−type LExpr = Location.Located Expr

14−data Expr = Literal Literal.Literal

15− | Range LExpr LExpr

16− | Access LExpr String

17− | Remove LExpr String

18− | Insert LExpr String LExpr

19− | Modify LExpr [(String,LExpr)]

20− | Record [(String,[String],LExpr)]

21− | Binop String LExpr LExpr

22− | Lambda String LExpr

23− | App LExpr LExpr

24− | MultiIf [(LExpr,LExpr)]

25− | Let [Def] LExpr

26− | Var String

27− | Case LExpr [(Pattern.Pattern,LExpr)]

28− | Data String [LExpr]

29− | Markdown Pandoc.Pandoc

30− deriving (Eq, Data, Typeable)

13+type LExpr tipe var = Location.Located (Expr tipe var)

14+data Expr t v

15+ = Literal Literal.Literal

16+ | Var String

17+ | Range (LExpr t v) (LExpr t v)

18+ | Access (LExpr t v) String

19+ | Remove (LExpr t v) String

20+ | Insert (LExpr t v) String (LExpr t v)

21+ | Modify (LExpr t v) [(String, LExpr t v)]

22+ | Record [(String, [String], LExpr t v)]

23+ | Binop String (LExpr t v) (LExpr t v)

24+ | Lambda String (LExpr t v)

25+ | App (LExpr t v) (LExpr t v)

26+ | MultiIf [(LExpr t v,LExpr t v)]

27+ | Let [Def t v] (LExpr t v)

28+ | Case (LExpr t v) [(Pattern.Pattern, LExpr t v)]

29+ | Data String [LExpr t v]

30+ | Markdown Pandoc.Pandoc

31+ deriving (Eq, Data, Typeable)

3132

32−data Def = FnDef String [String] LExpr

33− | OpDef String String String LExpr

34− | TypeAnnotation String Type

35− deriving (Eq, Data, Typeable)

33+data Def tipe var

34+ = FnDef String [String] (LExpr tipe var)

35+ | OpDef String String String (LExpr tipe var)

36+ | TypeAnnotation String Type

37+ deriving (Eq, Data, Typeable)

3638

3739cons h t = Location.merge h t (Data "Cons" [h,t])

3840nil = Location.L (Just "[]") Location.NoSpan (Data "Nil" [])

@@ -43,7 +45,7 @@ delist (Location.L _ _ (Data "Cons" [h,t])) = h : delist t

4345delist _ = []

4446

4547

46−instance Show Expr where

48+instance Show (Expr t v) where

4749 show e =

4850 let show' (Location.L _ _ e) = Help.parensIf (needsParens e) (show e) in

4951 case e of

@@ -77,7 +79,7 @@ instance Show Expr where

7779 Markdown _ -> "[markdown| ... |]"

7880

7981

80−instance Show Def where

82+instance Show (Def t v) where

8183 show e =

8284 case e of

8385 FnDef v [] e -> v ++ " = " ++ show e

compiler/SourceSyntax/Module.hs+5−4

@@ -7,8 +7,9 @@ import qualified SourceSyntax.Declaration as Decl

77import System.FilePath (joinPath)

88import Types.Types

10−data Module = Module [String] Exports Imports [Decl.Declaration]

11− deriving (Show)

10+data Module tipe var =

11+ Module [String] Exports Imports [Decl.Declaration tipe var]

12+ deriving (Show)

1213

1314type Exports = [String]

1415

@@ -16,8 +17,8 @@ type Imports = [(String, ImportMethod)]

1617data ImportMethod = As String | Importing [String] | Hiding [String]

1718 deriving (Eq, Ord, Show, Data, Typeable)

1819

19−name :: Module -> String

20+name :: Module a b -> String

2021name (Module names _ _ _) = intercalate "." names

2122

22−path :: Module -> FilePath

23+path :: Module a b -> FilePath

2324path (Module names _ _ _) = joinPath names

compiler/SourceSyntax/Rename.hs+12−12

@@ -5,7 +5,7 @@ import Control.Arrow (first)

55import Control.Monad (ap, liftM, foldM, mapM, Monad, zipWithM)

66import Control.Monad.State (evalState, State, get, put)

77import Data.Char (isLower,isDigit)

8−import Guid

8+import Unique

99import SourceSyntax.Location

1010import SourceSyntax.Pattern

1111import SourceSyntax.Expression

@@ -16,17 +16,17 @@ derename var

1616 | isDigit (last var) = reverse . tail . dropWhile isDigit $ reverse var

1717 | otherwise = var

1818

19−renameModule :: Module -> Module

19+renameModule :: Module t v -> Module t v

2020renameModule modul = run (rename deprime modul)

2121

2222class Rename a where

23− rename :: (String -> String) -> a -> GuidCounter a

23+ rename :: (String -> String) -> a -> Unique a

2424

25−instance Rename Module where

25+instance Rename (Module t v) where

2626 rename env (Module name ex im stmts) = do stmts' <- renameStmts env stmts

2727 return (Module name ex im stmts')

2828

29−instance Rename Def where

29+instance Rename (Def t v) where

3030 rename env (OpDef op a1 a2 e) =

3131 do env' <- extends env [a1,a2]

3232 OpDef op (env' a1) (env' a2) `liftM` rename env' e

@@ -36,7 +36,7 @@ instance Rename Def where

3636 rename env (TypeAnnotation n t) = return (TypeAnnotation (env n) t)

3737

3838

39−instance Rename Declaration where

39+instance Rename (Declaration t v) where

4040 rename env stmt =

4141 case stmt of

4242 Definition def -> Definition `liftM` rename env def

@@ -60,7 +60,7 @@ renameStmts env stmts = do env' <- extends env $ concatMap getNames stmts

6060instance Rename a => Rename (Located a) where

6161 rename env (L t s e) = L t s `liftM` rename env e

6262

63−instance Rename Expr where

63+instance Rename (Expr t v) where

6464 rename env expr =

6565 let rnm = rename env in

6666 case expr of

@@ -115,16 +115,16 @@ instance Rename Expr where

115115

116116deprime = map (\c -> if c == '\'' then '$' else c)

117117

118−extend :: (String -> String) -> String -> GuidCounter (String, String -> String)

118+extend :: (String -> String) -> String -> Unique (String, String -> String)

119119extend env x = do

120120 n <- guid

121121 let rx = deprime x ++ "_" ++ show n

122122 return (rx, \y -> if y == x then rx else env y)

123123

124−extends :: (String -> String) -> [String] -> GuidCounter (String -> String)

124+extends :: (String -> String) -> [String] -> Unique (String -> String)

125125extends env xs = foldM (\e x -> liftM snd $ extend e x) env xs

126126

127−patternExtend :: Pattern -> (String -> String) -> GuidCounter (Pattern, String -> String)

127+patternExtend :: Pattern -> (String -> String) -> Unique (Pattern, String -> String)

128128patternExtend pattern env =

129129 case pattern of

130130 PAnything -> return (PAnything, env)

@@ -141,8 +141,8 @@ patternExtend pattern env =

141141 return (pattern, foldr (\f e n -> if n == f then f else env n) env fs)

142142

143143patternRename :: (String -> String)

144− -> (Pattern, LExpr)

145− -> GuidCounter (Pattern, LExpr)

144+ -> (Pattern, LExpr t v)

145+ -> Unique (Pattern, LExpr t v)

146146patternRename env (p,e) = do

147147 (rp,env') <- patternExtend p env

148148 re <- rename env' e

compiler/Unique.hsnew file+19

@@ -0,0 +1,19 @@

1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2+module Unique (guid, set, run, runAt, Unique) where

4+import Control.Monad.State (evalState, State, get, put)

6+-- Wrapper around State monad.

7+newtype Unique a = U { runU :: State Int a }

8+ deriving (Monad)

10+-- Get the next GUID, incrementing the counter.

11+guid :: Unique Int

12+guid = U $ do n <- get

13+ put (n + 1)

14+ return n

15+

16+set n = U (put n)

17+

18+run = runAt 0

19+runAt n x = evalState (runU x) n