├── .cargo └── config ├── .gitignore ├── Cargo.lock ├── Cargo.toml ├── LICENSE ├── Prelude.hs ├── README.md ├── Test.hs ├── metrics └── src ├── builtins.rs ├── compiler.rs ├── core.rs ├── deriving.rs ├── graph.rs ├── infix.rs ├── interner.rs ├── lambda_lift.rs ├── lexer.rs ├── main.rs ├── module.rs ├── parser.rs ├── renamer.rs ├── repl.rs ├── scoped_map.rs ├── typecheck.rs ├── types.rs └── vm.rs /.cargo/config: -------------------------------------------------------------------------------- 1 | [build] 2 | rustflags = "-Adead_code -Aunused_macros" 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .vscode 2 | 3 | *.sdf 4 | *.suo 5 | *.sln 6 | *.vcxproj 7 | *.vcxproj.filters 8 | *.vcxproj.user 9 | *.ilk 10 | *.pdb 11 | *.idb 12 | *.opensdf 13 | *.tlog 14 | 15 | obj 16 | bin 17 | 18 | *.o 19 | *.exe 20 | 21 | *.swp 22 | *.make 23 | 24 | .depend 25 | tags 26 | 27 | target/ 28 | -------------------------------------------------------------------------------- /Cargo.lock: -------------------------------------------------------------------------------- 1 | # This file is automatically @generated by Cargo. 2 | # It is not intended for manual editing. 3 | version = 3 4 | 5 | [[package]] 6 | name = "cfg-if" 7 | version = "1.0.0" 8 | source = "registry+https://github.com/rust-lang/crates.io-index" 9 | checksum = "baf1de4339761588bc0619e3cbc0120ee582ebb74b53b4efbf79117bd2da40fd" 10 | 11 | [[package]] 12 | name = "getopts" 13 | version = "0.2.21" 14 | source = "registry+https://github.com/rust-lang/crates.io-index" 15 | checksum = "14dbbfd5c71d70241ecf9e6f13737f7b5ce823821063188d7e46c41d371eebd5" 16 | dependencies = [ 17 | "unicode-width", 18 | ] 19 | 20 | [[package]] 21 | name = "haskell-compiler" 22 | version = "0.0.2" 23 | dependencies = [ 24 | "getopts", 25 | "log 0.3.9", 26 | ] 27 | 28 | [[package]] 29 | name = "log" 30 | version = "0.3.9" 31 | source = "registry+https://github.com/rust-lang/crates.io-index" 32 | checksum = "e19e8d5c34a3e0e2223db8e060f9e8264aeeb5c5fc64a4ee9965c062211c024b" 33 | dependencies = [ 34 | "log 0.4.17", 35 | ] 36 | 37 | [[package]] 38 | name = "log" 39 | version = "0.4.17" 40 | source = "registry+https://github.com/rust-lang/crates.io-index" 41 | checksum = "abb12e687cfb44aa40f41fc3978ef76448f9b6038cad6aef4259d3c095a2382e" 42 | dependencies = [ 43 | "cfg-if", 44 | ] 45 | 46 | [[package]] 47 | name = "unicode-width" 48 | version = "0.1.10" 49 | source = "registry+https://github.com/rust-lang/crates.io-index" 50 | checksum = "c0edd1e5b14653f783770bce4a4dabb4a5108a5370a5f5d8cfe8710c361f6c8b" 51 | -------------------------------------------------------------------------------- /Cargo.toml: -------------------------------------------------------------------------------- 1 | [package] 2 | name = "haskell-compiler" 3 | version = "0.0.2" 4 | authors = [ "Markus Westerlind " ] 5 | edition = "2021" 6 | 7 | [[bin]] 8 | name = "haskell-compiler" 9 | path = "src/main.rs" 10 | 11 | [dependencies] 12 | log = "0.3.6" 13 | getopts = "0.2" 14 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (C) 2014 Markus Westerlind 2 | 3 | 4 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 5 | 6 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 7 | 8 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 9 | 10 | -------------------------------------------------------------------------------- /Prelude.hs: -------------------------------------------------------------------------------- 1 | module Prelude where 2 | 3 | data Bool = True | False 4 | deriving(Eq, Ord) 5 | 6 | not b = case b of 7 | True -> False 8 | False -> True 9 | 10 | infixr 2 || 11 | 12 | (||) :: Bool -> Bool -> Bool 13 | (||) True y = True 14 | (||) False y = y 15 | 16 | infixr 3 && 17 | 18 | (&&) :: Bool -> Bool -> Bool 19 | (&&) x y = case x of 20 | True -> y 21 | False -> False 22 | 23 | data Maybe a = Just a | Nothing 24 | deriving(Eq, Ord) 25 | 26 | maybe :: b -> (a -> b) -> Maybe a -> b 27 | maybe def f m = case m of 28 | Just x -> f x 29 | Nothing -> def 30 | 31 | 32 | data Either a b = Left a | Right b 33 | 34 | either :: (a -> c) -> (b -> c) -> Either a b -> c 35 | either l r e = case e of 36 | Left x -> l x 37 | Right x -> r x 38 | 39 | id x = x 40 | 41 | 42 | infix 4 ==, /= 43 | 44 | class Eq a where 45 | (==) :: a -> a -> Bool 46 | (==) x y = not (x /= y) 47 | (/=) :: a -> a -> Bool 48 | (/=) x y = not (x == y) 49 | 50 | instance Eq Bool where 51 | (==) True True = True 52 | (==) False False = True 53 | (==) x y = False 54 | 55 | (/=) x y = not (x == y) 56 | 57 | instance Eq Int where 58 | (==) x y = primIntEQ x y 59 | 60 | instance Eq Double where 61 | (==) x y = primDoubleEQ x y 62 | (/=) x y = not (x == y) 63 | 64 | instance Eq a => Eq [a] where 65 | (==) (x:xs) (y:ys) = (x == y) && (xs == ys) 66 | (==) [] [] = True 67 | (==) x y = False 68 | 69 | (/=) xs ys = not (xs == ys) 70 | 71 | infixl 6 +, - 72 | infixl 7 * 73 | 74 | class Num a where 75 | (+) :: a -> a -> a 76 | (-) :: a -> a -> a 77 | (*) :: a -> a -> a 78 | fromInteger :: Int -> a 79 | 80 | instance Num Int where 81 | (+) x y = primIntAdd x y 82 | (-) x y = primIntSubtract x y 83 | (*) x y = primIntMultiply x y 84 | fromInteger x = x 85 | 86 | instance Num Double where 87 | (+) x y = primDoubleAdd x y 88 | (-) x y = primDoubleSubtract x y 89 | (*) x y = primDoubleMultiply x y 90 | fromInteger x = primIntToDouble x 91 | 92 | infixl 7 / 93 | 94 | class Fractional a where 95 | (/) :: a -> a -> a 96 | fromRational :: Double -> a 97 | 98 | instance Fractional Double where 99 | (/) x y = primDoubleDivide x y 100 | fromRational x = x 101 | 102 | infixl 7 `div`, `rem` 103 | 104 | class Integral a where 105 | div :: a -> a -> a 106 | rem :: a -> a -> a 107 | toInteger :: a -> Int 108 | 109 | instance Integral Int where 110 | div x y = primIntDivide x y 111 | rem x y = primIntRemainder x y 112 | toInteger x = x 113 | 114 | data Ordering = LT | EQ | GT 115 | deriving(Eq, Ord) 116 | 117 | infix 1 <, >, <=, >= 118 | 119 | class Eq a => Ord a where 120 | compare :: a -> a -> Ordering 121 | (<) :: a -> a -> Bool 122 | (>) :: a -> a -> Bool 123 | (<=) :: a -> a -> Bool 124 | (>=) :: a -> a -> Bool 125 | min :: a -> a -> a 126 | max :: a -> a -> a 127 | compare x y = case x < y of 128 | True -> LT 129 | False -> case x == y of 130 | True -> EQ 131 | False -> GT 132 | (<) x y = case compare x y of 133 | LT -> True 134 | EQ -> False 135 | GT -> False 136 | (>) x y = case compare x y of 137 | LT -> False 138 | EQ -> False 139 | GT -> True 140 | (<=) x y = case compare x y of 141 | LT -> True 142 | EQ -> True 143 | GT -> False 144 | (>=) x y = case compare x y of 145 | LT -> False 146 | EQ -> True 147 | GT -> True 148 | min x y = case x < y of 149 | True -> x 150 | False -> y 151 | max x y = case x > y of 152 | True -> x 153 | False -> y 154 | 155 | 156 | instance Ord Int where 157 | compare x y = case primIntLT x y of 158 | True -> LT 159 | False -> case primIntEQ x y of 160 | True -> EQ 161 | False -> GT 162 | (<) x y = case compare x y of 163 | LT -> True 164 | EQ -> False 165 | GT -> False 166 | (>) x y = case compare x y of 167 | LT -> False 168 | EQ -> False 169 | GT -> True 170 | (<=) x y = case compare x y of 171 | LT -> True 172 | EQ -> True 173 | GT -> False 174 | (>=) x y = case compare x y of 175 | LT -> False 176 | EQ -> True 177 | GT -> True 178 | min x y = case x < y of 179 | True -> x 180 | False -> y 181 | max x y = case x > y of 182 | True -> x 183 | False -> y 184 | 185 | instance Ord Double where 186 | compare x y = case primDoubleLT x y of 187 | True -> LT 188 | False -> case primDoubleEQ x y of 189 | True -> EQ 190 | False -> GT 191 | (<) x y = case compare x y of 192 | LT -> True 193 | EQ -> False 194 | GT -> False 195 | (>) x y = case compare x y of 196 | LT -> False 197 | EQ -> False 198 | GT -> True 199 | (<=) x y = case compare x y of 200 | LT -> True 201 | EQ -> True 202 | GT -> False 203 | (>=) x y = case compare x y of 204 | LT -> False 205 | EQ -> True 206 | GT -> True 207 | min x y = case x < y of 208 | True -> x 209 | False -> y 210 | max x y = case x > y of 211 | True -> x 212 | False -> y 213 | 214 | instance Ord Bool where 215 | compare False True = LT 216 | compare True False = GT 217 | compare _ _ = EQ 218 | 219 | (<) x y = case compare x y of 220 | LT -> True 221 | EQ -> False 222 | GT -> False 223 | (>) x y = case compare x y of 224 | LT -> False 225 | EQ -> False 226 | GT -> True 227 | (<=) x y = case compare x y of 228 | LT -> True 229 | EQ -> True 230 | GT -> False 231 | (>=) x y = case compare x y of 232 | LT -> False 233 | EQ -> True 234 | GT -> True 235 | min x y = case x < y of 236 | True -> x 237 | False -> y 238 | max x y = case x > y of 239 | True -> x 240 | False -> y 241 | instance Ord a => Ord [a] where 242 | compare (x:xs) (y:ys) = case compare x y of 243 | EQ -> compare xs ys 244 | x -> x 245 | compare (_:_) [] = GT 246 | compare [] (_:_) = LT 247 | compare [] [] = EQ 248 | 249 | class Functor f where 250 | fmap :: (a -> b) -> f a -> f b 251 | 252 | instance Functor Maybe where 253 | fmap f x = case x of 254 | Just y -> Just (f y) 255 | Nothing -> Nothing 256 | 257 | instance Functor [] where 258 | fmap = map 259 | 260 | infixl 1 >>, >>= 261 | 262 | class Monad m where 263 | (>>=) :: m a -> (a -> m b) -> m b 264 | return :: a -> m a 265 | fail :: [Char] -> m a 266 | 267 | (>>) :: Monad m => m a -> m b -> m b 268 | (>>) x y = x >>= \_ -> y 269 | 270 | instance Monad Maybe where 271 | (>>=) x f = case x of 272 | Just y -> f y 273 | Nothing -> Nothing 274 | return x = Just x 275 | fail x = error x 276 | 277 | instance Monad [] where 278 | (>>=) xs f = concat (map f xs) 279 | return x = [x] 280 | fail x = error x 281 | 282 | class Enum a where 283 | succ :: a -> a 284 | pred :: a -> a 285 | enumFrom :: a -> [a] 286 | enumFromThen :: a -> a -> [a] 287 | enumFromTo :: a -> a -> [a] 288 | enumFromThenTo :: a -> a -> a -> [a] 289 | 290 | instance Enum Int where 291 | succ x = x + 1 292 | pred x = x - 1 293 | enumFrom x = 294 | let 295 | xs = x : enumFrom (x + 1) 296 | in xs 297 | enumFromThen n step = n : enumFromThen (n + step) step 298 | enumFromTo start stop = case start <= stop of 299 | True -> start : enumFromTo (start + 1) stop 300 | False -> [] 301 | enumFromThenTo start step stop = case start <= stop of 302 | True -> start : enumFromThenTo (start + step) step stop 303 | False -> [] 304 | 305 | instance Enum Double where 306 | succ x = x + 1 307 | pred x = x - 1 308 | enumFrom x = 309 | let 310 | xs = x : enumFrom (x + 1) 311 | in xs 312 | enumFromThen n step = n : enumFromThen (n + step) step 313 | enumFromTo start stop = case start <= stop of 314 | True -> start : enumFromTo (start + 1) stop 315 | False -> [] 316 | enumFromThenTo start step stop = case start <= stop of 317 | True -> start : enumFromThenTo (start + step) step stop 318 | False -> [] 319 | 320 | otherwise :: Bool 321 | otherwise = True 322 | 323 | fst :: (a, b) -> a 324 | fst x = case x of 325 | (y, _) -> y 326 | 327 | 328 | snd :: (a, b) -> b 329 | snd x = case x of 330 | (_, y) -> y 331 | 332 | curry :: ((a, b) -> c) -> a -> b -> c 333 | curry f x y = f (x, y) 334 | 335 | uncurry :: (a -> b -> c) -> (a, b) -> c 336 | uncurry f x = case x of 337 | (y, z) -> f y z 338 | 339 | const :: a -> b -> a 340 | const x _ = x 341 | 342 | infixr 9 . 343 | 344 | (.) :: (b -> c) -> (a -> b) -> (a -> c) 345 | (.) f g x = f (g x) 346 | 347 | infixr 0 $, $!, `seq` 348 | 349 | ($) :: (a -> b) -> a -> b 350 | ($) f x = f x 351 | 352 | until :: (a -> Bool) -> (a -> a) -> a -> a 353 | until p f x 354 | | p x = x 355 | | otherwise = until p f (f x) 356 | 357 | map :: (a -> b) -> [a] -> [b] 358 | map f (y:ys) = f y : map f ys 359 | map f [] = [] 360 | 361 | foldl :: (b -> a -> b) -> b -> [a] -> b 362 | foldl f x (y:ys) = foldl f (f x y) ys 363 | foldl f x [] = x 364 | 365 | undefined :: a 366 | undefined = error "undefined" 367 | 368 | head :: [a] -> a 369 | head xs = case xs of 370 | y:ys -> y 371 | [] -> error "head called on empty list" 372 | 373 | last :: [a] -> a 374 | last xs = case xs of 375 | y:ys -> case ys of 376 | _:zs -> last ys 377 | [] -> y 378 | [] -> error "last called on empty list" 379 | 380 | tail :: [a] -> [a] 381 | tail xs = case xs of 382 | y:ys -> ys 383 | [] -> error "tail called on empty list" 384 | 385 | init :: [a] -> [a] 386 | init xs = case xs of 387 | y:ys -> case ys of 388 | _:zs -> y : init ys 389 | [] -> [] 390 | [] -> error "init called on empty list" 391 | 392 | sum :: Num a => [a] -> a 393 | sum xs = case xs of 394 | y:ys -> y + sum ys 395 | [] -> 0 396 | 397 | infixl 9 !! 398 | 399 | (!!) :: [a] -> Int -> a 400 | (!!) xs n = case xs of 401 | y:ys -> case n of 402 | 0 -> y 403 | _ -> ys !! (n-1) 404 | [] -> error "(!!) index to large" 405 | 406 | reverse_ :: [a] -> [a] -> [a] 407 | reverse_ xs ys = case xs of 408 | z:zs -> reverse_ zs (z : ys) 409 | [] -> ys 410 | 411 | reverse :: [a] -> [a] 412 | reverse xs = reverse_ xs [] 413 | 414 | infixr 5 ++ 415 | 416 | (++) :: [a] -> [a] -> [a] 417 | (++) xs ys = case xs of 418 | x2:xs2 -> x2 : (xs2 ++ ys) 419 | [] -> ys 420 | 421 | filter :: (a -> Bool) -> [a] -> [a] 422 | filter p xs = case xs of 423 | y:ys -> case p y of 424 | True -> y : filter p ys 425 | False -> filter p ys 426 | [] -> [] 427 | 428 | null :: [a] -> Bool 429 | null xs = case xs of 430 | y:ys -> False 431 | [] -> True 432 | 433 | length :: [a] -> Int 434 | length xs = case xs of 435 | _:ys -> 1 + length ys 436 | [] -> 0 437 | 438 | concat :: [[a]] -> [a] 439 | concat xs = case xs of 440 | y:ys -> y ++ concat ys 441 | [] -> [] 442 | 443 | 444 | class Show a where 445 | show :: a -> [Char] 446 | 447 | instance Show Bool where 448 | show x = case x of 449 | True -> "True" 450 | False -> "False" 451 | 452 | instance (Show a, Show b) => Show (a, b) where 453 | show x = case x of 454 | (y, z) -> "(" ++ show y ++ ", " ++ show z ++ ")" 455 | 456 | instance Show a => Show (Maybe a) where 457 | show x = case x of 458 | Just y -> "Just (" ++ show y ++ ")" 459 | Nothing -> "Nothing" 460 | 461 | data RealWorld = RealWorld 462 | 463 | data IO a = IO 464 | 465 | instance Monad IO where 466 | (>>=) x f = io_bind x f 467 | return = io_return 468 | fail x = error x 469 | 470 | 471 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Haskell compiler 2 | 3 | This is a compiler for Haskell written in the [Rust programming language](https://www.rust-lang.org). This is no longer actively being worked on since I am currently working on other projects (mainly [gluon](https://github.com/gluon-lang/gluon). Though this should continue to compile on newer versions of Rustc it is possible that it may stop working as it is not actively maintained. Do let me know if that is the case though as I do still want to keep the project working. 4 | 5 | As the project is right now it can handle quite large parts of Haskell though bugs have to be expected. 6 | 7 | ## "Implemented" features 8 | * Typechecking 9 | * Higher kinded types 10 | * Algebraic data types 11 | * newtypes 12 | * Type classes 13 | * Large parts of the Prelude 14 | * `do` expressions 15 | * Simple REPL 16 | 17 | ## Known unimplemented features 18 | 19 | * Kind inference 20 | * Arithmetic sequences 21 | * List comprehensions 22 | * Foreign Function Interface 23 | * Most of the standard library 24 | * deriving other than for `Eq` and `Ord` 25 | * Type definitions 26 | * and more! 27 | -------------------------------------------------------------------------------- /Test.hs: -------------------------------------------------------------------------------- 1 | module Test where 2 | import Prelude 3 | 4 | 5 | test :: IO Int 6 | test = do 7 | let y = primIntAdd 0 2 * 4 8 | putStrLn "test" 9 | return y 10 | 11 | main :: Int 12 | main = sum [1, 2, 3] 13 | 14 | 15 | -------------------------------------------------------------------------------- /metrics: -------------------------------------------------------------------------------- 1 | { 2 | "compiler::tests::bench_prelude": { 3 | "noise": 1709961.1, 4 | "value": 9338681 5 | }, 6 | "lambda_lift::tests::bench": { 7 | "noise": 1827871.5, 8 | "value": 10046435.5 9 | }, 10 | "parser::tests::bench_prelude": { 11 | "noise": 3274298.25, 12 | "value": 32037115.5 13 | }, 14 | "typecheck::test::bench_prelude": { 15 | "noise": 4172798.2, 16 | "value": 48886953 17 | } 18 | } -------------------------------------------------------------------------------- /src/builtins.rs: -------------------------------------------------------------------------------- 1 | use crate::types::{Type, TypeVariable, Kind}; 2 | use crate::interner::intern; 3 | use crate::renamer::{name, Name}; 4 | use crate::renamer::typ::*; 5 | 6 | ///Returns an array of all the compiler primitves which exist (not including numeric primitives atm) 7 | pub fn builtins() -> Vec<(&'static str, Type)> { 8 | let var = Type::Generic(TypeVariable { id: intern("a"), kind: Kind::Star, age: 0 } ); 9 | let var2 = Type::Generic(TypeVariable { id: intern("b"), kind: Kind::Star, age: 0 } ); 10 | vec![("error", function_type_(list_type(char_type()), var.clone())), 11 | ("seq", function_type_(var.clone(), function_type_(var2.clone(), var2.clone()))), 12 | ("readFile", function_type_(list_type(char_type()), io(list_type(char_type())))), 13 | ("io_bind", function_type_(io(var.clone()), 14 | function_type_(function_type_(var.clone(), io(var2.clone())), 15 | io(var2.clone())))), 16 | ("io_return", function_type_(var.clone(), io(var.clone()))), 17 | ("putStrLn", function_type_(list_type(char_type()), io(unit()))), 18 | ("#compare_tags", function_type_(var.clone(), function_type_(var.clone(), Type::new_op(name("Ordering"), Vec::new())))), 19 | ] 20 | } 21 | 22 | -------------------------------------------------------------------------------- /src/deriving.rs: -------------------------------------------------------------------------------- 1 | use crate::module::encode_binding_identifier; 2 | use crate::core::*; 3 | use crate::core::Expr::*; 4 | use crate::renamer::{name, NameSupply}; 5 | use crate::renamer::typ::*; 6 | use crate::interner::{intern, InternedStr}; 7 | 8 | pub fn generate_deriving(instances: &mut Vec>>, data: &DataDefinition) { 9 | let mut gen = DerivingGen { name_supply: NameSupply::new() }; 10 | for deriving in data.deriving.iter() { 11 | match deriving.as_ref() { 12 | "Eq" => { 13 | let mut bindings = Vec::new(); 14 | bindings.push(gen.generate_eq(data)); 15 | instances.push(Instance { 16 | constraints: Vec::new(), 17 | typ: data.typ.value.clone(), 18 | classname: Name { name: intern("Eq"), uid: 0 }, 19 | bindings: bindings 20 | }); 21 | } 22 | "Ord" => { 23 | let mut bindings = Vec::new(); 24 | let b = gen.generate_ord(data); 25 | debug!("Generated Ord {:?} ->>\n{:?}", data.typ, b); 26 | bindings.push(b); 27 | instances.push(Instance { 28 | constraints: Vec::new(), 29 | typ: data.typ.value.clone(), 30 | classname: Name { name: intern("Ord"), uid: 0 }, 31 | bindings: bindings 32 | }); 33 | } 34 | x => panic!("Cannot generate instance for class {:?}", x) 35 | } 36 | } 37 | } 38 | 39 | struct DerivingGen { 40 | name_supply: NameSupply 41 | } 42 | impl DerivingGen { 43 | fn generate_eq(&mut self, data: &DataDefinition) -> Binding> { 44 | self.make_binop("Eq", "==", data, &mut |this, id_l, id_r| { 45 | let alts = this.match_same_constructors(data, &id_r, &mut |this, l, r| this.eq_fields(l, r)); 46 | Case(Box::new(Identifier(id_l.clone())), alts) 47 | }) 48 | } 49 | 50 | fn eq_fields(&mut self, args_l: &[Id], args_r: &[Id]) -> Expr> { 51 | if args_l.len() >= 1 { 52 | let first = bool_binop("==", Identifier(args_l[0].clone()), Identifier(args_r[0].clone())); 53 | args_l.iter().skip(1).zip(args_r.iter().skip(1)).fold(first, |acc, (l, r)| { 54 | let test = bool_binop("==", Identifier(l.clone()), Identifier(r.clone())); 55 | bool_binop("&&", acc, test) 56 | }) 57 | } 58 | else { 59 | true_expr() 60 | } 61 | } 62 | 63 | fn generate_ord(&mut self, data: &DataDefinition) -> Binding> { 64 | self.make_binop("Ord", "compare", data, &mut |this, id_l, id_r| { 65 | //We first compare the tags of the arguments since this would otherwise the last of the alternatives 66 | let when_eq = { 67 | let alts = this.match_same_constructors(data, &id_r, &mut |this, l, r| this.ord_fields(l, r)); 68 | Case(Box::new(Identifier(id_l.clone())), alts) 69 | }; 70 | let cmp = compare_tags(Identifier(id_l), Identifier(id_r)); 71 | this.eq_or_default(cmp, when_eq) 72 | }) 73 | } 74 | 75 | fn ord_fields(&mut self, args_l: &[Id], args_r: &[Id]) -> Expr> { 76 | let ordering = Type::new_op(name("Ordering"), Vec::new()); 77 | if args_l.len() >= 1 { 78 | let mut iter = args_l.iter().zip(args_r.iter()).rev(); 79 | let (x, y) = iter.next().unwrap(); 80 | let last = binop("compare", Identifier(x.clone()), Identifier(y.clone()), ordering.clone()); 81 | iter.fold(last, |acc, (l, r)| { 82 | let test = bool_binop("compare", Identifier(l.clone()), Identifier(r.clone())); 83 | self.eq_or_default(test, acc) 84 | }) 85 | } 86 | else { 87 | Identifier(id("EQ", ordering)) 88 | } 89 | } 90 | 91 | ///Creates a binary function binding with the name 'funcname' which is a function in an instance for 'data' 92 | ///This function takes two parameters of the type of 'data' 93 | fn make_binop(&mut self, class: &str, funcname: &str, data: &DataDefinition, func: &mut dyn FnMut(&mut DerivingGen, Id, Id) -> Expr>) -> Binding> { 94 | let arg_l = self.name_supply.anonymous(); 95 | let arg_r = self.name_supply.anonymous(); 96 | let mut id_r = Id::new(arg_r, data.typ.value.clone(), data.typ.constraints.clone()); 97 | let mut id_l = Id::new(arg_l, data.typ.value.clone(), data.typ.constraints.clone()); 98 | let expr = func(self, id_l.clone(), id_r.clone()); 99 | id_r.typ.value = function_type_(data.typ.value.clone(), bool_type()); 100 | id_l.typ.value = function_type_(data.typ.value.clone(), function_type_(data.typ.value.clone(), bool_type())); 101 | let lambda_expr = Lambda(id_l, Box::new(Lambda(id_r, Box::new(expr))));//TODO types 102 | let data_name = extract_applied_type(&data.typ.value).ctor().name; 103 | let name = encode_binding_identifier(data_name.name, intern(funcname)); 104 | //Create a constraint for each type parameter 105 | fn make_constraints(mut result: Vec>, class: InternedStr, typ: &Type) -> Vec> { 106 | match typ { 107 | &Type::Application(ref f, ref param) => { 108 | result.push(Constraint { class: Name { name: class, uid: 0 }, variables: vec![param.var().clone()] }); 109 | make_constraints(result, class, &**f) 110 | } 111 | _ => result 112 | } 113 | } 114 | let constraints = make_constraints(Vec::new(), intern(class), &data.typ.value); 115 | Binding { 116 | name: Id::new(Name { name: name, uid: 0 }, lambda_expr.get_type().clone(), constraints), 117 | expression: lambda_expr 118 | } 119 | } 120 | 121 | fn eq_or_default(&mut self, cmp: Expr>, def: Expr>) -> Expr> { 122 | let match_id = Id::new(self.name_supply.anonymous(), Type::new_op(name("Ordering"), Vec::new()), Vec::new()); 123 | Case(Box::new(cmp), vec![ 124 | Alternative { 125 | pattern: Pattern::Constructor(id("EQ", Type::new_op(name("Ordering"), Vec::new())), Vec::new()), 126 | expression: def 127 | }, 128 | Alternative { pattern: Pattern::Identifier(match_id.clone()), expression: Identifier(match_id) } 129 | ]) 130 | } 131 | 132 | fn match_same_constructors(&mut self, data: &DataDefinition, id_r: &Id, f: &mut dyn FnMut(&mut DerivingGen, &[Id], &[Id]) -> Expr>) -> Vec>> { 133 | let alts: Vec>> = data.constructors.iter().map(|constructor| { 134 | let args_l: Vec> = 135 | ArgIterator { typ: &constructor.typ.value } 136 | .map(|arg| Id::new(self.name_supply.anonymous(), arg.clone(), constructor.typ.constraints.clone())) 137 | .collect(); 138 | let mut iter = ArgIterator { typ: &constructor.typ.value }; 139 | let args_r: Vec> = iter.by_ref() 140 | .map(|arg| Id::new(self.name_supply.anonymous(), arg.clone(), constructor.typ.constraints.clone())) 141 | .collect(); 142 | let ctor_id = Id::new(constructor.name, iter.typ.clone(), constructor.typ.constraints.clone()); 143 | let expr = f(self, &*args_l, &*args_r); 144 | let pattern_r = Pattern::Constructor(ctor_id.clone(), args_r); 145 | let inner = Case(Box::new(Identifier(id_r.clone())), vec![ 146 | Alternative { pattern: pattern_r, expression: expr }, 147 | Alternative { 148 | pattern: Pattern::WildCard, 149 | expression: Identifier(Id::new(Name { uid: 0, name: intern("False") }, bool_type(), Vec::new())) 150 | } 151 | ]); 152 | Alternative { pattern: Pattern::Constructor(ctor_id, args_l), expression: inner } 153 | }).collect(); 154 | alts 155 | } 156 | } 157 | 158 | 159 | fn id(s: &str, typ: Type) -> Id { 160 | Id::new(Name {name: intern(s), uid: 0 }, typ, Vec::new()) 161 | } 162 | 163 | fn compare_tags(lhs: Expr>, rhs: Expr>) -> Expr> { 164 | let var = Type::new_var(intern("a")); 165 | let typ = function_type_(var.clone(), function_type_(var.clone(), Type::new_op(name("Ordering"), Vec::new()))); 166 | let id = Id::new(name("#compare_tags"), typ, Vec::new()); 167 | Apply(Box::new(Apply(Box::new(Identifier(id)), Box::new(lhs))), Box::new(rhs)) 168 | } 169 | 170 | fn bool_binop(op: &str, lhs: Expr>, rhs: Expr>) -> Expr> { 171 | binop(op, lhs, rhs, bool_type()) 172 | } 173 | fn binop(op: &str, lhs: Expr>, rhs: Expr>, return_type: Type) -> Expr> { 174 | let typ = function_type_(lhs.get_type().clone(), function_type_(rhs.get_type().clone(), return_type)); 175 | let f = Identifier(Id::new(name(op), typ, Vec::new())); 176 | Apply(Box::new(Apply(Box::new(f), Box::new(lhs))), Box::new(rhs)) 177 | } 178 | 179 | fn true_expr() -> Expr> { 180 | Identifier(Id::new(name("True"), bool_type(), Vec::new())) 181 | } 182 | 183 | struct ArgIterator<'a> { 184 | typ: &'a Type 185 | } 186 | impl <'a> Iterator for ArgIterator<'a> { 187 | type Item = &'a Type; 188 | fn next(&mut self) -> Option<&'a Type> { 189 | use crate::types::try_get_function; 190 | match try_get_function(self.typ) { 191 | Some((arg, rest)) => { 192 | self.typ = rest; 193 | Some(arg) 194 | } 195 | None => None 196 | } 197 | } 198 | } 199 | fn extract_applied_type<'a, Id>(typ: &'a Type) -> &'a Type { 200 | match typ { 201 | &Type::Application(ref lhs, _) => extract_applied_type(&**lhs), 202 | _ => typ 203 | } 204 | } 205 | -------------------------------------------------------------------------------- /src/graph.rs: -------------------------------------------------------------------------------- 1 | ///Graph module, contains a simple graph structure which is when typechecking to find 2 | ///functions which are mutually recursive 3 | 4 | use std::iter::repeat; 5 | use std::cmp::min; 6 | 7 | #[derive(PartialEq, Copy, Clone, Debug)] 8 | pub struct VertexIndex(usize); 9 | #[derive(PartialEq, Copy, Clone, Debug)] 10 | pub struct EdgeIndex(usize); 11 | 12 | impl VertexIndex { 13 | fn get(&self) -> usize { let VertexIndex(v) = *self; v } 14 | } 15 | impl EdgeIndex { 16 | fn get(&self) -> usize { let EdgeIndex(v) = *self; v } 17 | } 18 | 19 | pub struct Vertex { 20 | pub value: T, 21 | edges: Vec 22 | } 23 | pub struct Edge { 24 | from: VertexIndex, 25 | to: VertexIndex 26 | } 27 | 28 | pub struct Graph { 29 | edges: Vec, 30 | vertices: Vec> 31 | } 32 | 33 | impl Graph { 34 | ///Creates a new graph 35 | pub fn new() -> Graph { 36 | Graph { edges: Vec::new(), vertices: Vec::new() } 37 | } 38 | ///Creates a new vertex and returns the index which refers to it 39 | pub fn new_vertex(&mut self, value: T) -> VertexIndex { 40 | self.vertices.push(Vertex { edges:Vec::new(), value: value }); 41 | VertexIndex(self.vertices.len() - 1) 42 | } 43 | 44 | ///Connects two vertices with an edge 45 | pub fn connect(&mut self, from: VertexIndex, to: VertexIndex) { 46 | self.vertices[from.get()].edges.push(EdgeIndex(self.edges.len())); 47 | self.edges.push(Edge { from: from, to: to }); 48 | } 49 | ///Returns the vertex at the index 50 | pub fn get_vertex<'a>(&'a self, v: VertexIndex) -> &'a Vertex { 51 | &self.vertices[v.get()] 52 | } 53 | 54 | ///Returns the edge at the index 55 | pub fn get_edge<'a>(&'a self, edge: EdgeIndex) -> &'a Edge { 56 | &self.edges[edge.get()] 57 | } 58 | 59 | ///Returns how many vertices are in the graph 60 | pub fn len(&self) -> usize { 61 | self.vertices.len() 62 | } 63 | } 64 | 65 | ///Analyzes the graph for strongly connect components. 66 | ///Returns a vector of indices where each group is a separte vector 67 | pub fn strongly_connected_components(graph: &Graph) -> Vec> { 68 | 69 | let mut tarjan = TarjanComponents { graph: graph, index: 1, stack: Vec::new(), connections: Vec::new(), 70 | valid: repeat(0).take(graph.len()).collect(), 71 | lowlink: repeat(0).take(graph.len()).collect() 72 | }; 73 | 74 | 75 | for vert in 0..graph.len() { 76 | if tarjan.valid[vert] == 0 { 77 | tarjan.strong_connect(VertexIndex(vert)); 78 | } 79 | } 80 | 81 | tarjan.connections 82 | } 83 | 84 | struct TarjanComponents<'a, T: 'a>{ 85 | index: usize, 86 | graph: &'a Graph, 87 | valid: Vec, 88 | lowlink: Vec, 89 | stack: Vec, 90 | connections: Vec> 91 | } 92 | ///Implementation of "Tarjan's strongly connected components algorithm" 93 | impl <'a, T> TarjanComponents<'a, T> { 94 | fn strong_connect(&mut self, v: VertexIndex) { 95 | self.valid[v.get()] = self.index; 96 | self.lowlink[v.get()] = self.index; 97 | self.index += 1; 98 | self.stack.push(v); 99 | 100 | for edge_index in self.graph.get_vertex(v).edges.iter() { 101 | let edge = self.graph.get_edge(*edge_index); 102 | if self.valid[edge.to.get()] == 0 { 103 | self.strong_connect(edge.to); 104 | self.lowlink[v.get()] = min(self.lowlink[v.get()], self.lowlink[edge.to.get()]); 105 | } 106 | else if self.stack.iter().any(|x| *x == edge.to) { 107 | self.lowlink[v.get()] = min(self.lowlink[v.get()], self.valid[edge.to.get()]); 108 | } 109 | } 110 | 111 | if self.lowlink.get(v.get()) == self.valid.get(v.get()) { 112 | let mut connected = Vec::new(); 113 | loop { 114 | 115 | let w = self.stack.pop().unwrap(); 116 | connected.push(w); 117 | if w == v { 118 | break 119 | } 120 | } 121 | self.connections.push(connected); 122 | } 123 | } 124 | } 125 | 126 | 127 | #[test] 128 | fn test_tarjan() { 129 | let mut graph = Graph::new(); 130 | let v1 = graph.new_vertex(()); 131 | let v2 = graph.new_vertex(()); 132 | let v3 = graph.new_vertex(()); 133 | graph.connect(v1, v2); 134 | graph.connect(v2, v1); 135 | graph.connect(v2, v3); 136 | let connections = strongly_connected_components(&graph); 137 | 138 | assert_eq!(connections.len(), 2); 139 | assert_eq!(connections[0], vec![v3]); 140 | assert_eq!(connections[1], vec![v2, v1]); 141 | } 142 | 143 | #[test] 144 | fn test_tarjan2() { 145 | let mut graph = Graph::new(); 146 | let v1 = graph.new_vertex(()); 147 | let v2 = graph.new_vertex(()); 148 | let v3 = graph.new_vertex(()); 149 | let v4 = graph.new_vertex(()); 150 | graph.connect(v1, v2); 151 | graph.connect(v2, v1); 152 | graph.connect(v2, v3); 153 | graph.connect(v3, v4); 154 | graph.connect(v4, v2); 155 | let connections = strongly_connected_components(&graph); 156 | 157 | assert_eq!(connections.len(), 1); 158 | assert_eq!(connections[0], vec![v4, v3, v2, v1]); 159 | } 160 | 161 | #[test] 162 | fn test_tarjan3() { 163 | let mut graph = Graph::new(); 164 | let v1 = graph.new_vertex(()); 165 | let v2 = graph.new_vertex(()); 166 | let v3 = graph.new_vertex(()); 167 | let v4 = graph.new_vertex(()); 168 | let v5 = graph.new_vertex(()); 169 | graph.connect(v1, v2); 170 | graph.connect(v2, v1); 171 | graph.connect(v2, v3); 172 | graph.connect(v3, v4); 173 | graph.connect(v4, v3); 174 | graph.connect(v3, v5); 175 | let connections = strongly_connected_components(&graph); 176 | 177 | assert_eq!(connections.len(), 3); 178 | assert_eq!(connections[0], vec![v5]); 179 | assert_eq!(connections[1], vec![v4, v3]); 180 | assert_eq!(connections[2], vec![v2, v1]); 181 | } 182 | -------------------------------------------------------------------------------- /src/infix.rs: -------------------------------------------------------------------------------- 1 | use crate::module::*; 2 | use crate::renamer::Name; 3 | use crate::interner::intern; 4 | use std::collections::HashMap; 5 | 6 | pub struct PrecedenceVisitor { precedence: HashMap } 7 | 8 | impl MutVisitor for PrecedenceVisitor { 9 | fn visit_expr(&mut self, expr: &mut TypedExpr) { 10 | walk_expr_mut(self, expr); 11 | match expr.expr { 12 | Expr::OpApply(..) => { 13 | let mut temp = TypedExpr::new(Expr::Identifier(Name { uid: usize::max_value(), name: intern("") })); 14 | ::std::mem::swap(&mut temp, expr); 15 | temp = self.rewrite(Box::new(temp)); 16 | ::std::mem::swap(&mut temp, expr); 17 | } 18 | _ => () 19 | } 20 | } 21 | fn visit_module(&mut self, module: &mut Module) { 22 | for fixity in module.fixity_declarations.iter() { 23 | for op in fixity.operators.iter() { 24 | self.precedence.insert(op.clone(), (fixity.precedence, fixity.assoc)); 25 | } 26 | } 27 | walk_module_mut(self, module); 28 | } 29 | } 30 | impl PrecedenceVisitor { 31 | 32 | pub fn new() -> PrecedenceVisitor { 33 | let mut map = HashMap::new(); 34 | map.insert(Name { uid: 0, name: intern(":") }, (5, Assoc::Right)); 35 | PrecedenceVisitor { precedence: map } 36 | } 37 | 38 | fn get_precedence(&self, name: &Name) -> (isize, Assoc) { 39 | self.precedence.get(name) 40 | .map(|x| *x) 41 | .unwrap_or_else(|| (9, Assoc::Left)) 42 | } 43 | 44 | ///Takes a operator expression the is in the form (1 + (2 * (3 - 4))) and rewrites it using the 45 | ///operators real precedences 46 | fn rewrite(&self, mut input: Box>) -> TypedExpr { 47 | //Takes the two expressions at the top of the stack and applies the operator at the top to them 48 | fn reduce(expr_stack: &mut Vec>>, op_stack: &mut Vec) { 49 | assert!(expr_stack.len() >= 2); 50 | let op = op_stack.pop().unwrap(); 51 | let rhs = expr_stack.pop().unwrap(); 52 | let lhs = expr_stack.pop().unwrap(); 53 | let loc = lhs.location; 54 | expr_stack.push(Box::new(TypedExpr::with_location(Expr::OpApply(lhs, op, rhs), loc))); 55 | } 56 | let mut expr_stack = Vec::new(); 57 | let mut op_stack = Vec::new(); 58 | loop { 59 | //FIXME should destructure instead of clone 60 | let TypedExpr { typ, location, expr } = (*input).clone(); 61 | match expr { 62 | Expr::OpApply(l, op, r) => { 63 | expr_stack.push(l); 64 | input = r; 65 | loop { 66 | match op_stack.last().map(|x| *x) { 67 | Some(previous_op) => { 68 | let (op_prec, op_assoc) = self.get_precedence(&op); 69 | let (prev_prec, prev_assoc) = self.get_precedence(&previous_op); 70 | if op_prec > prev_prec { 71 | op_stack.push(op); 72 | break 73 | } 74 | else if op_prec == prev_prec { 75 | match (op_assoc, prev_assoc) { 76 | (Assoc::Left, Assoc::Left) => { 77 | reduce(&mut expr_stack, &mut op_stack); 78 | } 79 | (Assoc::Right, Assoc::Right) => { 80 | debug!("Shift op {:?}", op); 81 | op_stack.push(op); 82 | break 83 | } 84 | _ => panic!("Syntax error: mismatched associativity") 85 | } 86 | } 87 | else { 88 | reduce(&mut expr_stack, &mut op_stack); 89 | } 90 | } 91 | None => { 92 | op_stack.push(op); 93 | break 94 | } 95 | } 96 | } 97 | } 98 | rhs => { 99 | let mut result = TypedExpr { typ: typ, location: location, expr: rhs }; 100 | while op_stack.len() != 0 { 101 | assert!(expr_stack.len() >= 1); 102 | let lhs = expr_stack.pop().unwrap(); 103 | let op = op_stack.pop().unwrap(); 104 | result = TypedExpr::with_location(Expr::OpApply(lhs, op, Box::new(result)), location); 105 | } 106 | return result; 107 | } 108 | } 109 | } 110 | } 111 | } 112 | 113 | #[cfg(test)] 114 | mod tests { 115 | use crate::parser::*; 116 | use crate::module::*; 117 | use crate::interner::intern; 118 | use crate::typecheck::*; 119 | use crate::infix::PrecedenceVisitor; 120 | use crate::renamer::tests::{rename_expr, rename_modules}; 121 | 122 | #[test] 123 | fn operator_precedence() 124 | { 125 | let m = parse_string( 126 | r"import Prelude 127 | test = 3 * 4 - 5 * 6").unwrap(); 128 | let mut modules = rename_modules(m); 129 | let mut v = PrecedenceVisitor::new(); 130 | for module in modules.iter_mut() { 131 | v.visit_module(module); 132 | } 133 | assert_eq!(modules.last().unwrap().bindings[0].matches, Match::Simple(rename_expr(op_apply( 134 | op_apply(number(3), intern("*"), number(4)), 135 | intern("-"), 136 | op_apply(number(5), intern("*"), number(6)))))); 137 | } 138 | #[test] 139 | fn operator_precedence_parens() 140 | { 141 | let m = parse_string( 142 | r"import Prelude 143 | test = 3 * 4 * (5 - 6)").unwrap(); 144 | let mut modules = rename_modules(m); 145 | let mut v = PrecedenceVisitor::new(); 146 | for module in modules.iter_mut() { 147 | v.visit_module(module); 148 | } 149 | assert_eq!(modules.last().unwrap().bindings[0].matches, Match::Simple(rename_expr(op_apply( 150 | op_apply(number(3), intern("*"), number(4)), 151 | intern("*"), 152 | paren(op_apply(number(5), intern("-"), number(6))))))); 153 | } 154 | 155 | #[test] 156 | fn rewrite_operators() { 157 | let mut expr = rename_expr(op_apply(number(1), intern("*"), op_apply(number(2), intern("+"), number(3)))); 158 | PrecedenceVisitor::new().visit_expr(&mut expr); 159 | assert_eq!(expr, rename_expr(op_apply(op_apply(number(1), intern("*"), number(2)), intern("+"), number(3)))); 160 | } 161 | 162 | } 163 | -------------------------------------------------------------------------------- /src/interner.rs: -------------------------------------------------------------------------------- 1 | use std::collections::HashMap; 2 | use std::rc::Rc; 3 | use std::cell::RefCell; 4 | use std::ops::Deref; 5 | use std::fmt; 6 | 7 | #[derive(Eq, PartialEq, Clone, Copy, Default, Hash, Debug)] 8 | pub struct InternedStr(usize); 9 | 10 | pub struct Interner { 11 | indexes: HashMap, 12 | strings: Vec 13 | } 14 | 15 | impl Interner { 16 | 17 | pub fn new() -> Interner { 18 | Interner { indexes: HashMap::new(), strings: Vec::new() } 19 | } 20 | 21 | pub fn intern(&mut self, s: &str) -> InternedStr { 22 | match self.indexes.get(s).map(|x| *x) { 23 | Some(index) => InternedStr(index), 24 | None => { 25 | let index = self.strings.len(); 26 | self.indexes.insert(s.to_string(), index); 27 | self.strings.push(s.to_string()); 28 | InternedStr(index) 29 | } 30 | } 31 | } 32 | 33 | pub fn get_str<'a>(&'a self, InternedStr(i): InternedStr) -> &'a str { 34 | if i < self.strings.len() { 35 | &*self.strings[i] 36 | } 37 | else { 38 | panic!("Invalid InternedStr {:?}", i) 39 | } 40 | } 41 | } 42 | 43 | ///Returns a reference to the interner stored in TLD 44 | pub fn get_local_interner() -> Rc> { 45 | thread_local!(static INTERNER: Rc> = Rc::new(RefCell::new(Interner::new()))); 46 | INTERNER.with(|interner| interner.clone()) 47 | } 48 | 49 | pub fn intern(s: &str) -> InternedStr { 50 | let i = get_local_interner(); 51 | let mut i = i.borrow_mut(); 52 | i.intern(s) 53 | } 54 | 55 | impl Deref for InternedStr { 56 | type Target = str; 57 | fn deref(&self) -> &str { 58 | self.as_ref() 59 | } 60 | } 61 | 62 | impl AsRef for InternedStr { 63 | fn as_ref(&self) -> &str { 64 | let interner = get_local_interner(); 65 | let x = (*interner).borrow_mut(); 66 | let r: &str = x.get_str(*self); 67 | //The interner is task local and will never remove a string so this is safe 68 | unsafe { ::std::mem::transmute(r) } 69 | } 70 | } 71 | 72 | impl fmt::Display for InternedStr { 73 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 74 | write!(f, "{:?}", self.as_ref()) 75 | } 76 | } 77 | -------------------------------------------------------------------------------- /src/lambda_lift.rs: -------------------------------------------------------------------------------- 1 | use std::collections::HashMap; 2 | use std::collections::hash_map::Entry; 3 | use crate::core::*; 4 | use crate::core::Expr::*; 5 | use crate::renamer::NameSupply; 6 | use crate::renamer::typ::*; 7 | 8 | pub type TypeAndStr = Id; 9 | 10 | pub fn do_lambda_lift(module: Module) -> Module { 11 | lift_lambdas(abstract_module(module)) 12 | } 13 | 14 | struct FreeVariables { 15 | name_supply: NameSupply 16 | } 17 | 18 | fn each_pattern_variables(pattern: &Pattern, f: &mut dyn FnMut(&Name)) { 19 | match *pattern { 20 | Pattern::Identifier(ref ident) => (*f)(&ident.name), 21 | Pattern::Constructor(_, ref patterns) => { 22 | for p in patterns.iter() { 23 | (*f)(&p.name); 24 | } 25 | } 26 | _ => () 27 | } 28 | } 29 | 30 | 31 | impl FreeVariables { 32 | 33 | //Walks through an expression and notes all the free variables and for each lambda, adds the 34 | //free variables to its arguments and performs an immediate application 35 | //@variables All the local variables in scope, values are how many of the name there exists 36 | //@free_vars The free variables for the returned expression 37 | fn free_variables(&mut self, variables: &mut HashMap, free_vars: &mut HashMap, expr: &mut Expr) { 38 | match *expr { 39 | Identifier(ref mut i) => { 40 | //If the identifier is a local, add it to the free variables 41 | if variables.get(&i.name).map(|x| *x > 0).unwrap_or(false) { 42 | free_vars.insert(i.name.clone(), i.clone()); 43 | } 44 | } 45 | Apply(ref mut func, ref mut arg) => { 46 | self.free_variables(variables, free_vars, &mut **func); 47 | self.free_variables(variables, free_vars, &mut **arg); 48 | } 49 | Lambda(ref mut arg, ref mut body) => { 50 | match variables.entry(arg.name.clone()) { 51 | Entry::Vacant(entry) => { entry.insert(1); } 52 | Entry::Occupied(mut entry) => *entry.get_mut() += 1 53 | } 54 | self.free_variables(variables, free_vars, &mut **body); 55 | *variables.get_mut(&arg.name).unwrap() -= 1; 56 | free_vars.remove(&arg.name);//arg was not actually a free variable 57 | } 58 | Let(ref mut bindings, ref mut expr) => { 59 | for bind in bindings.iter() { 60 | match variables.entry(bind.name.name.clone()) { 61 | Entry::Vacant(entry) => { entry.insert(1); } 62 | Entry::Occupied(mut entry) => *entry.get_mut() += 1 63 | } 64 | } 65 | let mut free_vars2 = HashMap::new(); 66 | for bind in bindings.iter_mut() { 67 | free_vars2.clear(); 68 | self.free_variables(variables, &mut free_vars2, &mut bind.expression); 69 | //free_vars2 is the free variables for this binding 70 | for (k, v) in free_vars2.iter() { 71 | free_vars.insert(k.clone(), v.clone()); 72 | } 73 | self.abstract_(&free_vars2, &mut bind.expression); 74 | } 75 | self.free_variables(variables, free_vars, &mut **expr); 76 | for bind in bindings.iter() { 77 | *variables.get_mut(&bind.name.name).unwrap() -= 1; 78 | free_vars.remove(&bind.name.name); 79 | } 80 | } 81 | Case(ref mut expr, ref mut alts) => { 82 | self.free_variables(variables, free_vars, &mut **expr); 83 | for alt in alts.iter_mut() { 84 | each_pattern_variables(&alt.pattern, &mut |name| { 85 | match variables.entry(name.clone()) { 86 | Entry::Vacant(entry) => { entry.insert(1); } 87 | Entry::Occupied(mut entry) => *entry.get_mut() += 1 88 | } 89 | }); 90 | self.free_variables(variables, free_vars, &mut alt.expression); 91 | each_pattern_variables(&alt.pattern, &mut |name| { 92 | *variables.get_mut(name).unwrap() -= 1; 93 | free_vars.remove(name);//arg was not actually a free variable 94 | }); 95 | } 96 | } 97 | _ => () 98 | } 99 | } 100 | ///Adds the free variables, if any, to the expression 101 | fn abstract_(&mut self, free_vars: &HashMap, input_expr: &mut Expr) { 102 | if free_vars.len() != 0 { 103 | let mut temp = Literal(LiteralData { typ: Type::new_var(self.name_supply.from_str("a").name), value: Integral(0) }); 104 | ::std::mem::swap(&mut temp, input_expr); 105 | let mut e = { 106 | let mut rhs = temp; 107 | let mut typ = rhs.get_type().clone(); 108 | for (_, var) in free_vars.iter() { 109 | rhs = Lambda(var.clone(), Box::new(rhs)); 110 | typ = function_type_(var.get_type().clone(), typ); 111 | } 112 | let id = Id::new(self.name_supply.from_str("#sc"), typ.clone(), Vec::new()); 113 | let bind = Binding { 114 | name: id.clone(), 115 | expression: rhs 116 | }; 117 | Let(vec![bind], Box::new(Identifier(id))) 118 | }; 119 | for (_, var) in free_vars.iter() { 120 | e = Apply(Box::new(e), Box::new(Identifier(var.clone()))); 121 | } 122 | *input_expr = e 123 | } 124 | } 125 | } 126 | 127 | ///Lifts all lambdas in the module to the top level of the program 128 | pub fn lift_lambdas(mut module: Module) -> Module { 129 | use crate::core::mutable::*; 130 | struct LambdaLifter { out_lambdas: Vec> } 131 | impl Visitor for LambdaLifter { 132 | fn visit_expr(&mut self, expr: &mut Expr) { 133 | match *expr { 134 | Let(ref mut bindings, ref mut body) => { 135 | let mut new_binds = Vec::new(); 136 | let mut bs = vec![]; 137 | ::std::mem::swap(&mut bs, bindings); 138 | for mut bind in bs.into_iter() { 139 | let is_lambda = match bind.expression { 140 | Lambda(..) => true, 141 | _ => false 142 | }; 143 | walk_expr(self, &mut bind.expression); 144 | if is_lambda { 145 | self.out_lambdas.push(bind); 146 | } 147 | else { 148 | new_binds.push(bind); 149 | } 150 | } 151 | *bindings = new_binds; 152 | self.visit_expr(&mut **body); 153 | } 154 | _ => walk_expr(self, expr) 155 | } 156 | remove_empty_let(expr); 157 | } 158 | } 159 | let mut visitor = LambdaLifter { out_lambdas: Vec::new() }; 160 | visitor.visit_module(&mut module); 161 | let mut temp = Vec::new(); 162 | ::std::mem::swap(&mut temp, &mut module.bindings); 163 | let vec : Vec> = temp.into_iter() 164 | .chain(visitor.out_lambdas.into_iter()) 165 | .collect(); 166 | module.bindings = vec; 167 | module 168 | } 169 | //Replaces let expressions with no binding with the expression itself 170 | fn remove_empty_let(expr: &mut Expr) { 171 | let mut temp = unsafe { ::std::mem::MaybeUninit::zeroed().assume_init() }; 172 | ::std::mem::swap(&mut temp, expr); 173 | temp = match temp { 174 | Let(bindings, e) => { 175 | if bindings.len() == 0 { 176 | *e 177 | } 178 | else { 179 | Let(bindings, e) 180 | } 181 | } 182 | temp => temp 183 | }; 184 | ::std::mem::swap(&mut temp, expr); 185 | ::std::mem::forget(temp); 186 | } 187 | 188 | ///Takes a module and adds all variables which are captured into a lambda to its arguments 189 | pub fn abstract_module(mut module: Module) -> Module { 190 | use crate::core::mutable::*; 191 | impl Visitor for FreeVariables { 192 | fn visit_binding(&mut self, bind: &mut Binding) { 193 | let mut variables = HashMap::new(); 194 | let mut free_vars = HashMap::new(); 195 | self.free_variables(&mut variables, &mut free_vars, &mut bind.expression); 196 | } 197 | } 198 | let mut this = FreeVariables { name_supply: NameSupply::new() }; 199 | this.visit_module(&mut module); 200 | module 201 | } 202 | 203 | #[cfg(test)] 204 | mod tests { 205 | use test::Bencher; 206 | use crate::interner::*; 207 | use crate::lambda_lift::*; 208 | use std::collections::HashSet; 209 | use crate::parser::Parser; 210 | use crate::core::ref_::*; 211 | use crate::core::translate::translate_module; 212 | use crate::renamer::tests::rename_module; 213 | use crate::typecheck::TypeEnvironment; 214 | 215 | struct CheckUniques { 216 | found: HashSet 217 | } 218 | 219 | impl Visitor for CheckUniques { 220 | fn visit_binding(&mut self, bind: &Binding) { 221 | assert!(self.found.insert(bind.name.clone())); 222 | self.visit_expr(&bind.expression); 223 | } 224 | fn visit_expr(&mut self, expr: &Expr) { 225 | match expr { 226 | &Lambda(ref i, _) => { 227 | assert!(self.found.insert(i.clone())); 228 | } 229 | _ => () 230 | } 231 | walk_expr(self, expr) 232 | } 233 | } 234 | 235 | #[test] 236 | fn all_uniques() { 237 | let mut visitor = CheckUniques { found: HashSet::new() }; 238 | let mut parser = Parser::new( 239 | r"add x y = 2 240 | test = 3.14 241 | test2 x = 242 | let 243 | test = 2 244 | f x = 245 | let g y = add x (f y) 246 | in add x test 247 | in f x".chars()); 248 | let module = translate_module(rename_module(parser.module().unwrap())); 249 | visitor.visit_module(&module); 250 | } 251 | 252 | fn check_args(expr: &Expr, args: &[InternedStr]) -> bool { 253 | match expr { 254 | &Lambda(ref arg, ref body) => arg.name.name == args[0] && check_args(&**body, &args[1..]), 255 | _ => args.len() == 0 256 | } 257 | } 258 | 259 | struct CheckAbstract { 260 | count: isize 261 | } 262 | 263 | fn get_let<'a>(expr: &'a Expr, args: &mut Vec) -> &'a Expr { 264 | match expr { 265 | &Apply(ref f, ref arg) => { 266 | match **arg { 267 | Identifier(ref i) => args.push(i.name.name), 268 | _ => panic!("Expected identifier as argument") 269 | } 270 | get_let(&**f, args) 271 | } 272 | _ => expr 273 | } 274 | } 275 | 276 | impl Visitor for CheckAbstract { 277 | fn visit_binding(&mut self, bind: &Binding) { 278 | if intern("f") == bind.name.name.name { 279 | let mut args = Vec::new(); 280 | match get_let(&bind.expression, &mut args) { 281 | &Let(ref binds, ref body) => { 282 | //Push the argument of the function itself 283 | args.push(intern("x")); 284 | assert!(check_args(&binds[0].expression, args.as_ref())); 285 | assert_eq!(Identifier(binds[0].name.clone()), **body); 286 | } 287 | _ => assert!(false, "Expected Let, found {:?}", bind.expression) 288 | } 289 | self.count += 1; 290 | } 291 | else if intern("g") == bind.name.name.name { 292 | let mut args = Vec::new(); 293 | match get_let(&bind.expression, &mut args) { 294 | &Let(ref binds, ref body) => { 295 | args.push(intern("y")); 296 | assert!(check_args(&binds[0].expression, args.as_ref())); 297 | assert_eq!(Identifier(binds[0].name.clone()), **body); 298 | } 299 | _ => assert!(false, "Expected Let") 300 | } 301 | self.count += 1; 302 | } 303 | self.visit_expr(&bind.expression); 304 | } 305 | } 306 | 307 | #[test] 308 | fn all_free_vars() { 309 | let mut visitor = CheckAbstract { count: 0 }; 310 | let mut parser = Parser::new( 311 | r"add x y = 2 312 | test = 3.14 313 | test2 x = 314 | let 315 | test = 2 316 | f x = 317 | let g y = add x (f y) 318 | in add x test 319 | in f x".chars()); 320 | let mut module = rename_module(parser.module().unwrap()); 321 | TypeEnvironment::new() 322 | .typecheck_module(&mut module) 323 | .unwrap(); 324 | let m = translate_module(module); 325 | let module = abstract_module(m); 326 | visitor.visit_module(&module); 327 | assert_eq!(visitor.count, 2); 328 | } 329 | 330 | struct NoLambdas; 331 | 332 | impl Visitor for NoLambdas { 333 | fn visit_expr(&mut self, expr: &Expr) { 334 | match expr { 335 | &Lambda(..) => assert!(false, "Found lambda in expression"), 336 | _ => () 337 | } 338 | walk_expr(self, expr); 339 | } 340 | } 341 | #[test] 342 | fn no_local_lambdas() { 343 | fn skip_lambdas(expr: &Expr) -> &Expr { 344 | match expr { 345 | &Lambda(_, ref body) => skip_lambdas(&**body), 346 | _ => expr 347 | } 348 | } 349 | 350 | let mut visitor = NoLambdas; 351 | let mut parser = Parser::new( 352 | r"add x y = 2 353 | test = 3.14 354 | test2 x = 355 | let 356 | test = 2 357 | f x = 358 | let g y = add x (f y) 359 | in add x test 360 | in f x".chars()); 361 | let m = translate_module(rename_module(parser.module().unwrap())); 362 | let module = lift_lambdas(m); 363 | for bind in module.bindings.iter() { 364 | visitor.visit_expr(skip_lambdas(&bind.expression)); 365 | } 366 | } 367 | 368 | #[bench] 369 | fn bench(b: &mut Bencher) { 370 | use std::fs::File; 371 | use std::io::Read; 372 | use std::path::Path; 373 | use crate::typecheck::test::do_typecheck; 374 | 375 | let path = &Path::new("Prelude.hs"); 376 | let mut contents = ::std::string::String::new(); 377 | File::open(path).and_then(|mut f| f.read_to_string(&mut contents)).unwrap(); 378 | let module = do_typecheck(&contents); 379 | b.iter(|| { 380 | do_lambda_lift(translate_module(module.clone())) 381 | }); 382 | } 383 | } 384 | -------------------------------------------------------------------------------- /src/lexer.rs: -------------------------------------------------------------------------------- 1 | use std::fmt; 2 | use std::collections::VecDeque; 3 | use std::iter::Peekable; 4 | use std::rc::Rc; 5 | use std::cell::RefCell; 6 | use crate::interner::*; 7 | 8 | use self::TokenEnum::*; 9 | 10 | #[derive(Clone, Copy, Eq, PartialEq, Debug)] 11 | pub enum TokenEnum { 12 | EOF, 13 | NAME, 14 | OPERATOR, 15 | NUMBER, 16 | FLOAT, 17 | STRING, 18 | CHAR, 19 | LPARENS, 20 | RPARENS, 21 | LBRACKET, 22 | RBRACKET, 23 | LBRACE, 24 | RBRACE, 25 | INDENTSTART, 26 | INDENTLEVEL, 27 | COMMA, 28 | PIPE, 29 | CONTEXTARROW, 30 | EQUALSSIGN, 31 | SEMICOLON, 32 | MODULE, 33 | CLASS, 34 | INSTANCE, 35 | WHERE, 36 | LET, 37 | IN, 38 | CASE, 39 | OF, 40 | ARROW, 41 | LARROW, 42 | TYPEDECL, 43 | DATA, 44 | NEWTYPE, 45 | LAMBDA, 46 | DO, 47 | IMPORT, 48 | INFIXL, 49 | INFIXR, 50 | INFIX, 51 | DERIVING, 52 | IF, 53 | THEN, 54 | ELSE 55 | } 56 | 57 | #[derive(Clone, Copy, PartialEq, Debug)] 58 | pub struct Location { 59 | pub column : isize, 60 | pub row : isize, 61 | pub absolute : isize 62 | } 63 | 64 | impl Location { 65 | pub fn eof() -> Location { 66 | Location { column: -1, row: -1, absolute: -1 } 67 | } 68 | } 69 | #[derive(Clone, Debug)] 70 | pub struct Located { 71 | pub location: Location, 72 | pub node: T 73 | } 74 | 75 | impl PartialEq for Located { 76 | fn eq(&self, o: &Located) -> bool { 77 | self.node == o.node 78 | } 79 | } 80 | 81 | impl fmt::Display for Located { 82 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 83 | write!(f, "{}: {}", self.location, self.node) 84 | } 85 | } 86 | 87 | impl fmt::Display for Location { 88 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 89 | write!(f, "{}:{}", self.row, self.column) 90 | } 91 | } 92 | 93 | #[derive(Clone, Debug)] 94 | pub struct Token { 95 | pub token : TokenEnum, 96 | pub value : InternedStr, 97 | pub location : Location 98 | } 99 | impl Token { 100 | fn eof() -> Token { 101 | Token { token : EOF, value : intern(""), location : Location { column : -1, row : -1, absolute : -1} } 102 | } 103 | 104 | fn new(interner: &Rc>, token : TokenEnum, value : &str, loc : Location) -> Token { 105 | Token { token: token, value: (**interner).borrow_mut().intern(value), location: loc } 106 | } 107 | 108 | #[cfg(test)] 109 | fn new_(token : TokenEnum, value : &str) -> Token { 110 | Token::new(&get_local_interner(), token, value, Location { column : -1, row : -1, absolute : -1 }) 111 | } 112 | } 113 | 114 | impl PartialEq for Token { 115 | fn eq(&self, rhs : &Token) -> bool { 116 | self.token == rhs.token && self.value == rhs.value 117 | } 118 | } 119 | 120 | ///Takes a string which can be an identifier or a keyword and returns the correct TokenEnum 121 | fn name_or_keyword(tok : &str) -> TokenEnum { 122 | match tok { 123 | "module" => MODULE, 124 | "class" => CLASS, 125 | "instance" => INSTANCE, 126 | "where" => WHERE, 127 | "let" => LET, 128 | "in" => IN, 129 | "case" => CASE, 130 | "of" => OF, 131 | "->" => ARROW, 132 | "data" => DATA, 133 | "newtype" => NEWTYPE, 134 | "do" => DO, 135 | "import" => IMPORT, 136 | "infixl" => INFIXL, 137 | "infixr" => INFIXR, 138 | "infix" => INFIX, 139 | "deriving" => DERIVING, 140 | "if" => IF, 141 | "then" => THEN, 142 | "else" => ELSE, 143 | _ => NAME 144 | } 145 | } 146 | ///Returns whether the character is a haskell operator 147 | fn is_operator(first_char : char) -> bool { 148 | match first_char { 149 | '+' | '-' | '*' | '/' | '.' | '$' | 150 | ':' | '=' | '<' | '>' | '|' | '&' | '!' => true, 151 | _ => false 152 | } 153 | } 154 | 155 | pub struct Lexer> { 156 | ///The input which the lexer processes 157 | input : Peekable, 158 | ///The current location of the lexer 159 | location : Location, 160 | ///All the current unprocessed tokens stored on a stack 161 | unprocessed_tokens : Vec, 162 | ///The token buffer which contains the last n produced tokens. 163 | tokens : VecDeque, 164 | ///A stack which contains the indentation levels of automatically inserted '{' 165 | indent_levels : Vec, 166 | ///The offset into the token buffer at which the current token is at 167 | offset : usize, 168 | ///The string interner, cached here for efficency 169 | interner: Rc> 170 | } 171 | 172 | 173 | impl > Lexer { 174 | 175 | ///Constructs a new lexer with a default sized token buffer and the local string interner 176 | pub fn new(input : Stream) -> Lexer { 177 | let start = Location { column : 0, row : 0, absolute : 0}; 178 | Lexer { 179 | input : input.peekable(), 180 | location : start, 181 | unprocessed_tokens : Vec::new(), 182 | tokens : VecDeque::with_capacity(20), 183 | indent_levels : Vec::new(), 184 | offset : 0, 185 | interner: get_local_interner() 186 | } 187 | } 188 | ///Returns a new token with some special rules necessary for the parsing of the module declaration 189 | ///TODO check if this can be removed somehow 190 | pub fn module_next<'a>(&'a mut self) -> &'a Token { 191 | let mut newline = false; 192 | let n = self.next_indent_token(&mut newline); 193 | self.unprocessed_tokens.push(n); 194 | let new_token = self.unprocessed_tokens.last().unwrap().token; 195 | let loc = self.unprocessed_tokens.last().unwrap().location; 196 | 197 | if new_token != LBRACE && new_token != MODULE { 198 | self.unprocessed_tokens.push(Token::new(&self.interner, INDENTSTART, "{n}", loc)); 199 | } 200 | if newline { 201 | self.unprocessed_tokens.push(Token::new(&self.interner, INDENTLEVEL, "", loc)); 202 | } 203 | 204 | self.layout_independent_token(); 205 | self.current() 206 | } 207 | 208 | pub fn peek<'a>(&'a mut self) -> &'a Token { 209 | if self.offset == 0 { 210 | self.next(); 211 | self.backtrack(); 212 | } 213 | &self.tokens[self.tokens.len() - self.offset] 214 | } 215 | 216 | ///Returns the next token in the lexer 217 | pub fn next<'a>(&'a mut self) -> &'a Token { 218 | if self.offset > 0 { 219 | //backtrack has been used so simply return the next token from the buffer 220 | self.offset -= 1; 221 | match self.tokens.get(self.tokens.len() - 1 - self.offset) { 222 | Some(token) => token, 223 | None => panic!("Impossible empty tokens stream") 224 | } 225 | } 226 | else if self.unprocessed_tokens.len() > 0 { 227 | //Some previous call to next produced more than one token so process those first 228 | self.layout_independent_token(); 229 | self.tokens.back().unwrap() 230 | } 231 | else { 232 | self.next_token() 233 | } 234 | } 235 | 236 | ///Returns a reference to the current token 237 | pub fn current<'a>(&'a self) -> &'a Token { 238 | match self.tokens.get(self.tokens.len() - 1 - self.offset) { 239 | Some(token) => token, 240 | None => panic!("Attempted to access Lexer::current() on when tokens is empty") 241 | } 242 | } 243 | 244 | ///Moves the lexer back one token 245 | ///TODO check for overflow in the buffer 246 | pub fn backtrack(&mut self) { 247 | self.offset += 1; 248 | } 249 | 250 | ///Returns true if the lexer is still valid (it has not hit EOF) 251 | pub fn valid(&self) -> bool { 252 | self.offset > 0 || match self.tokens.back() { None => true, Some(x) => x.token != EOF } 253 | } 254 | 255 | ///Peeks at the next character in the input 256 | fn peek_char(&mut self) -> Option { 257 | self.input.peek().map(|c| *c) 258 | } 259 | 260 | ///Reads a character from the input and increments the current position 261 | fn read_char(&mut self) -> Option { 262 | match self.input.next() { 263 | Some(c) => { 264 | self.location.absolute += 1; 265 | self.location.column += 1; 266 | if c == '\n' || c == '\r' { 267 | self.location.column = 0; 268 | self.location.row += 1; 269 | //If this is a \n\r line ending skip the next char without increasing the location 270 | let x = '\n'; 271 | if c == '\r' && self.input.peek() == Some(&x) { 272 | self.input.next(); 273 | } 274 | } 275 | Some(c) 276 | } 277 | None => None 278 | } 279 | } 280 | 281 | ///Scans digits into a string 282 | fn scan_digits(&mut self) -> String { 283 | let mut result = String::new(); 284 | loop { 285 | match self.peek_char() { 286 | Some(x) => { 287 | if !x.is_digit(10) { 288 | break; 289 | } 290 | self.read_char(); 291 | result.push(x) 292 | } 293 | None => break 294 | } 295 | } 296 | result 297 | } 298 | ///Scans a number, float or isizeeger and returns the appropriate token 299 | fn scan_number(&mut self, c : char, location : Location) -> Token { 300 | let mut number = c.to_string(); 301 | number.push_str(self.scan_digits().as_ref()); 302 | let mut token = NUMBER; 303 | match self.peek_char() { 304 | Some('.') => { 305 | self.input.next(); 306 | token = FLOAT; 307 | number.push('.'); 308 | number.push_str(self.scan_digits().as_ref()); 309 | } 310 | _ => () 311 | } 312 | Token::new(&self.interner, token, number.as_ref(), location) 313 | } 314 | ///Scans an identifier or a keyword 315 | fn scan_identifier(&mut self, c: char, start_location: Location) -> Token { 316 | let mut result = c.to_string(); 317 | loop { 318 | match self.peek_char() { 319 | Some(ch) => { 320 | if !ch.is_alphanumeric() && ch != '_' { 321 | break; 322 | } 323 | self.read_char(); 324 | result.push(ch); 325 | } 326 | None => break 327 | } 328 | } 329 | return Token::new(&self.interner, name_or_keyword(result.as_ref()), result.as_ref(), start_location); 330 | } 331 | 332 | ///Returns the next token but if it is not an '}' it will attempt to insert a '}' automatically 333 | pub fn next_end<'a>(&'a mut self) -> &'a Token { 334 | //If the next token is not an '}' and the starting '{' is not explicit we insert an '}' 335 | //before the current token and set the current token to the '}' 336 | //Credits to the HUGS source code for the solution 337 | if self.next().token != RBRACE { 338 | if self.indent_levels.len() != 0 { 339 | //L (t:ts) (m:ms) = } : (L (t:ts) ms) if m /= 0 and parse-error(t) 340 | let m = *self.indent_levels.last().unwrap(); 341 | if m != 0 {//If not a explicit '}' 342 | debug!("ParseError on token {:?}, inserting }}", self.current().token); 343 | self.indent_levels.pop(); 344 | let loc = self.current().location; 345 | self.tokens.push_back(Token::new(&self.interner, RBRACE, "}", loc)); 346 | let len = self.tokens.len(); 347 | self.tokens.swap(len - 2, len - 1); 348 | self.backtrack(); 349 | } 350 | } 351 | } 352 | self.current() 353 | } 354 | 355 | ///Scans and returns the next token from the input stream, taking into account the indentation rules 356 | fn next_token<'a>(&'a mut self) -> &'a Token { 357 | let mut newline = false; 358 | let n = self.next_indent_token(&mut newline); 359 | self.unprocessed_tokens.push(n); 360 | let new_token = self.unprocessed_tokens.last().unwrap().token; 361 | 362 | if new_token != LBRACE { 363 | match self.tokens.back() { 364 | Some(tok) => { 365 | if tok.token == LET || tok.token == WHERE || tok.token == OF || tok.token == DO { 366 | let loc = self.unprocessed_tokens.last().unwrap().location; 367 | let indentstart = Token::new(&self.interner, INDENTSTART, "{n}", loc); 368 | self.unprocessed_tokens.push(indentstart); 369 | } 370 | } 371 | None => () 372 | } 373 | } 374 | if newline { 375 | let loc = self.unprocessed_tokens.last().unwrap().location; 376 | self.unprocessed_tokens.push(Token::new(&self.interner, INDENTLEVEL, "", loc)); 377 | } 378 | self.layout_independent_token(); 379 | self.tokens.back().unwrap() 380 | } 381 | 382 | ///Looks at the next unprocessed token and applies the indentation rules on it 383 | ///and returns a token which is not affected by indentation 384 | fn layout_independent_token(&mut self) { 385 | if self.unprocessed_tokens.len() > 0 { 386 | let tok = self.unprocessed_tokens.last().unwrap().clone();//TODO dont use clone 387 | match tok.token { 388 | INDENTLEVEL => { 389 | if self.indent_levels.len() > 0 { 390 | //m:ms 391 | let m = *self.indent_levels.last().unwrap(); 392 | //m == n 393 | if m == tok.location.column { 394 | debug!("Indents are same, inserted semicolon"); 395 | self.tokens.push_back(Token::new(&self.interner, SEMICOLON, ";", tok.location)); 396 | self.unprocessed_tokens.pop(); 397 | return; 398 | } 399 | else if tok.location.column < m { 400 | //n < m 401 | //TODO 402 | debug!("n < m, insert }}"); 403 | self.indent_levels.pop(); 404 | self.tokens.push_back(Token::new(&self.interner, RBRACE, "}", tok.location)); 405 | return; 406 | } 407 | } 408 | self.unprocessed_tokens.pop(); 409 | if self.unprocessed_tokens.len() == 0 { 410 | self.next_token(); 411 | return; 412 | } 413 | else { 414 | return self.layout_independent_token(); 415 | } 416 | } 417 | INDENTSTART => { 418 | //{n} token 419 | let n = tok.location.column; 420 | if self.indent_levels.len() != 0 { 421 | //m:ms 422 | let m = *self.indent_levels.last().unwrap(); 423 | if n > m { 424 | debug!("n > m + INDENTSTART, insert {{"); 425 | self.unprocessed_tokens.pop(); 426 | self.tokens.push_back(Token::new(&self.interner, LBRACE, "{", tok.location)); 427 | self.indent_levels.push(n); 428 | return; 429 | } 430 | } 431 | if n > 0 { 432 | self.tokens.push_back(Token::new(&self.interner, LBRACE, "{", tok.location)); 433 | self.unprocessed_tokens.pop(); 434 | self.indent_levels.push(n); 435 | return; 436 | } 437 | self.tokens.push_back(Token::new(&self.interner, LBRACE, "{", tok.location)); 438 | self.tokens.push_back(Token::new(&self.interner, RBRACE, "}", tok.location)); 439 | self.unprocessed_tokens.pop(); 440 | self.unprocessed_tokens.push(Token::new(&self.interner, INDENTLEVEL, "", tok.location)); 441 | self.offset += 1; 442 | return; 443 | } 444 | RBRACE => { 445 | if self.indent_levels.len() > 0 && *self.indent_levels.last().unwrap() == 0 { 446 | self.tokens.push_back(self.unprocessed_tokens.pop().unwrap()); 447 | self.indent_levels.pop(); 448 | return; 449 | } 450 | else { 451 | return;//parse-error 452 | } 453 | } 454 | LBRACE => { 455 | self.tokens.push_back(self.unprocessed_tokens.pop().unwrap()); 456 | self.indent_levels.push(0); 457 | return; 458 | } 459 | 460 | _ => () 461 | } 462 | self.tokens.push_back(self.unprocessed_tokens.pop().unwrap()); 463 | return; 464 | } 465 | else { 466 | if self.indent_levels.len() == 0 { 467 | //End of stream 468 | return; 469 | } 470 | else if *self.indent_levels.last().unwrap() != 0 { 471 | //Keep pusing right brackets 472 | self.indent_levels.pop(); 473 | self.tokens.push_back(Token::new(&self.interner, RBRACE, "}", self.location)); 474 | return; 475 | } 476 | } 477 | } 478 | 479 | ///Scans the character stream for the next token 480 | ///Return EOF token if the token stream has ehas ended 481 | fn next_indent_token(&mut self, newline : &mut bool) -> Token { 482 | let mut c = ' '; 483 | //Skip all whitespace before the token 484 | while c.is_whitespace() { 485 | match self.read_char() { 486 | Some(x) => { 487 | c = x; 488 | if self.location.column == 0 {//newline detected 489 | *newline = true; 490 | } 491 | } 492 | None => { return Token::eof() } 493 | } 494 | } 495 | let start_location = self.location; 496 | 497 | //Decide how to tokenize depending on what the first char is 498 | //ie if its an operator then more operators will follow 499 | if is_operator(c) { 500 | let mut result = c.to_string(); 501 | loop { 502 | match self.peek_char() { 503 | Some(ch) => { 504 | if !is_operator(ch) { 505 | break; 506 | } 507 | self.read_char(); 508 | result.push(ch); 509 | } 510 | None => { break; } 511 | } 512 | } 513 | let tok = match result.as_ref() { 514 | "=" => EQUALSSIGN, 515 | "->" => ARROW, 516 | "<-" => LARROW, 517 | "::" => TYPEDECL, 518 | "=>" => CONTEXTARROW, 519 | "|" => PIPE, 520 | _ => OPERATOR 521 | }; 522 | return Token::new(&self.interner, tok, result.as_ref(), start_location); 523 | } 524 | else if c.is_digit(10) { 525 | return self.scan_number(c, start_location); 526 | } 527 | else if c.is_alphabetic() || c == '_' { 528 | return self.scan_identifier(c, start_location); 529 | } 530 | else if c == '`' { 531 | let x = self.read_char().expect("Unexpected end of input"); 532 | if !x.is_alphabetic() && x != '_' { 533 | panic!("Parse error on '{:?}'", x); 534 | } 535 | let mut token = self.scan_identifier(x, start_location); 536 | let end_tick = self.read_char(); 537 | match end_tick { 538 | Some('`') => (), 539 | Some(x) => panic!("Parse error on '{:?}'", x), 540 | None => panic!("Unexpected end of input") 541 | } 542 | token.token = OPERATOR; 543 | return token; 544 | } 545 | else if c == '"' { 546 | let mut string = String::new(); 547 | loop { 548 | match self.read_char() { 549 | Some('"') => return Token::new(&self.interner, STRING, string.as_ref(), start_location), 550 | Some(x) => string.push(x), 551 | None => panic!("Unexpected EOF") 552 | } 553 | } 554 | } 555 | else if c == '\'' { 556 | match self.read_char() { 557 | Some(x) => { 558 | if self.read_char() == Some('\'') { 559 | //FIXME: Slow 560 | return Token::new(&self.interner, CHAR, &*x.to_string(), start_location); 561 | } 562 | else { 563 | panic!("Multi char character") 564 | } 565 | } 566 | None => panic!("Unexpected EOF") 567 | } 568 | } 569 | let tok = match c { 570 | ';' => SEMICOLON, 571 | '(' => LPARENS, 572 | ')' => RPARENS, 573 | '[' => LBRACKET, 574 | ']' => RBRACKET, 575 | '{' => LBRACE, 576 | '}' => RBRACE, 577 | ',' => COMMA, 578 | '\\'=> LAMBDA, 579 | _ => EOF 580 | }; 581 | //FIXME: Slow 582 | Token::new(&self.interner, tok, c.to_string().as_ref(), start_location) 583 | } 584 | } 585 | 586 | #[cfg(test)] 587 | mod tests { 588 | 589 | use crate::lexer::*; 590 | 591 | #[test] 592 | fn simple() { 593 | let mut lexer = Lexer::new("test 2 + 3".chars()); 594 | 595 | assert_eq!(*lexer.next(), Token::new_(NAME, "test")); 596 | assert_eq!(*lexer.next(), Token::new_(NUMBER, "2")); 597 | assert_eq!(*lexer.next(), Token::new_(OPERATOR, "+")); 598 | assert_eq!(*lexer.next(), Token::new_(NUMBER, "3")); 599 | } 600 | #[test] 601 | fn let_bind() { 602 | let mut lexer = Lexer::new( 603 | r"let 604 | test = 2 + 3 605 | in test".chars()); 606 | 607 | assert_eq!(*lexer.next(), Token::new_(LET, "let")); 608 | assert_eq!(*lexer.next(), Token::new_(LBRACE, "{")); 609 | assert_eq!(*lexer.next(), Token::new_(NAME, "test")); 610 | assert_eq!(*lexer.next(), Token::new_(EQUALSSIGN, "=")); 611 | assert_eq!(*lexer.next(), Token::new_(NUMBER, "2")); 612 | assert_eq!(*lexer.next(), Token::new_(OPERATOR, "+")); 613 | assert_eq!(*lexer.next(), Token::new_(NUMBER, "3")); 614 | } 615 | 616 | } 617 | -------------------------------------------------------------------------------- /src/main.rs: -------------------------------------------------------------------------------- 1 | #![crate_type = "bin"] 2 | #![cfg_attr(test, feature(test))] 3 | #[macro_use] 4 | extern crate log; 5 | extern crate getopts; 6 | #[cfg(test)] 7 | extern crate test; 8 | 9 | #[cfg(not(test))] 10 | use vm::execute_main_module; 11 | #[cfg(not(test))] 12 | use getopts::Options; 13 | 14 | macro_rules! write_core_expr( 15 | ($e:expr, $f:expr, $($p:pat),*) => ({ 16 | match $e { 17 | Identifier(ref s) => write!($f, "{}", *s), 18 | Apply(ref func, ref arg) => write!($f, "({} {})", func, *arg), 19 | Literal(ref l) => write!($f, "{}", *l), 20 | Lambda(ref arg, ref body) => write!($f, "({} -> {})", *arg, *body), 21 | Let(ref bindings, ref body) => { 22 | write!($f, "let {{\n")?; 23 | for bind in bindings.iter() { 24 | write!($f, "; {}\n", bind)?; 25 | } 26 | write!($f, "}} in {}\n", *body) 27 | } 28 | Case(ref expr, ref alts) => { 29 | write!($f, "case {} of {{\n", *expr)?; 30 | for alt in alts.iter() { 31 | write!($f, "; {}\n", alt)?; 32 | } 33 | write!($f, "}}\n") 34 | } 35 | $($p => Ok(()))* 36 | } 37 | }) 38 | ); 39 | 40 | mod types; 41 | mod module; 42 | mod compiler; 43 | mod typecheck; 44 | mod lexer; 45 | mod parser; 46 | mod graph; 47 | mod vm; 48 | mod scoped_map; 49 | mod core; 50 | mod lambda_lift; 51 | mod renamer; 52 | mod infix; 53 | mod builtins; 54 | mod interner; 55 | mod deriving; 56 | #[cfg(not(test))] 57 | mod repl; 58 | 59 | #[cfg(not(test))] 60 | fn main() { 61 | let mut opts = Options::new(); 62 | opts.optflag("i", "interactive", "Starts the REPL"); 63 | opts.optflag("h", "help", "Print help"); 64 | 65 | let matches = { 66 | let args: Vec<_> = std::env::args().skip(1).collect(); 67 | opts.parse(args).unwrap() 68 | }; 69 | 70 | if matches.opt_present("h") { 71 | println!("Usage: vm [OPTIONS|EXPRESSION] {}", opts.usage("")); 72 | return; 73 | } 74 | 75 | if matches.opt_present("i") { 76 | repl::start(); 77 | return; 78 | } 79 | 80 | if matches.free.len() < 1 { 81 | println!("Usage: vm [OPTIONS|EXPRESSION] {}", opts.usage("")); 82 | return; 83 | } 84 | 85 | let modulename = &*matches.free[0]; 86 | match execute_main_module(modulename.as_ref()).unwrap() { 87 | Some(x) => println!("{:?}", x), 88 | None => println!("Error running module {}", modulename) 89 | } 90 | } 91 | 92 | -------------------------------------------------------------------------------- /src/module.rs: -------------------------------------------------------------------------------- 1 | use std::fmt; 2 | use std::collections::HashMap; 3 | use crate::interner::{intern, InternedStr}; 4 | use crate::lexer::{Location, Located}; 5 | pub use std::default::Default; 6 | pub use crate::types::*; 7 | 8 | use self::Expr::*; 9 | 10 | #[derive(Clone, Debug)] 11 | pub struct Module { 12 | pub name : Ident, 13 | pub imports: Vec>, 14 | pub bindings : Vec>, 15 | pub type_declarations : Vec>, 16 | pub classes : Vec>, 17 | pub instances : Vec>, 18 | pub data_definitions : Vec>, 19 | pub newtypes : Vec>, 20 | pub fixity_declarations : Vec> 21 | } 22 | 23 | #[derive(Clone, Debug)] 24 | pub struct Import { 25 | pub module: InternedStr, 26 | //None if 'import Name' 27 | //Some(names) if 'import Name (names)' 28 | pub imports: Option> 29 | } 30 | 31 | #[derive(Clone, Debug)] 32 | pub struct Class { 33 | pub constraints: Vec>, 34 | pub name : Ident, 35 | pub variable : TypeVariable, 36 | pub declarations : Vec>, 37 | pub bindings: Vec> 38 | } 39 | 40 | #[derive(Clone, Debug)] 41 | pub struct Instance { 42 | pub bindings : Vec>, 43 | pub constraints : Vec>, 44 | pub typ : Type, 45 | pub classname : Ident 46 | } 47 | 48 | #[derive(Clone, Debug, PartialEq)] 49 | pub struct Binding { 50 | pub name : Ident, 51 | pub arguments: Vec>, 52 | pub matches: Match, 53 | pub where_bindings : Option>>, 54 | pub typ: Qualified, Ident> 55 | } 56 | 57 | #[derive(PartialEq, Eq, Clone, Debug)] 58 | pub struct Constructor { 59 | pub name : Ident, 60 | pub typ : Qualified, Ident>, 61 | pub tag : isize, 62 | pub arity : isize 63 | } 64 | 65 | #[derive(PartialEq, Clone, Debug)] 66 | pub struct DataDefinition { 67 | pub constructors : Vec>, 68 | pub typ : Qualified, Ident>, 69 | pub parameters : HashMap, 70 | pub deriving: Vec 71 | } 72 | 73 | #[derive(PartialEq, Clone, Debug)] 74 | pub struct Newtype { 75 | pub typ: Qualified, 76 | pub constructor_name: Ident, 77 | pub constructor_type: Qualified, Ident>, 78 | pub deriving: Vec 79 | } 80 | 81 | #[derive(PartialEq, Clone, Copy, Debug)] 82 | pub enum Assoc { 83 | Left, 84 | Right, 85 | No 86 | } 87 | 88 | #[derive(PartialEq, Clone, Debug)] 89 | pub struct FixityDeclaration { 90 | pub assoc: Assoc, 91 | pub precedence: isize, 92 | pub operators: Vec 93 | } 94 | 95 | #[derive(Clone, Debug, PartialEq, Eq, Default)] 96 | pub struct TypeDeclaration { 97 | pub typ : Qualified, Ident>, 98 | pub name : Ident 99 | } 100 | impl > fmt::Display for TypeDeclaration { 101 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 102 | write!(f, "{} :: {}", self.name, self.typ) 103 | } 104 | } 105 | 106 | 107 | #[derive(Clone, Debug)] 108 | pub struct TypedExpr { 109 | pub expr : Expr, 110 | pub typ : Type, 111 | pub location : Location 112 | } 113 | 114 | impl PartialEq for TypedExpr { 115 | fn eq(&self, other : &TypedExpr) -> bool { 116 | self.expr == other.expr 117 | } 118 | } 119 | 120 | impl > fmt::Display for TypedExpr { 121 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 122 | write!(f, "{} :: {}", self.expr, self.typ) 123 | } 124 | } 125 | 126 | impl TypedExpr { 127 | pub fn new>(expr : Expr) -> TypedExpr { 128 | TypedExpr { expr : expr, typ : Type::new_var(intern("a")), location : Location { column : -1, row : -1, absolute : -1 } } 129 | } 130 | pub fn with_location>(expr : Expr, loc : Location) -> TypedExpr { 131 | TypedExpr { expr : expr, typ : Type::new_var(intern("a")), location : loc } 132 | } 133 | } 134 | 135 | #[derive(Clone, Debug, PartialEq)] 136 | pub struct Alternative { 137 | pub pattern : Located>, 138 | pub matches: Match, 139 | pub where_bindings : Option>> 140 | } 141 | 142 | #[derive(Clone, Debug, PartialOrd, PartialEq, Eq)] 143 | pub enum Pattern { 144 | Number(isize), 145 | Identifier(Ident), 146 | Constructor(Ident, Vec>), 147 | WildCard 148 | } 149 | 150 | #[derive(Clone, Debug, PartialEq)] 151 | pub enum Match { 152 | Guards(Vec>), 153 | Simple(TypedExpr) 154 | } 155 | impl Match { 156 | pub fn location<'a>(&'a self) -> &'a Location { 157 | match *self { 158 | Match::Guards(ref gs) => &gs[0].predicate.location, 159 | Match::Simple(ref e) => &e.location 160 | } 161 | } 162 | } 163 | 164 | #[derive(Clone, Debug, PartialEq)] 165 | pub struct Guard { 166 | pub predicate: TypedExpr, 167 | pub expression: TypedExpr 168 | } 169 | 170 | #[derive(Clone, Debug, PartialEq)] 171 | pub enum DoBinding { 172 | DoLet(Vec>), 173 | DoBind(Located>, TypedExpr), 174 | DoExpr(TypedExpr) 175 | } 176 | 177 | #[derive(Clone, Debug, PartialEq)] 178 | pub enum LiteralData { 179 | Integral(isize), 180 | Fractional(f64), 181 | String(InternedStr), 182 | Char(char) 183 | } 184 | #[derive(Clone, Debug, PartialEq)] 185 | pub enum Expr { 186 | Identifier(Ident), 187 | Apply(Box>, Box>), 188 | OpApply(Box>, Ident, Box>), 189 | Literal(LiteralData), 190 | Lambda(Pattern, Box>), 191 | Let(Vec>, Box>), 192 | Case(Box>, Vec>), 193 | IfElse(Box>, Box>, Box>), 194 | Do(Vec>, Box>), 195 | TypeSig(Box>, Qualified, Ident>), 196 | Paren(Box>) 197 | } 198 | impl > fmt::Display for Binding { 199 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 200 | write!(f, "{} = {}", self.name, self.matches) 201 | } 202 | } 203 | 204 | impl > fmt::Display for Expr { 205 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 206 | write_core_expr!(*self, f, _)?; 207 | match *self { 208 | Do(ref bindings, ref expr) => { 209 | write!(f, "do {{\n")?; 210 | for bind in bindings.iter() { 211 | match *bind { 212 | DoBinding::DoLet(ref bindings) => { 213 | write!(f, "let {{\n")?; 214 | for bind in bindings.iter() { 215 | write!(f, "; {} = {}\n", bind.name, bind.matches)?; 216 | } 217 | write!(f, "}}\n")?; 218 | } 219 | DoBinding::DoBind(ref p, ref e) => write!(f, "; {} <- {}\n", p.node, *e)?, 220 | DoBinding::DoExpr(ref e) => write!(f, "; {}\n", *e)? 221 | } 222 | } 223 | write!(f, "{} }}", *expr) 224 | } 225 | OpApply(ref lhs, ref op, ref rhs) => write!(f, "({} {} {})", lhs, op, rhs), 226 | TypeSig(ref expr, ref typ) => write!(f, "{} {}", expr, typ), 227 | Paren(ref expr) => write!(f, "({})", expr), 228 | _ => Ok(()) 229 | } 230 | } 231 | } 232 | impl > fmt::Display for Pattern { 233 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 234 | match self { 235 | &Pattern::Identifier(ref s) => write!(f, "{}", s), 236 | &Pattern::Number(ref i) => write!(f, "{}", i), 237 | &Pattern::Constructor(ref name, ref patterns) => { 238 | write!(f, "({} ", name)?; 239 | for p in patterns.iter() { 240 | write!(f, " {}", p)?; 241 | } 242 | write!(f, ")") 243 | } 244 | &Pattern::WildCard => write!(f, "_") 245 | } 246 | } 247 | } 248 | 249 | impl > fmt::Display for Alternative { 250 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 251 | write!(f, "{} -> {}", self.pattern.node, self.matches) 252 | } 253 | } 254 | impl > fmt::Display for Match { 255 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 256 | match *self { 257 | Match::Simple(ref e) => write!(f, "{}", *e), 258 | Match::Guards(ref gs) => { 259 | for g in gs.iter() { 260 | write!(f, "| {} -> {}\n", g.predicate, g.expression)?; 261 | } 262 | Ok(()) 263 | } 264 | } 265 | } 266 | } 267 | impl fmt::Display for LiteralData { 268 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 269 | match *self { 270 | LiteralData::Integral(i) => write!(f, "{}", i), 271 | LiteralData::Fractional(v) => write!(f, "{}", v), 272 | LiteralData::String(ref s) => write!(f, "\"{}\"", *s), 273 | LiteralData::Char(c) => write!(f, "'{}'", c) 274 | } 275 | } 276 | } 277 | 278 | ///Trait which implements the visitor pattern. 279 | ///The tree will be walked through automatically, calling the appropriate visit_ function 280 | ///If a visit_ function is overridden it will need to call the appropriate walk_function to 281 | ///recurse deeper into the AST 282 | pub trait Visitor : Sized { 283 | fn visit_expr(&mut self, expr: &TypedExpr) { 284 | walk_expr(self, expr) 285 | } 286 | fn visit_alternative(&mut self, alt: &Alternative) { 287 | walk_alternative(self, alt) 288 | } 289 | fn visit_pattern(&mut self, pattern: &Pattern) { 290 | walk_pattern(self, pattern) 291 | } 292 | fn visit_binding(&mut self, binding: &Binding) { 293 | walk_binding(self, binding); 294 | } 295 | fn visit_module(&mut self, module: &Module) { 296 | walk_module(self, module); 297 | } 298 | } 299 | 300 | pub fn walk_module>(visitor: &mut V, module: &Module) { 301 | for bind in module.instances.iter().flat_map(|i| i.bindings.iter()) { 302 | visitor.visit_binding(bind); 303 | } 304 | for bind in module.bindings.iter() { 305 | visitor.visit_binding(bind); 306 | } 307 | } 308 | 309 | pub fn walk_binding>(visitor: &mut V, binding: &Binding) { 310 | match binding.matches { 311 | Match::Simple(ref e) => visitor.visit_expr(e), 312 | _ => panic!() 313 | } 314 | } 315 | 316 | pub fn walk_expr>(visitor: &mut V, expr: &TypedExpr) { 317 | match &expr.expr { 318 | &Apply(ref func, ref arg) => { 319 | visitor.visit_expr(&**func); 320 | visitor.visit_expr(&**arg); 321 | } 322 | &OpApply(ref lhs, _, ref rhs) => { 323 | visitor.visit_expr(&**lhs); 324 | visitor.visit_expr(&**rhs); 325 | } 326 | &Lambda(_, ref body) => visitor.visit_expr(&**body), 327 | &Let(ref binds, ref e) => { 328 | for b in binds.iter() { 329 | visitor.visit_binding(b); 330 | } 331 | visitor.visit_expr(&**e); 332 | } 333 | &Case(ref e, ref alts) => { 334 | visitor.visit_expr(&**e); 335 | for alt in alts.iter() { 336 | visitor.visit_alternative(alt); 337 | } 338 | } 339 | &IfElse(ref pred, ref if_true, ref if_false) => { 340 | visitor.visit_expr(&**pred); 341 | visitor.visit_expr(&**if_true); 342 | visitor.visit_expr(&**if_false); 343 | } 344 | &Do(ref binds, ref expr) => { 345 | for bind in binds.iter() { 346 | match *bind { 347 | DoBinding::DoLet(ref bs) => { 348 | for b in bs.iter() { 349 | visitor.visit_binding(b); 350 | } 351 | } 352 | DoBinding::DoBind(ref pattern, ref e) => { 353 | visitor.visit_pattern(&pattern.node); 354 | visitor.visit_expr(e); 355 | } 356 | DoBinding::DoExpr(ref e) => visitor.visit_expr(e) 357 | } 358 | } 359 | visitor.visit_expr(&**expr); 360 | } 361 | &TypeSig(ref expr, _) => visitor.visit_expr(&**expr), 362 | &Paren(ref expr) => visitor.visit_expr(&**expr), 363 | &Literal(..) | &Identifier(..) => () 364 | } 365 | } 366 | 367 | pub fn walk_alternative>(visitor: &mut V, alt: &Alternative) { 368 | visitor.visit_pattern(&alt.pattern.node); 369 | match alt.matches { 370 | Match::Simple(ref e) => visitor.visit_expr(e), 371 | Match::Guards(ref gs) => { 372 | for g in gs.iter() { 373 | visitor.visit_expr(&g.predicate); 374 | visitor.visit_expr(&g.expression); 375 | } 376 | } 377 | } 378 | match alt.where_bindings { 379 | Some(ref bindings) => { 380 | for bind in bindings.iter() { 381 | visitor.visit_binding(bind); 382 | } 383 | } 384 | None => () 385 | } 386 | } 387 | 388 | pub fn walk_pattern>(visitor: &mut V, pattern: &Pattern) { 389 | match pattern { 390 | &Pattern::Constructor(_, ref ps) => { 391 | for p in ps.iter() { 392 | visitor.visit_pattern(p); 393 | } 394 | } 395 | _ => () 396 | } 397 | } 398 | 399 | 400 | 401 | pub trait MutVisitor : Sized { 402 | fn visit_expr(&mut self, expr: &mut TypedExpr) { 403 | walk_expr_mut(self, expr) 404 | } 405 | fn visit_alternative(&mut self, alt: &mut Alternative) { 406 | walk_alternative_mut(self, alt) 407 | } 408 | fn visit_pattern(&mut self, pattern: &mut Pattern) { 409 | walk_pattern_mut(self, pattern) 410 | } 411 | fn visit_binding(&mut self, binding: &mut Binding) { 412 | walk_binding_mut(self, binding); 413 | } 414 | fn visit_module(&mut self, module: &mut Module) { 415 | walk_module_mut(self, module); 416 | } 417 | } 418 | 419 | pub fn walk_module_mut>(visitor: &mut V, module: &mut Module) { 420 | for bind in module.instances.iter_mut().flat_map(|i| i.bindings.iter_mut()) { 421 | visitor.visit_binding(bind); 422 | } 423 | for bind in module.bindings.iter_mut() { 424 | visitor.visit_binding(bind); 425 | } 426 | } 427 | 428 | pub fn walk_binding_mut>(visitor: &mut V, binding: &mut Binding) { 429 | match binding.matches { 430 | Match::Simple(ref mut e) => visitor.visit_expr(e), 431 | Match::Guards(ref mut gs) => { 432 | for g in gs.iter_mut() { 433 | visitor.visit_expr(&mut g.predicate); 434 | visitor.visit_expr(&mut g.expression); 435 | } 436 | } 437 | } 438 | } 439 | 440 | pub fn walk_expr_mut>(visitor: &mut V, expr: &mut TypedExpr) { 441 | match expr.expr { 442 | Apply(ref mut func, ref mut arg) => { 443 | visitor.visit_expr(&mut **func); 444 | visitor.visit_expr(&mut **arg); 445 | } 446 | OpApply(ref mut lhs, _, ref mut rhs) => { 447 | visitor.visit_expr(&mut **lhs); 448 | visitor.visit_expr(&mut **rhs); 449 | } 450 | Lambda(_, ref mut body) => visitor.visit_expr(&mut **body), 451 | Let(ref mut binds, ref mut e) => { 452 | for b in binds.iter_mut() { 453 | visitor.visit_binding(b); 454 | } 455 | visitor.visit_expr(&mut **e); 456 | } 457 | Case(ref mut e, ref mut alts) => { 458 | visitor.visit_expr(&mut **e); 459 | for alt in alts.iter_mut() { 460 | visitor.visit_alternative(alt); 461 | } 462 | } 463 | IfElse(ref mut pred, ref mut if_true, ref mut if_false) => { 464 | visitor.visit_expr(&mut **pred); 465 | visitor.visit_expr(&mut **if_true); 466 | visitor.visit_expr(&mut **if_false); 467 | } 468 | Do(ref mut binds, ref mut expr) => { 469 | for bind in binds.iter_mut() { 470 | match *bind { 471 | DoBinding::DoLet(ref mut bs) => { 472 | for b in bs.iter_mut() { 473 | visitor.visit_binding(b); 474 | } 475 | } 476 | DoBinding::DoBind(ref mut pattern, ref mut e) => { 477 | visitor.visit_pattern(&mut pattern.node); 478 | visitor.visit_expr(e); 479 | } 480 | DoBinding::DoExpr(ref mut e) => visitor.visit_expr(e) 481 | } 482 | } 483 | visitor.visit_expr(&mut **expr); 484 | } 485 | TypeSig(ref mut expr, _) => visitor.visit_expr(&mut **expr), 486 | Paren(ref mut expr) => visitor.visit_expr(&mut **expr), 487 | Literal(..) | Identifier(..) => () 488 | } 489 | } 490 | 491 | pub fn walk_alternative_mut>(visitor: &mut V, alt: &mut Alternative) { 492 | visitor.visit_pattern(&mut alt.pattern.node); 493 | match alt.matches { 494 | Match::Simple(ref mut e) => visitor.visit_expr(e), 495 | Match::Guards(ref mut gs) => { 496 | for g in gs.iter_mut() { 497 | visitor.visit_expr(&mut g.predicate); 498 | visitor.visit_expr(&mut g.expression); 499 | } 500 | } 501 | } 502 | match alt.where_bindings { 503 | Some(ref mut bindings) => { 504 | for bind in bindings.iter_mut() { 505 | visitor.visit_binding(bind); 506 | } 507 | } 508 | None => () 509 | } 510 | } 511 | 512 | pub fn walk_pattern_mut>(visitor: &mut V, pattern: &mut Pattern) { 513 | match *pattern { 514 | Pattern::Constructor(_, ref mut ps) => { 515 | for p in ps.iter_mut() { 516 | visitor.visit_pattern(p); 517 | } 518 | } 519 | _ => () 520 | } 521 | } 522 | 523 | pub struct Binds<'a, Ident: 'a> { 524 | vec: &'a [Binding] 525 | } 526 | 527 | 528 | impl <'a, Ident: Eq> Iterator for Binds<'a, Ident> { 529 | type Item = &'a [Binding]; 530 | fn next(&mut self) -> Option<&'a [Binding]> { 531 | if self.vec.len() == 0 { 532 | None 533 | } 534 | else { 535 | let end = self.vec.iter() 536 | .position(|bind| bind.name != self.vec[0].name) 537 | .unwrap_or(self.vec.len()); 538 | let head = &self.vec[..end]; 539 | self.vec = &self.vec[end..]; 540 | Some(head) 541 | } 542 | } 543 | } 544 | 545 | ///Returns an iterator which returns slices which contain bindings which are next 546 | ///to eachother and have the same name. 547 | ///Ex 548 | ///not True = False 549 | ///not False = True 550 | ///undefined = ... 551 | ///Produces [[not True, not False], [undefined]] 552 | pub fn binding_groups<'a, Ident: Eq>(bindings: &'a [Binding]) -> Binds<'a, Ident> { 553 | Binds { vec: bindings } 554 | } 555 | 556 | ///Since bindings in instances have the same name as any other instance for the same class we 557 | ///Give it a new name which is '# Type name' (no spaces) 558 | pub fn encode_binding_identifier(instancename : InternedStr, bindingname : InternedStr) -> InternedStr { 559 | let mut buffer = String::new(); 560 | buffer.push_str("#"); 561 | buffer.push_str(&instancename); 562 | buffer.push_str(&bindingname); 563 | intern(buffer.as_ref()) 564 | } 565 | 566 | -------------------------------------------------------------------------------- /src/renamer.rs: -------------------------------------------------------------------------------- 1 | use std::fmt; 2 | use std::error; 3 | use crate::module::*; 4 | use crate::lexer::Located; 5 | use crate::scoped_map::ScopedMap; 6 | use crate::interner::*; 7 | 8 | ///A Name is a reference to a specific identifier in the program, guaranteed to be unique 9 | #[derive(Eq, Hash, Clone, Copy, Debug)] 10 | pub struct Name { 11 | pub name: InternedStr, 12 | pub uid: usize 13 | } 14 | 15 | pub fn name(s: &str) -> Name { 16 | Name { uid: 0, name: intern(s) } 17 | } 18 | 19 | impl PartialEq for Name { 20 | fn eq(&self, other: &Name) -> bool { 21 | self.uid == other.uid && self.name == other.name 22 | } 23 | } 24 | impl PartialEq for Name { 25 | fn eq(&self, other: &InternedStr) -> bool { 26 | self.name == *other 27 | } 28 | } 29 | impl PartialEq for InternedStr { 30 | fn eq(&self, other: &Name) -> bool { 31 | *self == other.name 32 | } 33 | } 34 | 35 | 36 | impl AsRef for Name { 37 | fn as_ref(&self) -> &str { 38 | self.name.as_ref() 39 | } 40 | } 41 | 42 | impl ::std::fmt::Display for Name { 43 | fn fmt(&self, f: &mut ::std::fmt::Formatter) -> ::std::fmt::Result { 44 | write!(f, "{}_{}", self.name, self.uid) 45 | } 46 | } 47 | 48 | ///Generic struct which can store and report errors 49 | #[derive(Debug)] 50 | pub struct Errors { 51 | errors: Vec 52 | } 53 | impl Errors { 54 | pub fn new() -> Errors { 55 | Errors { errors: Vec::new() } 56 | } 57 | pub fn insert(&mut self, e: T) { 58 | self.errors.push(e); 59 | } 60 | pub fn has_errors(&self) -> bool { 61 | self.errors.len() != 0 62 | } 63 | 64 | pub fn into_result(&mut self, value: V) -> Result> { 65 | if self.has_errors() { 66 | Err(::std::mem::replace(self, Errors::new())) 67 | } 68 | else { 69 | Ok(value) 70 | } 71 | } 72 | } 73 | impl Errors { 74 | pub fn report_errors(&self, f: &mut fmt::Formatter, pass: &str) -> fmt::Result { 75 | write!(f, "Found {} errors in compiler pass: {}", self.errors.len(), pass)?; 76 | for error in self.errors.iter() { 77 | write!(f, "{}", error)?; 78 | } 79 | Ok(()) 80 | } 81 | } 82 | 83 | #[derive(Debug)] 84 | pub struct RenamerError(Errors); 85 | 86 | impl fmt::Display for RenamerError { 87 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 88 | self.0.report_errors(f, "renamer") 89 | } 90 | } 91 | 92 | impl error::Error for RenamerError { 93 | fn description(&self) -> &str { "renaming error" } 94 | } 95 | 96 | #[derive(Debug)] 97 | enum Error { 98 | MultipleDefinitions(InternedStr), 99 | UndefinedModule(InternedStr), 100 | } 101 | 102 | impl fmt::Display for Error { 103 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 104 | match *self { 105 | Error::MultipleDefinitions(s) => write!(f, "{} is defined multiple times", s), 106 | Error::UndefinedModule(s) => write!(f, "Module {} is not defined", s) 107 | } 108 | } 109 | } 110 | 111 | ///A NameSupply can turn simple strings into unique Names 112 | pub struct NameSupply { 113 | unique_id: usize 114 | } 115 | impl NameSupply { 116 | 117 | pub fn new() -> NameSupply { 118 | NameSupply { unique_id: 1 } 119 | } 120 | ///Create a unique Name which are anonymous 121 | pub fn anonymous(&mut self) -> Name { 122 | self.from_str("_a") 123 | } 124 | ///Takes a string and returns a new Name which is unique 125 | pub fn from_str(&mut self, s: &str) -> Name { 126 | self.from_interned(intern(s)) 127 | } 128 | ///Takes a string and returns a new Name which is unique 129 | pub fn from_interned(&mut self, s: InternedStr) -> Name { 130 | Name { name: s, uid: self.next_id() } 131 | } 132 | pub fn next_id(&mut self) -> usize { 133 | self.unique_id += 1; 134 | self.unique_id 135 | } 136 | } 137 | 138 | ///The renamer has methods which turns the ASTs identifiers from simple strings 139 | ///into unique Names 140 | ///Currently there is some constraints on what the unique ids should be. 141 | ///Each module gets one uid which it uses for a top level declarations (bindings, types, etc) 142 | ///All functions which are in a class or an instance gets the same id as the class has, 143 | ///this is to allow the compiler to find the specific instance/class functions when it constructs dictionaries 144 | ///All uid's of the other names can have any uid (as long as it isizeroduces no name collisions) 145 | struct Renamer { 146 | ///Mapping of strings into the unique name 147 | uniques: ScopedMap, 148 | name_supply: NameSupply, 149 | ///All errors found while renaming are stored here 150 | errors: Errors 151 | } 152 | 153 | 154 | impl Renamer { 155 | fn new() -> Renamer { 156 | Renamer { uniques: ScopedMap::new(), name_supply: NameSupply::new(), errors: Errors::new() } 157 | } 158 | 159 | fn import_globals(&mut self, module: &Module, str_fn: &mut dyn FnMut(T) -> InternedStr, uid: usize) { 160 | let names = module.data_definitions.iter() 161 | .flat_map(|data| data.constructors.iter().map(|ctor| ctor.name)) 162 | .chain(module.newtypes.iter().map(|newtype| newtype.constructor_name)) 163 | .chain(module.classes.iter().flat_map(|class| 164 | Some(class.name).into_iter() 165 | .chain(class.declarations.iter().map(|decl| decl.name)) 166 | .chain(binding_groups(&*class.bindings).map(|binds| binds[0].name)))) 167 | .chain(binding_groups(module.bindings.as_ref()).map(|binds| binds[0].name)); 168 | for name in names { 169 | self.declare_global(str_fn(name), uid); 170 | } 171 | for instance in module.instances.iter() { 172 | let class_uid = self.get_name(str_fn(instance.classname)).uid; 173 | for binds in binding_groups(instance.bindings.as_ref()) { 174 | self.declare_global(str_fn(binds[0].name), class_uid); 175 | } 176 | } 177 | } 178 | 179 | ///Puts the globals of `module_env` into the current scope of the renamer. 180 | ///This includes putting all globals from the imports and the the globals of the module itself 181 | ///into scope 182 | fn insert_globals(&mut self, module_env: &[Module], module: &Module, uid: usize) { 183 | self.import_globals(module, &mut |name| name, uid); 184 | for import in module.imports.iter() { 185 | let imported_module = module_env.iter() 186 | .find(|m| m.name.name == import.module); 187 | let imported_module = match imported_module { 188 | Some(x) => x, 189 | None => { 190 | self.errors.insert(Error::UndefinedModule(import.module)); 191 | continue; 192 | } 193 | }; 194 | let uid = imported_module.name.uid; 195 | match import.imports { 196 | Some(ref imports) => { 197 | for &imported_str in imports.iter() { 198 | self.declare_global(imported_str, uid); 199 | } 200 | } 201 | None => {//Import everything 202 | self.import_globals(imported_module, &mut |name| name.name, imported_module.name.uid) 203 | } 204 | } 205 | } 206 | } 207 | 208 | fn rename_bindings(&mut self, bindings: Vec>, is_global: bool) -> Vec> { 209 | //Add all bindings in the scope 210 | if !is_global { 211 | for bind in binding_groups(bindings.as_ref()) { 212 | self.make_unique(bind[0].name.clone()); 213 | } 214 | } 215 | bindings.into_iter().map(|binding| { 216 | let Binding { name, arguments, matches, typ, where_bindings } = binding; 217 | let n = self.uniques.find(&name) 218 | .map(|u| u.clone()) 219 | .unwrap_or_else(|| unreachable!("Variable {} should already have been defined", name)); 220 | self.uniques.enter_scope(); 221 | let b = Binding { 222 | name: n, 223 | arguments: self.rename_arguments(arguments), 224 | where_bindings: where_bindings.map(|bs| self.rename_bindings(bs, false)), 225 | matches: self.rename_matches(matches), 226 | typ: self.rename_qualified_type(typ) 227 | }; 228 | self.uniques.exit_scope(); 229 | b 230 | }).collect() 231 | } 232 | 233 | fn rename(&mut self, input_expr: TypedExpr) -> TypedExpr { 234 | use crate::module::Expr::*; 235 | use crate::module::DoBinding::*; 236 | let TypedExpr { expr, typ, location } = input_expr; 237 | let e = match expr { 238 | Literal(l) => Literal(l), 239 | Identifier(i) => Identifier(self.get_name(i)), 240 | Apply(func, arg) => Apply(Box::new(self.rename(*func)), Box::new(self.rename(*arg))), 241 | OpApply(lhs, op, rhs) => OpApply(Box::new(self.rename(*lhs)), self.get_name(op), Box::new(self.rename(*rhs))), 242 | Lambda(arg, body) => { 243 | self.uniques.enter_scope(); 244 | let l = Lambda(self.rename_pattern(arg), Box::new(self.rename(*body))); 245 | self.uniques.exit_scope(); 246 | l 247 | } 248 | Let(bindings, expr) => { 249 | self.uniques.enter_scope(); 250 | let bs = self.rename_bindings(bindings, false); 251 | let l = Let(bs, Box::new(self.rename(*expr))); 252 | self.uniques.exit_scope(); 253 | l 254 | } 255 | Case(expr, alts) => { 256 | let a: Vec> = alts.into_iter().map(|alt| { 257 | let Alternative { 258 | pattern: Located { location: loc, node: pattern }, 259 | matches, 260 | where_bindings 261 | } = alt; 262 | self.uniques.enter_scope(); 263 | let a = Alternative { 264 | pattern: Located { location: loc, node: self.rename_pattern(pattern) }, 265 | where_bindings: where_bindings.map(|bs| self.rename_bindings(bs, false)), 266 | matches: self.rename_matches(matches) 267 | }; 268 | self.uniques.exit_scope(); 269 | a 270 | }).collect(); 271 | Case(Box::new(self.rename(*expr)), a) 272 | } 273 | IfElse(pred, if_true, if_false) => { 274 | IfElse(Box::new(self.rename(*pred)), 275 | Box::new(self.rename(*if_true)), 276 | Box::new(self.rename(*if_false))) 277 | } 278 | Do(bindings, expr) => { 279 | let bs: Vec> = bindings.into_iter().map(|bind| { 280 | match bind { 281 | DoExpr(expr) => DoExpr(self.rename(expr)), 282 | DoLet(bs) => DoLet(self.rename_bindings(bs, false)), 283 | DoBind(pattern, expr) => { 284 | let Located { location, node } = pattern; 285 | let loc = Located { location: location, node: self.rename_pattern(node) }; 286 | DoBind(loc, self.rename(expr)) 287 | } 288 | } 289 | }).collect(); 290 | Do(bs, Box::new(self.rename(*expr))) 291 | } 292 | TypeSig(expr, sig) => { 293 | TypeSig(Box::new(self.rename(*expr)), self.rename_qualified_type(sig)) 294 | } 295 | Paren(expr) => Paren(Box::new(self.rename(*expr))) 296 | }; 297 | let mut t = TypedExpr::with_location(e, location); 298 | t.typ = self.rename_type(typ); 299 | t 300 | } 301 | 302 | fn rename_pattern(&mut self, pattern: Pattern) -> Pattern { 303 | match pattern { 304 | Pattern::Number(i) => Pattern::Number(i), 305 | Pattern::Constructor(s, ps) => { 306 | let ps2: Vec> = ps.into_iter().map(|p| self.rename_pattern(p)).collect(); 307 | Pattern::Constructor(self.get_name(s), ps2) 308 | } 309 | Pattern::Identifier(s) => Pattern::Identifier(self.make_unique(s)), 310 | Pattern::WildCard => Pattern::WildCard 311 | } 312 | } 313 | ///Turns the string into the Name which is currently in scope 314 | ///If the name was not found it is assumed to be global 315 | fn get_name(&self, s: InternedStr) -> Name { 316 | match self.uniques.find(&s) { 317 | Some(&Name { uid, .. }) => Name { name: s, uid: uid }, 318 | None => Name { name: s, uid: 0 }//Primitive 319 | } 320 | } 321 | 322 | fn rename_matches(&mut self, matches: Match) -> Match { 323 | match matches { 324 | Match::Simple(e) => Match::Simple(self.rename(e)), 325 | Match::Guards(gs) => Match::Guards(gs.into_iter() 326 | .map(|Guard { predicate: p, expression: e }| 327 | Guard { predicate: self.rename(p), expression: self.rename(e) } 328 | ) 329 | .collect()) 330 | } 331 | } 332 | 333 | fn rename_arguments(&mut self, arguments: Vec>) -> Vec> { 334 | arguments.into_iter().map(|a| self.rename_pattern(a)).collect() 335 | } 336 | 337 | fn rename_qualified_type(&mut self, typ: Qualified, InternedStr>) -> Qualified, Name> { 338 | let Qualified { constraints, value: typ } = typ; 339 | let constraints2: Vec> = constraints.into_iter() 340 | .map(|Constraint { class, variables }| { 341 | Constraint { class: self.get_name(class), variables: variables } 342 | }) 343 | .collect(); 344 | qualified(constraints2, self.rename_type(typ)) 345 | } 346 | fn rename_type_declarations(&mut self, decls: Vec>) -> Vec> { 347 | let decls2: Vec> = decls.into_iter() 348 | .map(|decl| TypeDeclaration { name: self.get_name(decl.name), typ: self.rename_qualified_type(decl.typ) }) 349 | .collect(); 350 | decls2 351 | } 352 | 353 | ///Introduces a new Name to the current scope. 354 | ///If the name was already declared in the current scope an error is added 355 | fn make_unique(&mut self, name: InternedStr) -> Name { 356 | if self.uniques.in_current_scope(&name) { 357 | self.errors.insert(Error::MultipleDefinitions(name)); 358 | self.uniques.find(&name).map(|x| x.clone()).unwrap() 359 | } 360 | else { 361 | let u = self.name_supply.from_interned(name.clone()); 362 | self.uniques.insert(name, u.clone()); 363 | u 364 | } 365 | } 366 | fn declare_global(&mut self, s: InternedStr, module_id: usize) -> Name { 367 | self.make_unique(s); 368 | let name = self.uniques.find_mut(&s).unwrap(); 369 | name.uid = module_id; 370 | *name 371 | } 372 | 373 | fn rename_type(&mut self, typ: Type) -> Type { 374 | typ.map(|s| self.get_name(s)) 375 | } 376 | } 377 | 378 | pub fn rename_expr(expr: TypedExpr) -> Result, RenamerError> { 379 | let mut renamer = Renamer::new(); 380 | let expr = renamer.rename(expr); 381 | renamer.errors.into_result(expr) 382 | .map_err(RenamerError) 383 | } 384 | 385 | pub fn rename_module(module: Module) -> Result, RenamerError> { 386 | let mut renamer = Renamer::new(); 387 | let m = rename_module_(&mut renamer, &[], module); 388 | renamer.errors.into_result(m) 389 | .map_err(RenamerError) 390 | } 391 | fn rename_module_(renamer: &mut Renamer, module_env: &[Module], module: Module) -> Module { 392 | let mut name = renamer.make_unique(module.name); 393 | if name.as_ref() == "Prelude" { 394 | renamer.uniques.find_mut(&name.name).unwrap().uid = 0; 395 | name.uid = 0; 396 | } 397 | renamer.uniques.enter_scope(); 398 | renamer.insert_globals(module_env, &module, name.uid); 399 | let Module { 400 | name: _, 401 | imports, 402 | classes, 403 | data_definitions, 404 | newtypes, 405 | type_declarations, 406 | bindings, 407 | instances, 408 | fixity_declarations 409 | } = module; 410 | 411 | let imports2: Vec> = imports.into_iter().map(|import| { 412 | let imports = import.imports.as_ref().map(|x| { 413 | let is: Vec = x.iter() 414 | .map(|&x| renamer.get_name(x)) 415 | .collect(); 416 | is 417 | }); 418 | Import { module: import.module, imports: imports } 419 | }).collect(); 420 | 421 | let data_definitions2 : Vec> = data_definitions.into_iter().map(|data| { 422 | let DataDefinition { 423 | constructors, 424 | typ, 425 | parameters, 426 | deriving 427 | } = data; 428 | let c: Vec> = constructors.into_iter().map(|ctor| { 429 | let Constructor { 430 | name, 431 | typ, 432 | tag, 433 | arity 434 | } = ctor; 435 | Constructor { 436 | name : renamer.get_name(name), 437 | typ : renamer.rename_qualified_type(typ), 438 | tag : tag, 439 | arity : arity 440 | } 441 | }).collect(); 442 | let d: Vec = deriving.into_iter().map(|s| { 443 | renamer.get_name(s) 444 | }).collect(); 445 | 446 | DataDefinition { 447 | typ : renamer.rename_qualified_type(typ), 448 | parameters : parameters, 449 | constructors : c, 450 | deriving : d 451 | } 452 | }).collect(); 453 | 454 | let newtypes2: Vec> = newtypes.into_iter().map(|newtype| { 455 | let Newtype { typ, constructor_name, constructor_type, deriving } = newtype; 456 | let deriving2: Vec = deriving.into_iter().map(|s| { 457 | renamer.get_name(s) 458 | }).collect(); 459 | Newtype { 460 | typ: typ, 461 | constructor_name: renamer.get_name(constructor_name), 462 | constructor_type: renamer.rename_qualified_type(constructor_type), 463 | deriving: deriving2 464 | } 465 | }).collect(); 466 | 467 | let instances2: Vec> = instances.into_iter().map(|instance| { 468 | let Instance { 469 | bindings, 470 | constraints, 471 | typ, 472 | classname 473 | } = instance; 474 | let constraints2: Vec> = constraints.into_iter() 475 | .map(|Constraint { class, variables }| { 476 | Constraint { class: renamer.get_name(class), variables: variables } 477 | }) 478 | .collect(); 479 | Instance { 480 | bindings : renamer.rename_bindings(bindings, true), 481 | constraints : constraints2, 482 | typ : renamer.rename_type(typ), 483 | classname : renamer.get_name(classname) 484 | } 485 | }).collect(); 486 | 487 | 488 | let classes2 : Vec> = classes.into_iter().map(|class| { 489 | let Class { 490 | constraints, 491 | name, 492 | variable, 493 | declarations, 494 | bindings 495 | } = class; 496 | let constraints2: Vec> = constraints.into_iter() 497 | .map(|Constraint { class, variables }| { 498 | Constraint { class: renamer.get_name(class), variables: variables } 499 | }) 500 | .collect(); 501 | Class { 502 | constraints: constraints2, 503 | name: renamer.get_name(name), 504 | variable: variable, 505 | declarations: renamer.rename_type_declarations(declarations), 506 | bindings: renamer.rename_bindings(bindings, true) 507 | } 508 | }).collect(); 509 | 510 | let bindings2 = renamer.rename_bindings(bindings, true); 511 | 512 | let fixity_declarations2: Vec> = fixity_declarations.into_iter() 513 | .map(|FixityDeclaration { assoc, precedence, operators }| { 514 | 515 | let ops: Vec = operators.into_iter() 516 | .map(|s| renamer.get_name(s)) 517 | .collect(); 518 | FixityDeclaration { assoc: assoc, precedence: precedence, 519 | operators: ops 520 | } 521 | }) 522 | .collect(); 523 | let decls2 = renamer.rename_type_declarations(type_declarations); 524 | renamer.uniques.exit_scope(); 525 | Module { 526 | name: name, 527 | imports: imports2, 528 | classes : classes2, 529 | data_definitions: data_definitions2, 530 | type_declarations: decls2, 531 | bindings : bindings2, 532 | instances: instances2, 533 | newtypes: newtypes2, 534 | fixity_declarations: fixity_declarations2 535 | } 536 | } 537 | 538 | pub fn prelude_name(s: &str) -> Name { 539 | Name { name: intern(s), uid: 0 } 540 | } 541 | 542 | ///Renames a vector of modules. 543 | ///If any errors are encounterd while renaming, an error message is output and fail is called 544 | pub fn rename_modules(modules: Vec>) -> Result>, RenamerError> { 545 | let mut renamer = Renamer::new(); 546 | let mut ms = Vec::new(); 547 | for module in modules.into_iter() { 548 | let m = rename_module_(&mut renamer, ms.as_ref(), module); 549 | ms.push(m); 550 | } 551 | renamer.errors.into_result(ms) 552 | .map_err(RenamerError) 553 | } 554 | 555 | pub mod typ { 556 | use std::iter::repeat; 557 | use crate::types::{Kind, Type, TypeVariable}; 558 | use super::{name, Name}; 559 | use crate::interner::intern; 560 | 561 | ///Constructs a string which holds the name of an n-tuple 562 | pub fn tuple_name(n: usize) -> String { 563 | let commas = if n == 0 { 0 } else { n - 1 }; 564 | Some('(').into_iter() 565 | .chain(repeat(',').take(commas)) 566 | .chain(Some(')').into_iter()) 567 | .collect() 568 | } 569 | ///Returns the type of an n-tuple constructor as well as the name of the tuple 570 | pub fn tuple_type(n: usize) -> (String, Type) { 571 | let mut var_list = Vec::new(); 572 | assert!(n < 26); 573 | for i in 0..n { 574 | let c = (('a' as u8) + i as u8) as char; 575 | let var = TypeVariable::new_var_kind(intern(c.to_string().as_ref()), Kind::Star.clone()); 576 | var_list.push(Type::Generic(var)); 577 | } 578 | let ident = tuple_name(n); 579 | let mut typ = Type::new_op(name(ident.as_ref()), var_list); 580 | for i in (0..n).rev() { 581 | let c = (('a' as u8) + i as u8) as char; 582 | typ = function_type_(Type::Generic(TypeVariable::new(intern(c.to_string().as_ref()))), typ); 583 | } 584 | (ident, typ) 585 | } 586 | 587 | ///Constructs a list type which holds elements of type 'typ' 588 | pub fn list_type(typ: Type) -> Type { 589 | Type::new_op(name("[]"), vec![typ]) 590 | } 591 | ///Returns the Type of the Char type 592 | pub fn char_type() -> Type { 593 | Type::new_op(name("Char"), vec![]) 594 | } 595 | ///Returns the type for the Int type 596 | pub fn int_type() -> Type { 597 | Type::new_op(name("Int"), vec![]) 598 | } 599 | ///Returns the type for the Bool type 600 | pub fn bool_type() -> Type { 601 | Type::new_op(name("Bool"), vec![]) 602 | } 603 | ///Returns the type for the Double type 604 | pub fn double_type() -> Type { 605 | Type::new_op(name("Double"), vec![]) 606 | } 607 | ///Creates a function type 608 | pub fn function_type(arg: &Type, result: &Type) -> Type { 609 | function_type_(arg.clone(), result.clone()) 610 | } 611 | 612 | ///Creates a function type 613 | pub fn function_type_(func : Type, arg : Type) -> Type { 614 | Type::new_op(name("->"), vec![func, arg]) 615 | } 616 | 617 | ///Creates a IO type 618 | pub fn io(typ: Type) -> Type { 619 | Type::new_op(name("IO"), vec![typ]) 620 | } 621 | ///Returns the unit type '()' 622 | pub fn unit() -> Type { 623 | Type::new_op(name("()"), vec![]) 624 | } 625 | } 626 | 627 | 628 | #[cfg(test)] 629 | pub mod tests { 630 | use super::Name; 631 | use crate::interner::InternedStr; 632 | use crate::module::{TypedExpr, Module}; 633 | use crate::parser::*; 634 | 635 | pub fn rename_modules(modules: Vec>) -> Vec> { 636 | super::rename_modules(modules) 637 | .unwrap() 638 | } 639 | pub fn rename_module(module: Module) -> Module { 640 | super::rename_module(module) 641 | .unwrap() 642 | } 643 | pub fn rename_expr(expr: TypedExpr) -> TypedExpr { 644 | super::rename_expr(expr) 645 | .unwrap() 646 | } 647 | 648 | #[test] 649 | #[should_panic] 650 | fn duplicate_binding() { 651 | let mut parser = Parser::new( 652 | r"main = 1 653 | test = [] 654 | main = 2".chars()); 655 | let module = parser.module().unwrap(); 656 | rename_modules(vec!(module)); 657 | } 658 | #[test] 659 | fn import_binding() { 660 | let file = 661 | r" 662 | import Prelude (id) 663 | main = id"; 664 | let modules = parse_string(file).unwrap(); 665 | rename_modules(modules); 666 | } 667 | #[test] 668 | #[should_panic] 669 | fn missing_import() { 670 | let mut parser = Parser::new( 671 | r" 672 | import Prelude () 673 | main = id".chars()); 674 | let module = parser.module().unwrap(); 675 | rename_modules(vec!(module)); 676 | } 677 | } 678 | -------------------------------------------------------------------------------- /src/repl.rs: -------------------------------------------------------------------------------- 1 | use std::io::BufRead; 2 | 3 | use crate::compiler::*; 4 | use crate::typecheck::*; 5 | use crate::vm::*; 6 | use crate::interner::*; 7 | use crate::core::{Module, Type, Qualified}; 8 | use crate::core::translate::*; 9 | use crate::lambda_lift::*; 10 | use crate::parser::Parser; 11 | use crate::renamer::{Name, rename_expr}; 12 | 13 | ///Returns whether the type in question is an IO action 14 | fn is_io(typ: &Type) -> bool { 15 | match *typ { 16 | Type::Application(ref lhs, _) => 17 | match **lhs { 18 | Type::Constructor(ref op) => op.name.as_ref() == "IO", 19 | _ => false 20 | }, 21 | _ => false 22 | } 23 | } 24 | 25 | ///Compiles an expression into an assembly 26 | fn compile_expr(prelude: &Assembly, expr_str: &str) -> Result { 27 | let mut parser = Parser::new(expr_str.chars()); 28 | let expr = parser.expression_().unwrap(); 29 | let mut expr = rename_expr(expr).unwrap(); 30 | 31 | let mut type_env = TypeEnvironment::new(); 32 | type_env.add_types(prelude as &dyn DataTypes); 33 | type_env.typecheck_expr(&mut expr).unwrap(); 34 | let temp_module = Module::from_expr(translate_expr(expr)); 35 | let m = do_lambda_lift(temp_module); 36 | 37 | let mut compiler = Compiler::new(); 38 | compiler.assemblies.push(prelude); 39 | Ok(compiler.compile_module(&m)) 40 | } 41 | 42 | ///Finds the main function and if it is an IO function, adds instructions to push the "RealWorld" argument 43 | fn find_main(assembly: &Assembly) -> (Vec, Qualified, Name>) { 44 | assembly.super_combinators.iter() 45 | .find(|sc| sc.name == Name { name: intern("main"), uid: 0 }) 46 | .map(|sc| { 47 | if is_io(&sc.typ.value) { 48 | //If the expression we compiled is IO we need to add an extra argument 49 | //'RealWorld' which can be any dumb value (42 here), len - 3 is used because 50 | //it is currently 3 instructions Eval, Update(0), Unwind at the end of each instruction list 51 | //to finish the expression 52 | let mut vec: Vec = sc.instructions.iter().map(|x| x.clone()).collect(); 53 | let len = vec.len(); 54 | vec.insert(len - 3, Instruction::Mkap); 55 | vec.insert(0, Instruction::PushInt(42));//Realworld 56 | (vec, sc.typ.clone()) 57 | } 58 | else { 59 | (sc.instructions.clone(), sc.typ.clone()) 60 | } 61 | }) 62 | .expect("Expected main function") 63 | } 64 | 65 | pub fn run_and_print_expr(expr_str: &str) { 66 | let prelude = compile_file("Prelude.hs") 67 | .unwrap(); 68 | let mut vm = VM::new(); 69 | vm.add_assembly(prelude); 70 | let assembly = compile_expr(vm.get_assembly(0), expr_str.as_ref()) 71 | .unwrap(); 72 | let (instructions, type_decl) = find_main(&assembly); 73 | let assembly_index = vm.add_assembly(assembly); 74 | let result = vm.evaluate(&*instructions, assembly_index);//TODO 0 is not necessarily correct 75 | println!("{:?} {}", result, type_decl); 76 | } 77 | 78 | ///Starts the REPL 79 | pub fn start() { 80 | let mut vm = VM::new(); 81 | match compile_file("Prelude.hs") { 82 | Ok(prelude) => { vm.add_assembly(prelude); } 83 | Err(err) => println!("Failed to compile the prelude\nReason: {}", err) 84 | } 85 | 86 | let stdin = ::std::io::stdin(); 87 | for line in stdin.lock().lines() { 88 | let expr_str = match line { 89 | Ok(l) => l, 90 | Err(e) => panic!("Reading line failed with '{:?}'", e) 91 | }; 92 | let assembly = match compile_expr(vm.get_assembly(0), expr_str.as_ref()) { 93 | Ok(assembly) => assembly, 94 | Err(err) => { 95 | println!("{}", err); 96 | continue 97 | } 98 | }; 99 | let (instructions, typ) = find_main(&assembly); 100 | let assembly_index = vm.add_assembly(assembly); 101 | let result = vm.evaluate(&*instructions, assembly_index);//TODO 0 is not necessarily correct 102 | println!("{:?} {}", result, typ); 103 | } 104 | } 105 | -------------------------------------------------------------------------------- /src/scoped_map.rs: -------------------------------------------------------------------------------- 1 | use std::collections::HashMap; 2 | use std::collections::hash_map::{Entry, IterMut}; 3 | use std::hash::Hash; 4 | 5 | ///A map struct which allows for the isizeroduction of different scopes 6 | ///Introducing a new scope will make it possible to isizeroduce additional 7 | ///variables with names already defined, shadowing the old name 8 | ///After exiting a scope the shadowed variable will again be re isizeroduced 9 | pub struct ScopedMap { 10 | ///A hashmap storing a key -> value mapping 11 | ///Stores a vector of values in which the value at the top is value returned from 'find' 12 | map: HashMap>, 13 | ///A vector of scopes, when entering a scope, None is added as a marker 14 | ///when later exiting a scope, values are removed from the map until the marker is found 15 | scopes: Vec> 16 | } 17 | 18 | #[allow(dead_code)] 19 | impl ScopedMap 20 | where K: Eq + Hash + Clone { 21 | 22 | pub fn new() -> ScopedMap { 23 | ScopedMap { map: HashMap::new(), scopes: Vec::new() } 24 | } 25 | ///Introduces a new scope 26 | pub fn enter_scope(&mut self) { 27 | self.scopes.push(None); 28 | } 29 | ///Exits the current scope, removing anything inserted since the 30 | ///matching enter_scope call 31 | pub fn exit_scope(&mut self) { 32 | loop { 33 | match self.scopes.pop() { 34 | Some(Some(key)) => { self.map.get_mut(&key).map(|x| x.pop()); } 35 | _ => break 36 | } 37 | } 38 | } 39 | ///Removes a previusly inserted value from the map. 40 | pub fn remove(&mut self, k: &K) -> bool { 41 | match self.map.get_mut(k).map(|x| x.pop()) { 42 | Some(..) => { 43 | let mut i = self.scopes.len() as isize - 1; 44 | while i >= 0 { 45 | if self.scopes[i as usize].as_ref().map_or(false, |x| x == k) { 46 | self.scopes.remove(i as usize); 47 | } 48 | i -= 1; 49 | } 50 | true 51 | } 52 | None => false 53 | } 54 | } 55 | 56 | ///Returns true if the key has a value declared in the last declared scope 57 | pub fn in_current_scope(&self, k: &K) -> bool { 58 | for n in self.scopes.iter().rev() { 59 | match *n { 60 | Some(ref name) if name == k => return true, 61 | None => break, 62 | _ => () 63 | } 64 | } 65 | false 66 | } 67 | ///Returns an iterator of the (key, values) pairs inserted in the map 68 | pub fn iter_mut<'a>(&'a mut self) -> IterMut<'a, K, Vec> { 69 | self.map.iter_mut() 70 | } 71 | 72 | ///Returns a reference to the last inserted value corresponding to the key 73 | pub fn find<'a>(&'a self, k: &K) -> Option<&'a V> { 74 | self.map.get(k).and_then(|x| x.last()) 75 | } 76 | 77 | ///Returns the number of elements in the container. 78 | ///Shadowed elements are not counted 79 | pub fn len(&self) -> usize { self.map.len() } 80 | 81 | ///Removes all elements 82 | pub fn clear(&mut self) { 83 | self.map.clear(); 84 | self.scopes.clear(); 85 | } 86 | 87 | ///Swaps the value stored at key, or inserts it if it is not present 88 | pub fn swap(&mut self, k: K, v: V) -> Option { 89 | let vec = match self.map.entry(k.clone()) { 90 | Entry::Vacant(entry) => entry.insert(Vec::new()), 91 | Entry::Occupied(entry) => entry.into_mut() 92 | }; 93 | if vec.len() != 0 { 94 | let r = vec.pop(); 95 | vec.push(v); 96 | r 97 | } 98 | else { 99 | vec.push(v); 100 | self.scopes.push(Some(k)); 101 | None 102 | } 103 | } 104 | pub fn pop(&mut self, k: &K) -> Option { 105 | match self.map.get_mut(k).and_then(|x| x.pop()) { 106 | Some(v) => { 107 | let mut i = self.scopes.len() as isize - 1; 108 | while i >= 0 { 109 | if self.scopes[i as usize].as_ref().map_or(false, |x| x == k) { 110 | self.scopes.remove(i as usize); 111 | } 112 | i -= 1; 113 | } 114 | Some(v) 115 | } 116 | None => None 117 | } 118 | } 119 | pub fn find_mut<'a>(&'a mut self, key: &K) -> Option<&'a mut V> { 120 | self.map.get_mut(key).and_then(|x| x.last_mut()) 121 | } 122 | pub fn insert(&mut self, k: K, v: V) -> bool { 123 | let vec = match self.map.entry(k.clone()) { 124 | Entry::Vacant(entry) => entry.insert(Vec::new()), 125 | Entry::Occupied(entry) => entry.into_mut() 126 | }; 127 | vec.push(v); 128 | self.scopes.push(Some(k)); 129 | vec.len() == 1 130 | } 131 | } 132 | 133 | #[cfg(test)] 134 | mod tests { 135 | use crate::scoped_map::ScopedMap; 136 | #[test] 137 | fn test() { 138 | let mut map = ScopedMap::new(); 139 | map.insert("a", 0); 140 | map.insert("b", 1); 141 | map.enter_scope(); 142 | assert_eq!(map.find(&"a"), Some(&0)); 143 | assert_eq!(map.find(&"b"), Some(&1)); 144 | assert_eq!(map.find(&"c"), None); 145 | map.insert("a", 1); 146 | map.insert("c", 2); 147 | assert_eq!(map.find(&"a"), Some(&1)); 148 | assert_eq!(map.find(&"c"), Some(&2)); 149 | map.exit_scope(); 150 | assert_eq!(map.find(&"a"), Some(&0)); 151 | assert_eq!(map.find(&"c"), None); 152 | } 153 | } 154 | -------------------------------------------------------------------------------- /src/types.rs: -------------------------------------------------------------------------------- 1 | use std::collections::HashMap; 2 | use std::default::Default; 3 | use std::fmt; 4 | use std::iter; 5 | use crate::interner::{InternedStr, intern}; 6 | 7 | #[derive(Clone, Debug, Default, Eq, Hash)] 8 | pub struct TypeConstructor { 9 | pub name : Ident, 10 | pub kind : Kind 11 | } 12 | 13 | impl PartialEq> for TypeConstructor 14 | where Id: PartialEq { 15 | fn eq(&self, other: &TypeConstructor) -> bool { 16 | self.name == other.name && self.kind == other.kind 17 | } 18 | } 19 | 20 | pub type VarId = InternedStr; 21 | #[derive(Clone, Debug, PartialEq, Eq, Default)] 22 | pub struct TypeVariable { 23 | pub id : InternedStr, 24 | pub kind : Kind, 25 | pub age: isize 26 | } 27 | #[derive(Clone, Debug, Eq, Hash)] 28 | pub enum Type { 29 | Variable(TypeVariable), 30 | Constructor(TypeConstructor), 31 | Application(Box>, Box>), 32 | Generic(TypeVariable) 33 | } 34 | #[derive(Clone, Debug, Default, Hash)] 35 | pub struct Qualified { 36 | pub constraints: Vec>, 37 | pub value: T 38 | } 39 | pub fn qualified(constraints: Vec>, typ: Type) -> Qualified, Ident> { 40 | Qualified { constraints: constraints, value: typ } 41 | } 42 | 43 | impl TypeVariable { 44 | pub fn new(id : VarId) -> TypeVariable { 45 | TypeVariable::new_var_kind(id, Kind::Star) 46 | } 47 | pub fn new_var_kind(id : VarId, kind: Kind) -> TypeVariable { 48 | TypeVariable { id : id, kind: kind, age: 0 } 49 | } 50 | } 51 | 52 | impl > Type { 53 | 54 | ///Creates a new type variable with the specified id 55 | pub fn new_var(id : VarId) -> Type { 56 | Type::new_var_kind(id, Kind::Star) 57 | } 58 | ///Creates a new type which is a type variable which takes a number of types as arguments 59 | ///Gives the typevariable the correct kind arity. 60 | pub fn new_var_args(id: VarId, types : Vec>) -> Type { 61 | Type::new_type_kind(Type::Variable(TypeVariable { id : id, kind: Kind::Star, age: 0 }), types) 62 | } 63 | ///Creates a new type variable with the specified kind 64 | pub fn new_var_kind(id : VarId, kind: Kind) -> Type { 65 | Type::Variable(TypeVariable::new_var_kind(id, kind)) 66 | } 67 | ///Creates a new type constructor with the specified argument and kind 68 | pub fn new_op(name : Id, types : Vec>) -> Type { 69 | Type::new_type_kind(Type::Constructor(TypeConstructor { name : name, kind: Kind::Star }), types) 70 | } 71 | ///Creates a new type constructor applied to the types and with a specific kind 72 | pub fn new_op_kind(name : Id, types : Vec>, kind: Kind) -> Type { 73 | let mut result = Type::Constructor(TypeConstructor { name : name, kind: kind }); 74 | for typ in types.into_iter() { 75 | result = Type::Application(Box::new(result), Box::new(typ)); 76 | } 77 | result 78 | } 79 | fn new_type_kind(mut result: Type, types: Vec>) -> Type { 80 | *result.mut_kind() = Kind::new(types.len() as isize + 1); 81 | for typ in types.into_iter() { 82 | result = Type::Application(Box::new(result), Box::new(typ)); 83 | } 84 | result 85 | } 86 | 87 | ///Returns a reference to the type variable or fails if it is not a variable 88 | pub fn var(&self) -> &TypeVariable { 89 | match self { 90 | &Type::Variable(ref var) => var, 91 | _ => panic!("Tried to unwrap {} as a TypeVariable", self) 92 | } 93 | } 94 | 95 | ///Returns a reference to the type constructor or fails if it is not a constructor 96 | #[allow(dead_code)] 97 | pub fn ctor(&self) -> &TypeConstructor { 98 | match self { 99 | &Type::Constructor(ref op) => op, 100 | _ => panic!("Tried to unwrap {} as a TypeConstructor", self) 101 | } 102 | } 103 | 104 | ///Returns a reference to the the type function or fails if it is not an application 105 | #[allow(dead_code)] 106 | pub fn appl(&self) -> &Type { 107 | match self { 108 | &Type::Application(ref lhs, _) => &**lhs, 109 | _ => panic!("Error: Tried to unwrap {} as TypeApplication", self) 110 | } 111 | } 112 | #[allow(dead_code)] 113 | ///Returns a reference to the the type argument or fails if it is not an application 114 | pub fn appr(&self) -> &Type { 115 | match self { 116 | &Type::Application(_, ref rhs) => &**rhs, 117 | _ => panic!("Error: Tried to unwrap TypeApplication") 118 | } 119 | } 120 | 121 | ///Returns the kind of the type 122 | ///Fails only if the type is a type application with an invalid kind 123 | pub fn kind(&self) -> &Kind { 124 | match self { 125 | &Type::Variable(ref v) => &v.kind, 126 | &Type::Constructor(ref v) => &v.kind, 127 | &Type::Application(ref lhs, _) => 128 | match lhs.kind() { 129 | &Kind::Function(_, ref kind) => &**kind, 130 | _ => panic!("Type application must have a kind of Kind::Function, {}", self) 131 | }, 132 | &Type::Generic(ref v) => &v.kind 133 | } 134 | } 135 | ///Returns a mutable reference to the types kind 136 | pub fn mut_kind(&mut self) -> &mut Kind { 137 | match *self { 138 | Type::Variable(ref mut v) => &mut v.kind, 139 | Type::Constructor(ref mut v) => &mut v.kind, 140 | Type::Application(ref mut lhs, _) => 141 | match *lhs.mut_kind() { 142 | Kind::Function(_, ref mut kind) => &mut **kind, 143 | _ => panic!("Type application must have a kind of Kind::Function") 144 | }, 145 | Type::Generic(ref mut v) => &mut v.kind 146 | } 147 | } 148 | } 149 | impl Type { 150 | pub fn map(self, mut f: F) -> Type 151 | where F: FnMut(Id) -> Id2 { 152 | self.map_(&mut f) 153 | } 154 | fn map_(self, f: &mut F) -> Type 155 | where F: FnMut(Id) -> Id2 { 156 | match self { 157 | Type::Variable(v) => Type::Variable(v), 158 | Type::Constructor(TypeConstructor { name, kind }) => { 159 | Type::Constructor(TypeConstructor { name: f(name), kind: kind }) 160 | } 161 | Type::Application(lhs, rhs) => Type::Application(Box::new(lhs.map_(f)), Box::new(rhs.map_(f))), 162 | Type::Generic(v) => Type::Generic(v) 163 | } 164 | } 165 | } 166 | 167 | impl ::std::hash::Hash for TypeVariable { 168 | #[inline] 169 | fn hash(&self, state: &mut H) { 170 | //Only has the id since the kind should always be the same for two variables 171 | self.id.hash(state); 172 | } 173 | } 174 | 175 | ///Constructs a string which holds the name of an n-tuple 176 | pub fn tuple_name(n: usize) -> String { 177 | let commas = if n == 0 { 0 } else { n - 1 }; 178 | Some('(').into_iter() 179 | .chain(iter::repeat(',').take(commas)) 180 | .chain(Some(')').into_iter()) 181 | .collect() 182 | } 183 | 184 | ///Returns the type of an n-tuple constructor as well as the name of the tuple 185 | pub fn tuple_type(n: usize) -> (String, Type) { 186 | let mut var_list = Vec::new(); 187 | assert!(n < 26); 188 | for i in 0..n { 189 | let c = (('a' as u8) + i as u8) as char; 190 | let var = TypeVariable::new_var_kind(intern(&c.to_string()), Kind::Star.clone()); 191 | var_list.push(Type::Generic(var)); 192 | } 193 | let ident = tuple_name(n); 194 | let mut typ = Type::new_op(intern(&ident), var_list); 195 | for i in (0..n).rev() { 196 | let c = (('a' as u8) + i as u8) as char; 197 | typ = function_type_(Type::Generic(TypeVariable::new(intern(&c.to_string()))), typ); 198 | } 199 | (ident, typ) 200 | } 201 | 202 | ///Constructs a list type which holds elements of type 'typ' 203 | pub fn list_type(typ: Type) -> Type { 204 | Type::new_op(intern("[]"), vec![typ]) 205 | } 206 | 207 | ///Returns the Type of the Char type 208 | pub fn char_type() -> Type { 209 | Type::new_op(intern("Char"), vec![]) 210 | } 211 | 212 | ///Returns the type for the Int type 213 | pub fn int_type() -> Type { 214 | Type::new_op(intern("Int"), vec![]) 215 | } 216 | 217 | ///Returns the type for the Bool type 218 | pub fn bool_type() -> Type { 219 | Type::new_op(intern("Bool"), vec![]) 220 | } 221 | 222 | ///Returns the type for the Double type 223 | pub fn double_type() -> Type { 224 | Type::new_op(intern("Double"), vec![]) 225 | } 226 | 227 | ///Creates a function type 228 | pub fn function_type(arg: &Type, result: &Type) -> Type { 229 | function_type_(arg.clone(), result.clone()) 230 | } 231 | 232 | ///Creates a function type 233 | pub fn function_type_(func : Type, arg : Type) -> Type { 234 | Type::new_op(intern("->"), vec![func, arg]) 235 | } 236 | 237 | ///Creates a IO type 238 | pub fn io(typ: Type) -> Type { 239 | Type::new_op(intern("IO"), vec![typ]) 240 | } 241 | 242 | ///Returns the unit type '()' 243 | pub fn unit() -> Type { 244 | Type::new_op(intern("()"), vec![]) 245 | } 246 | 247 | #[derive(Clone, Debug, PartialEq, Eq, Hash)] 248 | pub struct Constraint { 249 | pub class : Ident, 250 | pub variables : Vec 251 | } 252 | 253 | #[derive(Clone, Debug, PartialEq, Eq, Hash)] 254 | pub enum Kind { 255 | Function(Box, Box), 256 | Star 257 | } 258 | impl fmt::Display for Kind { 259 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 260 | match self { 261 | &Kind::Star => write!(f, "*"), 262 | &Kind::Function(ref lhs, ref rhs) => write!(f, "({} -> {})", *lhs, *rhs) 263 | } 264 | } 265 | } 266 | 267 | impl Kind { 268 | pub fn new(v: isize) -> Kind { 269 | let mut kind = Kind::Star.clone(); 270 | for _ in 1..v { 271 | kind = Kind::Function(Box::new(Kind::Star), Box::new(kind)); 272 | } 273 | kind 274 | } 275 | } 276 | 277 | impl Default for Kind { 278 | fn default() -> Kind { 279 | Kind::Star 280 | } 281 | } 282 | 283 | impl Default for Type { 284 | fn default() -> Type { 285 | Type::Variable(TypeVariable::new(intern("a"))) 286 | } 287 | } 288 | impl fmt::Display for TypeVariable { 289 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 290 | write!(f, "{}", self.id) 291 | } 292 | } 293 | impl fmt::Display for TypeConstructor { 294 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 295 | write!(f, "{}", self.name) 296 | } 297 | } 298 | 299 | impl > fmt::Display for Qualified { 300 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 301 | if self.constraints.len() != 0 { 302 | write!(f, "(")?; 303 | } 304 | for constraint in &self.constraints { 305 | write!(f, "{}, ", constraint)?; 306 | } 307 | if self.constraints.len() != 0 { 308 | write!(f, ") => {}" , self.value) 309 | } 310 | else { 311 | write!(f, "{}" , self.value) 312 | } 313 | } 314 | } 315 | 316 | #[derive(PartialEq, Copy, Clone, PartialOrd)] 317 | enum Prec_ { 318 | Top, 319 | Function, 320 | Constructor, 321 | } 322 | #[derive(Copy, Clone)] 323 | struct Prec<'a, Id: 'a>(Prec_, &'a Type); 324 | 325 | ///If the type is a function it returns the type of the argument and the result type, 326 | ///otherwise it returns None 327 | pub fn try_get_function<'a, Id: AsRef>(typ: &'a Type) -> Option<(&'a Type, &'a Type)> { 328 | match *typ { 329 | Type::Application(ref xx, ref result) => { 330 | match **xx { 331 | Type::Application(ref xx, ref arg) => { 332 | match **xx { 333 | Type::Constructor(ref op) if "->" == op.name.as_ref() => { 334 | Some((&**arg, &**result)) 335 | } 336 | _ => None 337 | } 338 | } 339 | _ => None 340 | } 341 | } 342 | _ => None 343 | } 344 | } 345 | 346 | impl <'a, Id: fmt::Display + AsRef> fmt::Display for Prec<'a, Id> { 347 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 348 | let Prec(p, t) = *self; 349 | match *t { 350 | Type::Variable(ref var) => write!(f, "{}", *var), 351 | Type::Constructor(ref op) => write!(f, "{}", *op), 352 | Type::Generic(ref var) => write!(f, "\\#{}", *var), 353 | Type::Application(ref lhs, ref rhs) => { 354 | match try_get_function(t) { 355 | Some((arg, result)) => { 356 | if p >= Prec_::Function { 357 | write!(f, "({} -> {})", *arg, result) 358 | } 359 | else { 360 | write!(f, "{} -> {}", Prec(Prec_::Function, arg), result) 361 | } 362 | } 363 | None => { 364 | match **lhs { 365 | Type::Constructor(ref op) if "[]" == op.name.as_ref() => { 366 | write!(f, "[{}]", rhs) 367 | } 368 | _ => { 369 | if p >= Prec_::Constructor { 370 | write!(f, "({} {})", Prec(Prec_::Function, &**lhs), Prec(Prec_::Constructor, &**rhs)) 371 | } 372 | else { 373 | write!(f, "{} {}", Prec(Prec_::Function, &**lhs), Prec(Prec_::Constructor, &**rhs)) 374 | } 375 | } 376 | } 377 | } 378 | } 379 | } 380 | } 381 | } 382 | } 383 | 384 | impl > fmt::Display for Type { 385 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 386 | write!(f, "{}", Prec(Prec_::Top, self)) 387 | } 388 | } 389 | impl fmt::Display for Constraint { 390 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 391 | write!(f, "{}", self.class)?; 392 | for var in self.variables.iter() { 393 | write!(f, " {}", *var)?; 394 | } 395 | Ok(()) 396 | } 397 | } 398 | fn type_eq<'a, Id, Id2>(mapping: &mut HashMap<&'a TypeVariable, &'a TypeVariable>, lhs: &'a Type, rhs: &'a Type) -> bool 399 | where Id: PartialEq { 400 | match (lhs, rhs) { 401 | (&Type::Constructor(ref l), &Type::Constructor(ref r)) => l.name == r.name, 402 | (&Type::Variable(ref r), &Type::Variable(ref l)) => var_eq(mapping, r, l), 403 | (&Type::Application(ref lhs1, ref rhs1), &Type::Application(ref lhs2, ref rhs2)) => { 404 | type_eq(mapping, &**lhs1, &**lhs2) && type_eq(mapping, &**rhs1, &**rhs2) 405 | } 406 | _ => false 407 | } 408 | } 409 | 410 | fn var_eq<'a>(mapping: &mut HashMap<&'a TypeVariable, &'a TypeVariable>, l: &'a TypeVariable, r: &'a TypeVariable) -> bool { 411 | match mapping.get(&l) { 412 | Some(x) => return x.id == r.id, 413 | None => () 414 | } 415 | mapping.insert(l, r); 416 | true 417 | } 418 | 419 | impl PartialEq for Qualified, U> { 420 | fn eq(&self, other: &Qualified, U>) -> bool { 421 | let mut mapping = HashMap::new(); 422 | self.constraints.iter() 423 | .zip(other.constraints.iter()) 424 | .all(|(l, r)| l.class == r.class && var_eq(&mut mapping, &l.variables[0], &r.variables[0])) 425 | && type_eq(&mut mapping, &self.value, &other.value) 426 | } 427 | } 428 | impl Eq for Qualified, U> { } 429 | 430 | impl PartialEq> for Type 431 | where Id: PartialEq { 432 | ///Compares two types, treating two type variables as equal as long as they always and only appear at the same place 433 | ///a -> b == c -> d 434 | ///a -> b != c -> c 435 | fn eq(&self, other: &Type) -> bool { 436 | let mut mapping = HashMap::new(); 437 | type_eq(&mut mapping, self, other) 438 | } 439 | } 440 | 441 | pub fn extract_applied_type(typ: &Type) -> &Type { 442 | match *typ { 443 | Type::Application(ref lhs, _) => extract_applied_type(&**lhs), 444 | _ => typ 445 | } 446 | } 447 | -------------------------------------------------------------------------------- /src/vm.rs: -------------------------------------------------------------------------------- 1 | use std::fmt; 2 | use std::rc::Rc; 3 | use std::cell::{Ref, RefMut, RefCell}; 4 | use std::path::Path; 5 | use std::io; 6 | use std::io::Read; 7 | use std::fs::File; 8 | use std::error::Error; 9 | use std::num::Wrapping; 10 | use crate::typecheck::TypeEnvironment; 11 | use crate::compiler::*; 12 | use crate::parser::Parser; 13 | use crate::core::translate::translate_module; 14 | use crate::lambda_lift::do_lambda_lift; 15 | use crate::renamer::rename_module; 16 | use crate::vm::primitive::{BuiltinFun, get_builtin}; 17 | use crate::interner::*; 18 | 19 | use self::Node_::*; 20 | 21 | #[derive(Clone)] 22 | pub struct InstanceDictionary { 23 | entries: Vec> 24 | } 25 | 26 | #[derive(Clone)] 27 | enum DictionaryEntry { 28 | Function(usize), 29 | App(usize, InstanceDictionary) 30 | } 31 | 32 | pub enum Node_<'a> { 33 | Application(Node<'a>, Node<'a>), 34 | Int(isize), 35 | Float(f64), 36 | Char(char), 37 | Combinator(&'a SuperCombinator), 38 | Indirection(Node<'a>), 39 | Constructor(u16, Vec>), 40 | Dictionary(InstanceDictionary), 41 | BuiltinFunction(usize, BuiltinFun) 42 | } 43 | impl <'a> Clone for Node_<'a> { 44 | fn clone(&self) -> Node_<'a> { 45 | match self { 46 | &Application(ref func, ref arg) => Application(func.clone(), arg.clone()), 47 | &Int(i) => Int(i), 48 | &Float(i) => Float(i), 49 | &Char(c) => Char(c), 50 | &Combinator(sc) => Combinator(sc), 51 | &Indirection(ref n) => Indirection(n.clone()), 52 | &Constructor(ref tag, ref args) => Constructor(tag.clone(), args.clone()), 53 | &Dictionary(ref dict) => Dictionary(dict.clone()), 54 | &BuiltinFunction(arity, f) => BuiltinFunction(arity, f) 55 | } 56 | } 57 | } 58 | 59 | #[derive(Clone)] 60 | pub struct Node<'a> { 61 | node: Rc>> 62 | } 63 | 64 | impl <'a> Node<'a> { 65 | ///Creates a new node 66 | fn new(n : Node_<'a>) -> Node<'a> { 67 | Node { node: Rc::new(RefCell::new(n)) } 68 | } 69 | fn borrow<'b>(&'b self) -> Ref<'b, Node_<'a>> { 70 | (*self.node).borrow() 71 | } 72 | fn borrow_mut<'b>(&'b self) -> RefMut<'b, Node_<'a>> { 73 | (*self.node).borrow_mut() 74 | } 75 | } 76 | impl <'a> fmt::Debug for Node<'a> { 77 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 78 | write!(f, "{:?}", *self.borrow()) 79 | } 80 | } 81 | impl <'a> fmt::Debug for Node_<'a> { 82 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 83 | match self { 84 | &Application(ref func, ref arg) => write!(f, "({:?} {:?})", *func, *arg), 85 | &Int(i) => write!(f, "{:?}", i), 86 | &Float(i) => write!(f, "{:?}f", i), 87 | &Char(c) => write!(f, "'{:?}'", c), 88 | &Combinator(ref sc) => write!(f, "{:?}", sc.name), 89 | &Indirection(ref n) => write!(f, "(~> {:?})", *n), 90 | &Constructor(ref tag, ref args) => { 91 | let cons = args; 92 | if cons.len() > 0 { 93 | match *cons[0].borrow() { 94 | Char(_) => { 95 | fn print_string<'a>(f: &mut fmt::Formatter, cons: &Vec>) -> fmt::Result { 96 | if cons.len() >= 2 { 97 | match *cons[0].borrow() { 98 | Char(c) => { write!(f, "{:?}", c)?; }, 99 | _ => () 100 | } 101 | match *cons[1].borrow() { 102 | Constructor(_, ref args2) => return print_string(f, args2), 103 | _ => () 104 | } 105 | } 106 | Ok(()) 107 | } 108 | write!(f, "\"")?; 109 | print_string(f, cons)?; 110 | write!(f, "\"") 111 | } 112 | _ => { 113 | //Print a normal constructor 114 | write!(f, "{{{:?}", *tag)?; 115 | for arg in args.iter() { 116 | write!(f, " {:?}", *arg.borrow())?; 117 | } 118 | write!(f, "}}") 119 | } 120 | } 121 | } 122 | else { 123 | //Print a normal constructor 124 | write!(f, "{{{:?}", *tag)?; 125 | for arg in args.iter() { 126 | write!(f, " {:?}", *arg.borrow())?; 127 | } 128 | write!(f, "}}") 129 | } 130 | } 131 | &Dictionary(ref dict) => write!(f, "{:?}", dict), 132 | &BuiltinFunction(..) => write!(f, "") 133 | } 134 | } 135 | } 136 | impl fmt::Debug for InstanceDictionary { 137 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 138 | write!(f, "[")?; 139 | if self.entries.len() > 0 { 140 | write!(f, "{:?}", *self.entries[0])?; 141 | } 142 | for entry in self.entries.iter().skip(1) { 143 | write!(f, ", {:?}", **entry)?; 144 | } 145 | write!(f, "]") 146 | } 147 | } 148 | impl fmt::Debug for DictionaryEntry { 149 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 150 | match *self { 151 | DictionaryEntry::Function(index) => write!(f, "{:?}", index), 152 | DictionaryEntry::App(ref func, ref arg) => write!(f, "({:?} {:?})", *func, *arg) 153 | } 154 | } 155 | } 156 | 157 | pub struct VM { 158 | ///Vector of all assemblies which are loaded. 159 | assembly : Vec, 160 | ///A pair of (assembly_index, function_index). 161 | globals: Vec<(usize, usize)>, 162 | } 163 | 164 | impl <'a> VM { 165 | pub fn new() -> VM { 166 | VM { assembly : Vec::new(), globals: Vec::new() } 167 | } 168 | 169 | ///Adds an assembly to the VM, adding entries to the global table as necessary 170 | pub fn add_assembly(&mut self, assembly: Assembly) -> usize { 171 | self.assembly.push(assembly); 172 | let assembly_index = self.assembly.len() - 1; 173 | for index in 0..self.assembly.last().unwrap().super_combinators.len() { 174 | self.globals.push((assembly_index, index)); 175 | } 176 | assembly_index 177 | } 178 | ///Returns a reference to the assembly at the index 179 | pub fn get_assembly(&self, index: usize) -> &Assembly { 180 | &self.assembly[index] 181 | } 182 | 183 | ///Evaluates the code into Head Normal Form (HNF) 184 | pub fn evaluate(&self, code: &[Instruction], assembly_id: usize) -> Node_ { 185 | let mut stack = Vec::new(); 186 | self.execute(&mut stack, code, assembly_id); 187 | self.deepseq(stack, assembly_id) 188 | } 189 | 190 | ///Evaluates the what is at the top of the stack into HNF 191 | fn deepseq(&'a self, mut stack: Vec>, assembly_id: usize) -> Node_<'a> { 192 | static EVALCODE : &'static [Instruction] = &[Instruction::Eval]; 193 | self.execute(&mut stack, EVALCODE, assembly_id); 194 | match *stack[0].borrow() { 195 | Constructor(tag, ref vals) => { 196 | let mut ret = Vec::new(); 197 | for v in vals.iter() { 198 | let s = vec!(v.clone()); 199 | let x = self.deepseq(s, assembly_id); 200 | ret.push(Node::new(x)); 201 | } 202 | Constructor(tag, ret) 203 | } 204 | _ => stack[0].borrow().clone() 205 | } 206 | } 207 | 208 | ///Executes a sequence of instructions, leaving the result on the top of the stack 209 | pub fn execute(&'a self, stack: &mut Vec>, code: &[Instruction], assembly_id: usize) { 210 | use crate::compiler::Instruction::*; 211 | debug!("----------------------------"); 212 | debug!("Entering frame with stack"); 213 | for x in stack.iter() { 214 | debug!("{:?}", *x.borrow()); 215 | } 216 | debug!(""); 217 | let mut i = Wrapping(0); 218 | while i.0 < code.len() { 219 | debug!("Executing instruction {:?} : {:?}", i.0, code[i.0]); 220 | match code[i.0] { 221 | Add => primitive(stack, |l, r| { l + r }), 222 | Sub => primitive(stack, |l, r| { l - r }), 223 | Multiply => primitive(stack, |l, r| { l * r }), 224 | Divide => primitive(stack, |l, r| { l / r }), 225 | Remainder => primitive(stack, |l, r| { l % r }), 226 | IntEQ => primitive_int(stack, |l, r| { if l == r { Constructor(0, Vec::new()) } else { Constructor(1, Vec::new()) } }), 227 | IntLT => primitive_int(stack, |l, r| { if l < r { Constructor(0, Vec::new()) } else { Constructor(1, Vec::new()) } }), 228 | IntLE => primitive_int(stack, |l, r| { if l <= r { Constructor(0, Vec::new()) } else { Constructor(1, Vec::new()) } }), 229 | IntGT => primitive_int(stack, |l, r| { if l > r { Constructor(0, Vec::new()) } else { Constructor(1, Vec::new()) } }), 230 | IntGE => primitive_int(stack, |l, r| { if l >= r { Constructor(0, Vec::new()) } else { Constructor(1, Vec::new()) } }), 231 | DoubleAdd => primitive_float(stack, |l, r| { Float(l + r) }), 232 | DoubleSub => primitive_float(stack, |l, r| { Float(l - r) }), 233 | DoubleMultiply => primitive_float(stack, |l, r| { Float(l * r) }), 234 | DoubleDivide => primitive_float(stack, |l, r| { Float(l / r) }), 235 | DoubleRemainder => primitive_float(stack, |l, r| { Float(l % r) }), 236 | DoubleEQ => primitive_float(stack, |l, r| { if l == r { Constructor(0, Vec::new()) } else { Constructor(1, Vec::new()) } }), 237 | DoubleLT => primitive_float(stack, |l, r| { if l < r { Constructor(0, Vec::new()) } else { Constructor(1, Vec::new()) } }), 238 | DoubleLE => primitive_float(stack, |l, r| { if l <= r { Constructor(0, Vec::new()) } else { Constructor(1, Vec::new()) } }), 239 | DoubleGT => primitive_float(stack, |l, r| { if l > r { Constructor(0, Vec::new()) } else { Constructor(1, Vec::new()) } }), 240 | DoubleGE => primitive_float(stack, |l, r| { if l >= r { Constructor(0, Vec::new()) } else { Constructor(1, Vec::new()) } }), 241 | IntToDouble => { 242 | let top = stack.pop().unwrap(); 243 | stack.push(match *top.borrow() { 244 | Int(i) => Node::new(Float(i as f64)), 245 | _ => panic!("Excpected Int in Int -> Double cast") 246 | }); 247 | } 248 | DoubleToInt => { 249 | let top = stack.pop().unwrap(); 250 | stack.push(match *top.borrow() { 251 | Float(f) => Node::new(Int(f as isize)), 252 | _ => panic!("Excpected Double in Double -> Int cast") 253 | }); 254 | } 255 | PushInt(value) => { stack.push(Node::new(Int(value))); } 256 | PushFloat(value) => { stack.push(Node::new(Float(value))); } 257 | PushChar(value) => { stack.push(Node::new(Char(value))); } 258 | Push(index) => { 259 | let x = stack[index].clone(); 260 | debug!("Pushed {:?}", *x.borrow()); 261 | for j in 0..stack.len() { 262 | debug!(" {:?} {:?}", j, *stack[j].borrow()); 263 | } 264 | stack.push(x); 265 | } 266 | PushGlobal(index) => { 267 | let (assembly_index, index) = self.globals[index]; 268 | let sc = &self.assembly[assembly_index].super_combinators[index]; 269 | stack.push(Node::new(Combinator(sc))); 270 | } 271 | PushBuiltin(index) => { 272 | let (arity, f) = get_builtin(index); 273 | stack.push(Node::new(BuiltinFunction(arity, f))); 274 | } 275 | Mkap => { 276 | assert!(stack.len() >= 2); 277 | let func = stack.pop().unwrap(); 278 | let arg = stack.pop().unwrap(); 279 | debug!("Mkap {:?} {:?}", *func.borrow(), *arg.borrow()); 280 | stack.push(Node::new(Application(func, arg))); 281 | } 282 | Eval => { 283 | static UNWINDCODE : &'static [Instruction] = &[Unwind]; 284 | let old = stack.pop().unwrap(); 285 | let mut new_stack = vec!(old.clone()); 286 | self.execute(&mut new_stack, UNWINDCODE, assembly_id); 287 | stack.push(new_stack.pop().unwrap()); 288 | debug!("{:?}", stack); 289 | let new = stack.last().unwrap().borrow().clone(); 290 | *(*old.node).borrow_mut() = new; 291 | debug!("{:?}", stack); 292 | } 293 | Pop(num) => { 294 | for _ in 0..num { 295 | stack.pop(); 296 | } 297 | } 298 | Update(index) => { 299 | stack[index] = Node::new(Indirection(stack.last().unwrap().clone())); 300 | } 301 | Unwind => { 302 | fn unwind<'a, F>(i_ptr: &mut Wrapping, arity: usize, stack: &mut Vec>, f: F) 303 | where F: FnOnce(&mut Vec>) -> Node<'a> { 304 | if stack.len() - 1 < arity { 305 | while stack.len() > 1 { 306 | stack.pop(); 307 | } 308 | } 309 | else { 310 | for j in (stack.len() - arity - 1)..(stack.len() - 1) { 311 | let temp = match *stack[j].borrow() { 312 | Application(_, ref arg) => arg.clone(), 313 | _ => panic!("Expected Application") 314 | }; 315 | stack[j] = temp; 316 | } 317 | let value = { 318 | let mut new_stack = Vec::new(); 319 | for i in 0..arity { 320 | let index = stack.len() - i - 2; 321 | new_stack.push(stack[index].clone()); 322 | } 323 | f(&mut new_stack) 324 | }; 325 | for _ in 0..(arity + 1) { 326 | stack.pop(); 327 | } 328 | stack.push(value); 329 | *i_ptr = *i_ptr - Wrapping(1); 330 | } 331 | } 332 | let x = (*stack.last().unwrap().borrow()).clone(); 333 | debug!("Unwinding {:?}", x); 334 | match x { 335 | Application(func, _) => { 336 | stack.push(func); 337 | i = i - Wrapping(1);//Redo the unwind instruction 338 | } 339 | Combinator(comb) => { 340 | debug!(">>> Call {:?}", comb.name); 341 | unwind(&mut i, comb.arity, stack, |new_stack| { 342 | self.execute(new_stack, &*comb.instructions, comb.assembly_id); 343 | new_stack.pop().unwrap() 344 | }); 345 | } 346 | BuiltinFunction(arity, func) => { 347 | unwind(&mut i, arity, stack, |new_stack| func(self, new_stack.as_ref())); 348 | } 349 | Indirection(node) => { 350 | *stack.last_mut().unwrap() = node; 351 | i = i - Wrapping(1);//Redo the unwind instruction 352 | } 353 | _ => () 354 | } 355 | } 356 | Slide(size) => { 357 | let top = stack.pop().unwrap(); 358 | for _ in 0..size { 359 | stack.pop(); 360 | } 361 | stack.push(top); 362 | } 363 | Split(_) => { 364 | let temp = stack.pop().unwrap(); 365 | let temp = temp.borrow(); 366 | match *temp { 367 | Constructor(_, ref fields) => { 368 | for field in fields.iter() { 369 | stack.push(field.clone()); 370 | } 371 | } 372 | _ => panic!("Expected constructor in Split instruction") 373 | } 374 | } 375 | Pack(tag, arity) => { 376 | let mut args = Vec::new(); 377 | for _ in 0..arity { 378 | args.push(stack.pop().unwrap()); 379 | } 380 | stack.push(Node::new(Constructor(tag, args))); 381 | } 382 | JumpFalse(address) => { 383 | match *stack.last().unwrap().borrow() { 384 | Constructor(0, _) => (), 385 | Constructor(1, _) => i = Wrapping(address - 1), 386 | _ => () 387 | } 388 | stack.pop(); 389 | } 390 | CaseJump(jump_tag) => { 391 | let jumped = match *stack.last().unwrap().borrow() { 392 | Constructor(tag, _) => { 393 | if jump_tag == tag as usize { 394 | i = i + Wrapping(1);//Skip the jump instruction ie continue to the next test 395 | true 396 | } 397 | else { 398 | false 399 | } 400 | } 401 | ref x => panic!("Expected constructor when executing CaseJump, got {:?}", *x), 402 | }; 403 | if !jumped { 404 | stack.pop(); 405 | } 406 | } 407 | Jump(to) => { 408 | i = Wrapping(to - 1); 409 | } 410 | PushDictionary(index) => { 411 | let assembly = &self.assembly[assembly_id]; 412 | let dict : &[usize] = &*assembly.instance_dictionaries[index]; 413 | let dict = InstanceDictionary { entries: dict.iter().map(|i| Rc::new(DictionaryEntry::Function(*i))).collect() }; 414 | stack.push(Node::new(Dictionary(dict))); 415 | } 416 | PushDictionaryMember(index) => { 417 | let sc = { 418 | let x = stack[0].borrow(); 419 | let dict = match *x { 420 | Dictionary(ref x) => x, 421 | ref x => panic!("Attempted to retrieve {:?} as dictionary", *x) 422 | }; 423 | match *dict.entries[index] { 424 | DictionaryEntry::Function(gi) => { 425 | let (assembly_index, i) = self.globals[gi]; 426 | Combinator(&self.assembly[assembly_index].super_combinators[i]) 427 | } 428 | DictionaryEntry::App(gi, ref dict) => { 429 | let (assembly_index, i) = self.globals[gi]; 430 | let sc = &self.assembly[assembly_index].super_combinators[i]; 431 | Application(Node::new(Combinator(sc)), Node::new(Dictionary(dict.clone()))) 432 | } 433 | } 434 | }; 435 | stack.push(Node::new(sc)); 436 | } 437 | MkapDictionary => { 438 | let a = stack.pop().unwrap(); 439 | let a = a.borrow(); 440 | let arg = match *a { 441 | Dictionary(ref d) => { 442 | d 443 | } 444 | _ => panic!() 445 | }; 446 | let func = stack.pop().unwrap(); 447 | let mut new_dict = InstanceDictionary { entries: Vec::new() }; 448 | match *func.borrow() { 449 | Dictionary(ref d) => { 450 | for entry in d.entries.iter() { 451 | match **entry { 452 | DictionaryEntry::Function(index) => { 453 | new_dict.entries.push(Rc::new(DictionaryEntry::App(index, arg.clone()))); 454 | } 455 | _ => panic!() 456 | } 457 | } 458 | } 459 | _ => panic!() 460 | } 461 | stack.push(Node::new(Dictionary(new_dict))); 462 | } 463 | ConstructDictionary(size) => { 464 | let mut new_dict = InstanceDictionary { entries: Vec::new() }; 465 | for _ in 0..size { 466 | let temp = stack.pop().unwrap(); 467 | let temp = temp.borrow(); 468 | match *temp { 469 | Dictionary(ref d) => { 470 | new_dict.entries.extend(d.entries.iter().map(|x| x.clone())); 471 | } 472 | ref x => panic!("Unexpected {:?}", x) 473 | } 474 | } 475 | stack.push(Node::new(Dictionary(new_dict))); 476 | } 477 | PushDictionaryRange(start, size) => { 478 | let mut new_dict = InstanceDictionary { entries: Vec::new() }; 479 | match *stack[0].borrow() { 480 | Dictionary(ref d) => { 481 | new_dict.entries.extend(d.entries.iter().skip(start).take(size).map(|x| x.clone())); 482 | } 483 | _ => panic!() 484 | } 485 | stack.push(Node::new(Dictionary(new_dict))); 486 | } 487 | } 488 | i = i + Wrapping(1); 489 | } 490 | debug!("End frame"); 491 | debug!("--------------------------"); 492 | } 493 | } 494 | 495 | 496 | ///Exucutes a binary primitive instruction taking two integers 497 | fn primitive_int<'a, F>(stack: &mut Vec>, f: F) where F: FnOnce(isize, isize) -> Node_<'a> { 498 | let l = stack.pop().unwrap(); 499 | let r = stack.pop().unwrap(); 500 | let l = l.borrow(); 501 | let r = r.borrow(); 502 | match (&*l, &*r) { 503 | (&Int(lhs), &Int(rhs)) => stack.push(Node::new(f(lhs, rhs))), 504 | (lhs, rhs) => panic!("Expected fully evaluted numbers in primitive instruction\n LHS: {:?}\nRHS: {:?} ", lhs, rhs) 505 | } 506 | } 507 | ///Exucutes a binary primitive instruction taking two doubles 508 | fn primitive_float<'a, F>(stack: &mut Vec>, f: F) where F: FnOnce(f64, f64) -> Node_<'a> { 509 | let l = stack.pop().unwrap(); 510 | let r = stack.pop().unwrap(); 511 | let l = l.borrow(); 512 | let r = r.borrow(); 513 | match (&*l, &*r) { 514 | (&Float(lhs), &Float(rhs)) => stack.push(Node::new(f(lhs, rhs))), 515 | (lhs, rhs) => panic!("Expected fully evaluted numbers in primitive instruction\n LHS: {:?}\nRHS: {:?} ", lhs, rhs) 516 | } 517 | } 518 | fn primitive(stack: &mut Vec, f: F) where F: FnOnce(isize, isize) -> isize { 519 | primitive_int(stack, move |l, r| Int(f(l, r))) 520 | } 521 | 522 | #[derive(PartialEq, Debug)] 523 | pub enum VMResult { 524 | Char(char), 525 | Int(isize), 526 | Double(f64), 527 | Constructor(u16, Vec) 528 | } 529 | 530 | 531 | // TODO: throw this garbage into the macro below 532 | use crate::parser::ParseError; 533 | use crate::renamer::RenamerError; 534 | use crate::typecheck::TypeError; 535 | 536 | macro_rules! vm_error { 537 | ($($pre: ident :: $post: ident),+) => { 538 | 539 | #[derive(Debug)] 540 | pub enum VMError { 541 | Io(io::Error), 542 | $($post(crate::$pre::$post)),+ 543 | } 544 | 545 | impl fmt::Display for VMError { 546 | fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { 547 | match *self { 548 | VMError::Io(ref e) => write!(f, "{}", e), 549 | $(VMError::$post(ref e) => write!(f, "{}", e)),+ 550 | } 551 | } 552 | } 553 | 554 | impl Error for VMError { 555 | fn description(&self) -> &str { 556 | "stuff" 557 | 558 | /*match *self { 559 | VMError::Io(ref e) => e.description(), 560 | $(VMError::$post(ref e) => e.description()),+ 561 | }*/ 562 | } 563 | } 564 | 565 | impl From for VMError { 566 | fn from(e: io::Error) -> Self { VMError::Io(e) } 567 | } 568 | 569 | $(impl From<$post> for VMError { 570 | fn from(e: $post) -> Self { VMError::$post(e) } 571 | })+ 572 | } 573 | } 574 | vm_error! { parser::ParseError, renamer::RenamerError, typecheck::TypeError } 575 | 576 | fn compile_iter>(iterator: T) -> Result { 577 | let mut parser = Parser::new(iterator); 578 | let module = parser.module().unwrap(); 579 | let mut module = rename_module(module).unwrap(); 580 | 581 | let mut typer = TypeEnvironment::new(); 582 | typer.typecheck_module(&mut module).unwrap(); 583 | let core_module = do_lambda_lift(translate_module(module)); 584 | 585 | let mut compiler = Compiler::new(); 586 | Ok(compiler.compile_module(&core_module)) 587 | } 588 | 589 | ///Compiles a single file 590 | pub fn compile_file(filename: &str) -> Result { 591 | let path = &Path::new(filename); 592 | let mut file = File::open(path)?; 593 | let mut contents = ::std::string::String::new(); 594 | file.read_to_string(&mut contents)?; 595 | compile_iter(contents.chars()) 596 | } 597 | 598 | fn extract_result(node: Node_) -> Option { 599 | match node { 600 | // TODO: Application result 601 | 602 | Constructor(tag, fields) => { 603 | let mut result = Vec::new(); 604 | for field in fields.iter() { 605 | match extract_result((*field.borrow()).clone()) { 606 | Some(x) => result.push(x), 607 | None => return None 608 | } 609 | } 610 | 611 | Some(VMResult::Constructor(tag, result)) 612 | } 613 | 614 | Char(i) => Some(VMResult::Char(i)), 615 | Int(i) => Some(VMResult::Int(i)), 616 | Float(i) => Some(VMResult::Double(i)), 617 | 618 | x => { 619 | println!("Can't extract result {:?}", x); 620 | None 621 | } 622 | } 623 | } 624 | 625 | pub fn execute_main_string(module: &str) -> Result, String> { 626 | let assemblies = compile_string(module)?; 627 | execute_main_module_(assemblies) 628 | } 629 | 630 | ///Takes a module with a main function and compiles it and all its imported modules 631 | ///and then executes the main function 632 | pub fn execute_main_module(modulename: &str) -> Result, String> { 633 | let assemblies = compile_module(modulename)?; 634 | execute_main_module_(assemblies) 635 | } 636 | 637 | fn execute_main_module_(assemblies: Vec) -> Result, String> { 638 | let mut vm = VM::new(); 639 | for assembly in assemblies.into_iter() { 640 | vm.add_assembly(assembly); 641 | } 642 | let x = vm.assembly.iter().flat_map(|a| a.super_combinators.iter()).find(|sc| sc.name.name == intern("main")); 643 | match x { 644 | Some(sc) => { 645 | assert!(sc.arity == 0); 646 | let result = vm.evaluate(&*sc.instructions, sc.assembly_id); 647 | Ok(extract_result(result)) 648 | } 649 | None => Ok(None) 650 | } 651 | } 652 | 653 | //We mirror the naming scheme from Haskell here which is camelCase 654 | #[allow(non_snake_case)] 655 | mod primitive { 656 | 657 | use std::io::Read; 658 | use std::fs::File; 659 | use crate::vm::{VM, Node, Node_}; 660 | use crate::vm::Node_::{Application, Constructor, BuiltinFunction, Char}; 661 | use crate::compiler::Instruction; 662 | use crate::compiler::Instruction::Eval; 663 | 664 | pub fn get_builtin(i: usize) -> (usize, BuiltinFun) { 665 | match i { 666 | 0 => (1, error), 667 | 1 => (2, seq), 668 | 2 => (2, readFile), 669 | 3 => (3, io_bind), 670 | 4 => (2, io_return), 671 | 5 => (2, putStrLn), 672 | 6 => (2, compare_tags), 673 | _ => panic!("undefined primitive") 674 | } 675 | } 676 | 677 | pub type BuiltinFun = for <'a> extern "Rust" fn (&'a VM, &[Node<'a>]) -> Node<'a>; 678 | 679 | fn error<'a>(vm: &'a VM, stack: &[Node<'a>]) -> Node<'a> { 680 | let mut vec = Vec::new(); 681 | vec.push(stack[0].clone()); 682 | let node = vm.deepseq(vec, 123); 683 | panic!("error: {:?}", node) 684 | } 685 | fn eval<'a>(vm: &'a VM, node: Node<'a>) -> Node<'a> { 686 | static EVALCODE : &'static [Instruction] = &[Eval]; 687 | let mut temp = Vec::new(); 688 | temp.push(node); 689 | vm.execute(&mut temp, EVALCODE, 123); 690 | temp.pop().unwrap() 691 | } 692 | fn seq<'a>(vm: &'a VM, stack: &[Node<'a>]) -> Node<'a> { 693 | eval(vm, stack[0].clone()); 694 | stack[1].clone() 695 | } 696 | fn io_bind<'a>(_vm: &'a VM, stack: &[Node<'a>]) -> Node<'a> { 697 | //IO a -> (a -> IO b) -> IO b 698 | //IO a = (RealWorld -> (a, RealWorld) 699 | //((RealWorld -> (a, RealWorld)) -> (a -> RealWorld -> (b, RealWorld)) -> RealWorld -> (b, RealWorld) 700 | // 0 1 2 701 | //(a, RealWorld) 702 | let aw = Node::new(Application(stack[0].clone(), stack[2].clone())); 703 | let p = Node::new(BuiltinFunction(2, pass)); 704 | Node::new(Application(Node::new(Application(p, aw)), stack[1].clone())) 705 | } 706 | fn pass<'a>(vm: &'a VM, stack: &[Node<'a>]) -> Node<'a> { 707 | //(a, RealWorld) -> (a -> RealWorld -> (b, RealWorld)) -> (b, RealWorld) 708 | eval(vm, stack[0].clone()); 709 | let aw = stack[0].borrow(); 710 | let (a, rw) = match *aw { 711 | Constructor(_, ref args) => (&args[0], &args[1]), 712 | _ => panic!("pass exepected constructor") 713 | }; 714 | Node::new(Application(Node::new(Application(stack[1].clone(), a.clone())), rw.clone())) 715 | } 716 | fn io_return<'a>(_vm: &'a VM, stack: &[Node<'a>]) -> Node<'a> { 717 | //a -> RealWorld -> (a, RealWorld) 718 | Node::new(Constructor(0, vec!(stack[0].clone(), stack[1].clone()))) 719 | } 720 | fn readFile<'a>(vm: &'a VM, stack: &[Node<'a>]) -> Node<'a> { 721 | let mut temp = Vec::new(); 722 | temp.push(stack[0].clone()); 723 | let node_filename = vm.deepseq(temp, 123); 724 | let filename = get_string(&node_filename); 725 | let mut file = match File::open(&filename) { 726 | Ok(f) => f, 727 | Err(err) => panic!("error: readFile -> {:?}", err) 728 | }; 729 | let mut s = ::std::string::String::new(); 730 | let (begin, _end) = match file.read_to_string(&mut s) { 731 | Ok(_) => create_string(&s), 732 | Err(err) => panic!("error: readFile -> {:?}", err) 733 | }; 734 | //Return (String, RealWorld) 735 | Node::new(Constructor(0, vec!(begin, stack[1].clone()))) 736 | } 737 | 738 | fn putStrLn<'a>(vm: &'a VM, stack: &[Node<'a>]) -> Node<'a> { 739 | let mut temp = Vec::new(); 740 | temp.push(stack[0].clone()); 741 | let msg_node = vm.deepseq(temp, 123); 742 | let msg = get_string(&msg_node); 743 | println!("{:?}", msg); 744 | Node::new(Constructor(0, vec!(Node::new(Constructor(0, vec!())), stack[1].clone()))) 745 | } 746 | fn get_string<'a>(node: &Node_<'a>) -> String { 747 | fn get_string_<'a>(buffer: &mut String, node: &Node_<'a>) { 748 | match *node { 749 | Constructor(_, ref args) => { 750 | if args.len() == 2 { 751 | match *args[0].borrow() { 752 | Char(c) => buffer.push(c), 753 | _ => panic!("Unevaluated char") 754 | } 755 | get_string_(buffer, &*args[1].borrow()); 756 | } 757 | } 758 | _ => panic!("Unevaluated list") 759 | } 760 | } 761 | let mut buffer = String::new(); 762 | get_string_(&mut buffer, node); 763 | buffer 764 | } 765 | fn create_string<'a>(s: &str) -> (Node<'a>, Node<'a>) { 766 | let mut node = Node::new(Constructor(0, vec!())); 767 | let first = node.clone(); 768 | for c in s.chars() { 769 | let temp = match *node.borrow_mut() { 770 | Constructor(ref mut tag, ref mut args) => { 771 | *tag = 1; 772 | args.push(Node::new(Char(c))); 773 | args.push(Node::new(Constructor(0, Vec::new()))); 774 | args[1].clone() 775 | } 776 | _ => panic!() 777 | }; 778 | node = temp; 779 | } 780 | (first, node) 781 | } 782 | ///Compares the tags of two constructors, returning an Ordering 783 | fn compare_tags<'a>(vm: &'a VM, stack: &[Node<'a>]) -> Node<'a> { 784 | use std::cmp::Ordering; 785 | assert_eq!(stack.len(), 2); 786 | let lhs = eval(vm, stack[0].clone()); 787 | let rhs = eval(vm, stack[1].clone()); 788 | let tag = match (&*lhs.borrow(), &*rhs.borrow()) { 789 | (&Constructor(lhs, _), &Constructor(rhs, _)) => match lhs.cmp(&rhs) { 790 | Ordering::Less => 0, 791 | Ordering::Equal => 1, 792 | Ordering::Greater => 2 793 | }, 794 | (_, _) => 1//EQ 795 | }; 796 | Node::new(Constructor(tag, Vec::new())) 797 | } 798 | } 799 | 800 | #[cfg(test)] 801 | mod tests { 802 | 803 | use crate::typecheck::TypeEnvironment; 804 | use crate::compiler::{compile_with_type_env}; 805 | use crate::vm::{VM, compile_file, compile_iter, execute_main_module, execute_main_string, extract_result, VMResult}; 806 | use crate::interner::*; 807 | 808 | fn execute_main>(iterator: T) -> Option { 809 | let mut vm = VM::new(); 810 | vm.add_assembly(compile_iter(iterator).unwrap()); 811 | let x = vm.assembly.iter().flat_map(|a| a.super_combinators.iter()).find(|sc| sc.name.name == intern("main")); 812 | match x { 813 | Some(sc) => { 814 | assert!(sc.arity == 0); 815 | let result = vm.evaluate(&*sc.instructions, sc.assembly_id); 816 | extract_result(result) 817 | } 818 | None => None 819 | } 820 | } 821 | 822 | #[test] 823 | fn test_primitive() 824 | { 825 | assert_eq!(execute_main("main = primIntAdd 10 5".chars()), Some(VMResult::Int(15))); 826 | assert_eq!(execute_main("main = primIntSubtract 7 (primIntMultiply 2 3)".chars()), Some(VMResult::Int(1))); 827 | assert_eq!(execute_main("main = primIntDivide 10 (primIntRemainder 6 4)".chars()), Some(VMResult::Int(5))); 828 | assert_eq!(execute_main("main = primDoubleDivide 3. 2.".chars()), Some(VMResult::Double(1.5))); 829 | let s = 830 | r"data Bool = True | False 831 | main = primIntLT 1 2"; 832 | assert_eq!(execute_main(s.chars()), Some(VMResult::Constructor(0, Vec::new()))); 833 | } 834 | 835 | #[test] 836 | fn test_function() 837 | { 838 | let module = 839 | r"mult2 x = primIntMultiply x 2 840 | 841 | main = mult2 10"; 842 | assert_eq!(execute_main(module.chars()), Some(VMResult::Int(20))); 843 | 844 | let module2 = 845 | r"mult2 x = primIntMultiply x 2 846 | 847 | add x y = primIntAdd y x 848 | 849 | main = add 3 (mult2 10)"; 850 | assert_eq!(execute_main(module2.chars()), Some(VMResult::Int(23))); 851 | } 852 | #[test] 853 | fn test_case() 854 | { 855 | let module = 856 | r"mult2 x = primIntMultiply x 2 857 | 858 | main = case [mult2 123, 0] of 859 | x:xs -> x 860 | [] -> 10"; 861 | assert_eq!(execute_main(module.chars()), Some(VMResult::Int(246))); 862 | } 863 | 864 | #[test] 865 | fn test_nested_case() { 866 | let module = 867 | r"mult2 x = primIntMultiply x 2 868 | 869 | main = case [mult2 123, 0] of 870 | 246:xs -> primIntAdd 0 246 871 | [] -> 10"; 872 | assert_eq!(execute_main(module.chars()), Some(VMResult::Int(246))); 873 | } 874 | 875 | #[test] 876 | fn test_nested_case2() { 877 | let module = 878 | r"mult2 x = primIntMultiply x 2 879 | 880 | main = case [mult2 123, 0] of 881 | 246:[] -> primIntAdd 0 246 882 | x:xs -> 20 883 | [] -> 10"; 884 | assert_eq!(execute_main(module.chars()), Some(VMResult::Int(20))); 885 | } 886 | #[test] 887 | fn local_function() { 888 | let module = 889 | r"main = 890 | let 891 | f x y = 892 | let 893 | g x = primIntAdd x y 894 | in g (primIntAdd 1 x) 895 | in f (primIntAdd 2 0) (primIntAdd 3 0)"; 896 | assert_eq!(execute_main(module.chars()), Some(VMResult::Int(6))); 897 | } 898 | 899 | #[test] 900 | fn test_data_types() 901 | { 902 | let module = 903 | r"data Bool = True | False 904 | 905 | test = False 906 | 907 | main = case test of 908 | False -> primIntAdd 0 0 909 | True -> primIntAdd 1 0"; 910 | assert_eq!(execute_main(module.chars()), Some(VMResult::Int(0))); 911 | } 912 | 913 | #[test] 914 | fn test_typeclasses_known_types() 915 | { 916 | let module = 917 | r"data Bool = True | False 918 | 919 | class Test a where 920 | test :: a -> Int 921 | 922 | instance Test Int where 923 | test x = x 924 | 925 | instance Test Bool where 926 | test x = case x of 927 | True -> 1 928 | False -> 0 929 | 930 | 931 | main = primIntSubtract (test (primIntAdd 5 0)) (test True)"; 932 | assert_eq!(execute_main(module.chars()), Some(VMResult::Int(4))); 933 | } 934 | 935 | #[test] 936 | fn test_typeclasses_unknown() 937 | { 938 | let module = 939 | r"data Bool = True | False 940 | 941 | class Test a where 942 | test :: a -> Int 943 | 944 | instance Test Int where 945 | test x = x 946 | 947 | instance Test Bool where 948 | test x = case x of 949 | True -> 1 950 | False -> 0 951 | 952 | testAdd y = primIntAdd (test (primIntAdd 5 0)) (test y) 953 | 954 | main = testAdd True"; 955 | assert_eq!(execute_main(module.chars()), Some(VMResult::Int(6))); 956 | } 957 | 958 | #[test] 959 | fn test_run_prelude() { 960 | let prelude = compile_file("Prelude.hs").unwrap(); 961 | let assembly = { 962 | let mut type_env = TypeEnvironment::new(); 963 | 964 | compile_with_type_env(&mut type_env, &[&prelude], 965 | r"add x y = primIntAdd x y 966 | main = foldl add 0 [1,2,3,4]").unwrap() 967 | }; 968 | 969 | let mut vm = VM::new(); 970 | vm.add_assembly(prelude); 971 | vm.add_assembly(assembly); 972 | let x = vm.assembly.iter().flat_map(|a| a.super_combinators.iter()).find(|sc| sc.name.name == intern("main")); 973 | let result = match x { 974 | Some(sc) => { 975 | assert!(sc.arity == 0); 976 | let result = vm.evaluate(&*sc.instructions, sc.assembly_id); 977 | extract_result(result) 978 | } 979 | None => None 980 | }; 981 | assert_eq!(result, Some(VMResult::Int(10))); 982 | } 983 | 984 | #[test] 985 | fn instance_super_class() { 986 | let prelude = compile_file("Prelude.hs").unwrap(); 987 | 988 | let assembly = { 989 | let mut type_env = TypeEnvironment::new(); 990 | compile_with_type_env(&mut type_env, &[&prelude], "main = [primIntAdd 0 1,2,3,4] == [1,2,3]").unwrap() 991 | }; 992 | 993 | let mut vm = VM::new(); 994 | vm.add_assembly(prelude); 995 | vm.add_assembly(assembly); 996 | let x = vm.assembly.iter().flat_map(|a| a.super_combinators.iter()).find(|sc| sc.name.name == intern("main")); 997 | let result = match x { 998 | Some(sc) => { 999 | assert!(sc.arity == 0); 1000 | let result = vm.evaluate(&*sc.instructions, sc.assembly_id); 1001 | extract_result(result) 1002 | } 1003 | None => None 1004 | }; 1005 | assert_eq!(result, Some(VMResult::Constructor(1, Vec::new()))); 1006 | } 1007 | 1008 | #[test] 1009 | fn monad_do() { 1010 | let prelude = compile_file("Prelude.hs").unwrap(); 1011 | 1012 | let assembly = { 1013 | let mut type_env = TypeEnvironment::new(); 1014 | compile_with_type_env(&mut type_env, &[&prelude], 1015 | " 1016 | test :: Maybe Int -> Maybe Int -> Maybe Int 1017 | test x y = do 1018 | x1 <- x 1019 | y 1020 | return (x1 + 1) 1021 | 1022 | main = test (Just 4) (Just 6)").unwrap() 1023 | }; 1024 | 1025 | let mut vm = VM::new(); 1026 | vm.add_assembly(prelude); 1027 | vm.add_assembly(assembly); 1028 | let x = vm.assembly.iter().flat_map(|a| a.super_combinators.iter()).find(|sc| sc.name.name == intern("main")); 1029 | let result = match x { 1030 | Some(sc) => { 1031 | assert!(sc.arity == 0); 1032 | let result = vm.evaluate(&*sc.instructions, sc.assembly_id); 1033 | extract_result(result) 1034 | } 1035 | None => None 1036 | }; 1037 | assert_eq!(result, Some(VMResult::Constructor(0, vec!(VMResult::Int(5))))); 1038 | } 1039 | 1040 | #[test] 1041 | fn import() { 1042 | let result = execute_main_module("Test"); 1043 | assert_eq!(result, Ok(Some(VMResult::Int(6)))); 1044 | } 1045 | 1046 | #[test] 1047 | fn pattern_bind() { 1048 | let result = execute_main_string( 1049 | r" 1050 | import Prelude 1051 | 1052 | test :: [Bool] -> Bool 1053 | test (True:[]) = False 1054 | test (True:y:ys) = y 1055 | test [] = False 1056 | 1057 | main = test [True, True] 1058 | ") 1059 | .unwrap(); 1060 | assert_eq!(result, Some(VMResult::Constructor(0, Vec::new()))); 1061 | } 1062 | #[test] 1063 | fn pattern_guards() { 1064 | let result = execute_main_string( 1065 | r" 1066 | import Prelude 1067 | 1068 | test :: Int -> [a] -> Int 1069 | test 2 _ = 2 1070 | test x [] 1071 | | primIntLT x 0 = primIntSubtract 0 1 1072 | | primIntGT x 0 = 1 1073 | test x _ = x 1074 | 1075 | main = (test 2 [], test 100 [], test 100 ['c']) 1076 | 1077 | ") 1078 | .unwrap(); 1079 | assert_eq!(result, Some(VMResult::Constructor(0, vec!(VMResult::Int(2), VMResult::Int(1), VMResult::Int(100))))); 1080 | } 1081 | 1082 | #[test] 1083 | fn pattern_guards_nested() { 1084 | let result = execute_main_string( 1085 | r" 1086 | import Prelude 1087 | 1088 | test :: Int -> [Int] -> Int 1089 | test 2 _ = 2 1090 | test x (0:[]) 1091 | | primIntLT x 0 = primIntSubtract 0 1 1092 | | primIntGT x 0 = 1 1093 | test x _ = x 1094 | 1095 | main = (test 2 [], test 100 [0], test 100 [0, 123]) 1096 | 1097 | ") 1098 | .unwrap(); 1099 | assert_eq!(result, Some(VMResult::Constructor(0, vec!(VMResult::Int(2), VMResult::Int(1), VMResult::Int(100))))); 1100 | } 1101 | #[test] 1102 | fn test_class_default_function() 1103 | { 1104 | let module = 1105 | r"data Bool = True | False 1106 | 1107 | class Test a where 1108 | test :: a -> Int 1109 | test _ = 42 1110 | test2 :: Int 1111 | 1112 | instance Test Int where 1113 | test x = x 1114 | test2 = 0 1115 | 1116 | instance Test Bool where 1117 | test2 = 2 1118 | 1119 | main = (test True, test (1 :: Int))"; 1120 | assert_eq!(execute_main(module.chars()), Some(VMResult::Constructor(0, vec![VMResult::Int(42), VMResult::Int(1)]))); 1121 | } 1122 | 1123 | #[test] 1124 | fn use_super_class() { 1125 | let result = execute_main_string( 1126 | r" 1127 | import Prelude 1128 | 1129 | test x y = (x == y) || (x < y) 1130 | main = (test (0 :: Int) 2) && not (test (1 :: Int) 0)") 1131 | .unwrap_or_else(|err| panic!("{:?}", err)); 1132 | assert_eq!(result, Some(VMResult::Constructor(0, Vec::new()))); 1133 | } 1134 | #[test] 1135 | fn implement_class() { 1136 | let result = execute_main_string( 1137 | r" 1138 | import Prelude 1139 | data AB = A | B 1140 | 1141 | instance Eq AB where 1142 | (==) A A = True 1143 | (==) B B = True 1144 | (==) _ _ = False 1145 | 1146 | test x y = x == y 1147 | 1148 | main = A == B && test A A") 1149 | .unwrap_or_else(|err| panic!("{:?}", err)); 1150 | assert_eq!(result, Some(VMResult::Constructor(1, Vec::new()))); 1151 | } 1152 | 1153 | #[test] 1154 | fn deriving_eq() { 1155 | let result = execute_main_string( 1156 | r" 1157 | import Prelude 1158 | data Test = A Int | B 1159 | deriving(Eq) 1160 | 1161 | main = A 0 == A 2 || A 0 == B 1162 | ").unwrap(); 1163 | assert_eq!(result, Some(VMResult::Constructor(1, Vec::new()))); 1164 | } 1165 | #[test] 1166 | fn deriving_ord() { 1167 | let result = execute_main_string( 1168 | r" 1169 | import Prelude 1170 | data Test = A Int | B 1171 | deriving(Eq, Ord) 1172 | 1173 | main = compare (A 0) (A 2) == LT && compare B (A 123) == GT 1174 | ").unwrap(); 1175 | assert_eq!(result, Some(VMResult::Constructor(0, Vec::new()))); 1176 | } 1177 | 1178 | #[test] 1179 | fn instance_eq_list() { 1180 | let result = execute_main_string( 1181 | r" 1182 | import Prelude 1183 | test x y = x == y 1184 | main = test [1 :: Int] [3] 1185 | ").unwrap(); 1186 | assert_eq!(result, Some(VMResult::Constructor(1, Vec::new()))); 1187 | } 1188 | #[test] 1189 | fn build_dictionary() { 1190 | //Test that the compiler can generate code to build a dictionary at runtime 1191 | let result = execute_main_string( 1192 | r" 1193 | import Prelude 1194 | test :: Eq a => a -> a -> Bool 1195 | test x y = [x] == [y] 1196 | main = test [1 :: Int] [3] 1197 | ").unwrap(); 1198 | assert_eq!(result, Some(VMResult::Constructor(1, Vec::new()))); 1199 | } 1200 | 1201 | #[test] 1202 | fn if_else() { 1203 | let result = execute_main_string( 1204 | r" 1205 | import Prelude 1206 | 1207 | main = let 1208 | x = 123 :: Int 1209 | in if x < 0 1210 | then x 1211 | else 1 1212 | ").unwrap(); 1213 | assert_eq!(result, Some(VMResult::Int(1))); 1214 | } 1215 | 1216 | #[test] 1217 | fn newtype() { 1218 | let result = execute_main_string( 1219 | r" 1220 | import Prelude 1221 | newtype Even = Even Int 1222 | 1223 | makeEven :: Int -> Maybe Even 1224 | makeEven i 1225 | | i `div` 2 /= (i - 1) `div` 2 = Just (Even i) 1226 | | otherwise = Nothing 1227 | 1228 | main = makeEven (100 * 3) 1229 | ").unwrap(); 1230 | 1231 | assert_eq!(result, Some(VMResult::Constructor(0, vec![VMResult::Int(300)]))); 1232 | } 1233 | 1234 | #[test] 1235 | fn where_bindings() { 1236 | let result = execute_main_string( 1237 | r" 1238 | import Prelude 1239 | 1240 | main = case list of 1241 | [] -> 123 1242 | x:xs 1243 | | y < 10 -> 0 1244 | | otherwise -> y 1245 | where 1246 | y = x + 10 1247 | where 1248 | list = [1::Int] 1249 | ").unwrap(); 1250 | assert_eq!(result, Some(VMResult::Int(11))); 1251 | } 1252 | 1253 | } 1254 | --------------------------------------------------------------------------------