├── prelude.er ├── src ├── Main.hs ├── Common.hs ├── REPL.hs ├── Parser.hs └── Interpreter.hs ├── .project-settings.yml ├── LICENSE ├── prelude └── list.er └── README.md /prelude.er: -------------------------------------------------------------------------------- 1 | (import prelude.list) 2 | 3 | (define factorial 4 | (lambda x 5 | (case x 6 | ((0 1) 7 | (_ (* x (factorial (- x 1)))))))) -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import qualified Data.Map as Map 4 | import REPL 5 | 6 | main :: IO () 7 | main = do putStrLn "Welcome to Erumpo REPL!" 8 | repl Map.empty 9 | -------------------------------------------------------------------------------- /.project-settings.yml: -------------------------------------------------------------------------------- 1 | binary-ghc-args: 2 | - -O 3 | - -threaded 4 | module-template: ! 'module MODULE_NAME where 5 | 6 | ' 7 | extensions: {} 8 | environment: ghc-7.8-stable-14.09 9 | auto-hidden: [] 10 | cabal-file: project.cabal 11 | version: 1 12 | extra-packages: '' 13 | ghc-args: [] 14 | excluded-modules: [] 15 | -------------------------------------------------------------------------------- /src/Common.hs: -------------------------------------------------------------------------------- 1 | module Common where 2 | 3 | import qualified Data.Map as Map 4 | 5 | data Dec = 6 | DefineDec Pat Exp 7 | | ImportDec String 8 | 9 | type Env = Map.Map String Val 10 | 11 | data Exp = 12 | ConstExp Val 13 | | VarExp String 14 | | LambdaExp Pat Exp 15 | | LetrecExp [(Pat,Exp)] Exp 16 | | IfExp Exp Exp Exp 17 | | CaseExp Exp [(Pat,Exp)] 18 | | AppExp Exp Exp 19 | | ADTExp String [Exp] 20 | | UnaryOpExp String Exp 21 | | BinaryOpExp String Exp Exp 22 | 23 | data Val = 24 | UnitVal 25 | | BoolVal Bool 26 | | IntVal Integer 27 | | FloatVal Float 28 | | CharVal Char 29 | | ClosureVal Pat Exp Env 30 | | ADTVal String [Val] 31 | 32 | data Pat = 33 | NilPat 34 | | ConstPat Val 35 | | VarPat String 36 | | ADTPat String [Pat] 37 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015, Shao Cheng 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 5 | 6 | 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 7 | 8 | 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 9 | 10 | 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. 11 | 12 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /prelude/list.er: -------------------------------------------------------------------------------- 1 | (define append 2 | (lambda x_lst 3 | (lambda y_lst 4 | (case x_lst 5 | ((nil y_lst) 6 | ((Cons x_car x_cdr) (Cons x_car ((append x_cdr) y_lst)))))))) 7 | 8 | (define head 9 | (lambda (Cons car _) 10 | car)) 11 | 12 | (define tail 13 | (lambda (Cons _ cdr) 14 | cdr)) 15 | 16 | (define last 17 | (lambda lst 18 | (case lst 19 | (((Cons car nil) car) 20 | ((Cons _ cdr) (last cdr)))))) 21 | 22 | (define init 23 | (lambda lst 24 | (case lst 25 | (((Cons car nil) nil) 26 | ((Cons car cdr) (Cons car (init cdr))))))) 27 | 28 | (define null 29 | (lambda lst 30 | (case lst 31 | ((nil true) 32 | (_ false))))) 33 | 34 | (define length 35 | (lambda lst 36 | (case lst 37 | ((nil 0) 38 | ((Cons _ cdr) (+ 1 (length cdr))))))) 39 | 40 | (define map 41 | (lambda f 42 | (lambda lst 43 | (case lst 44 | ((nil nil) 45 | ((Cons car cdr) (Cons (f car) ((map f) cdr)))))))) 46 | 47 | (define reverse 48 | (lambda lst 49 | (case lst 50 | ((nil nil) 51 | ((Cons car cdr) ((append (reverse cdr)) (Cons car nil))))))) 52 | 53 | (define foldl 54 | (lambda f 55 | (lambda left 56 | (lambda lst 57 | (case lst 58 | ((nil left) 59 | ((Cons car cdr) (((foldl f) ((f left) car)) cdr)))))))) 60 | (define foldr 61 | (lambda f 62 | (lambda right 63 | (lambda lst 64 | (case lst 65 | ((nil right) 66 | ((Cons car cdr) (((foldr f) ((f car) right)) cdr)))))))) 67 | 68 | (define filter 69 | (lambda f 70 | (lambda lst 71 | (case lst 72 | ((nil nil) 73 | ((Cons car cdr) (if (f car) (Cons car ((filter f) cdr)) ((filter f) cdr)))))))) 74 | 75 | (define take 76 | (lambda n 77 | (lambda lst 78 | (case n 79 | ((0 nil) 80 | (_ (case lst 81 | ((nil nil) 82 | ((Cons car cdr) (Cons car ((take (- n 1)) cdr))))))))))) 83 | 84 | (define drop 85 | (lambda n 86 | (lambda lst 87 | (case n 88 | ((0 lst) 89 | (_ (case lst 90 | ((nil nil) 91 | ((Cons _ cdr) ((drop (- n 1)) cdr)))))))))) -------------------------------------------------------------------------------- /src/REPL.hs: -------------------------------------------------------------------------------- 1 | module REPL where 2 | 3 | import Common 4 | import Control.Monad 5 | import qualified Data.Map as Map 6 | import Interpreter 7 | import Parser 8 | import System.IO 9 | 10 | type PEnv = Map.Map Pat Exp 11 | 12 | readprogs :: [String] -> IO PEnv 13 | readprogs [] = return Map.empty 14 | readprogs (p:ps) = do penv <- readprog p 15 | penvs <- readprogs ps 16 | return (Map.union penvs penv) 17 | 18 | fromimp :: Dec -> String 19 | fromimp (ImportDec path) = path 20 | fromimp _ = error "type error" 21 | 22 | readprog :: String -> IO PEnv 23 | readprog path = do handle <- openFile path ReadMode 24 | contents <- hGetContents handle 25 | case parse (star (do whitespace 26 | imp <- importdec 27 | return imp)) contents of 28 | Just (imps,remain) -> do penv <- readprogs (map fromimp imps) 29 | case parse (do decs <- star (do whitespace 30 | dec <- definedec 31 | return dec) 32 | whitespace 33 | return decs) remain of 34 | Just (decs,[]) -> return (foldl (\penv (DefineDec p e)->Map.insert p e penv) penv decs) 35 | Just (_,_) -> error "syntax error" 36 | 37 | repl :: PEnv -> IO () 38 | repl env = do putStr "λ >>> " 39 | s <- getLine 40 | case parse (do whitespace 41 | imp <- importdec 42 | whitespace 43 | return imp) s of 44 | Just (ImportDec path,[]) -> do nenv <- readprog path 45 | putStrLn ("Successfully imported "++(show (Map.size nenv))++" entries from "++path++".") 46 | repl (Map.union nenv env) 47 | Just (ImportDec _,_) -> do putStrLn "Invalid import declaration." 48 | repl env 49 | Nothing -> case parse (do whitespace 50 | dec <- definedec 51 | whitespace 52 | return dec) s of 53 | Just (DefineDec p e,[]) -> do putStrLn "Successfully defined 1 entry." 54 | repl (Map.insert p e env) 55 | Just (DefineDec _ _,_) -> do putStrLn "Invalid define declaration." 56 | repl env 57 | Nothing -> case parse (do whitespace 58 | e <- expr 59 | whitespace 60 | return e) s of 61 | Just (e,[]) -> case eval (LetrecExp (Map.toList env) e) Map.empty of 62 | Just v -> do print v 63 | repl env 64 | Nothing -> do putStrLn "Error while evaluation." 65 | repl env 66 | _ -> do putStrLn "Invalid expression." 67 | repl env 68 | -------------------------------------------------------------------------------- /src/Parser.hs: -------------------------------------------------------------------------------- 1 | module Parser where 2 | 3 | import Common 4 | import Control.Monad 5 | import Data.Char 6 | 7 | newtype Parser a = Parser (String -> Maybe (a,String)) 8 | 9 | parse :: Parser a -> String -> Maybe (a,String) 10 | parse (Parser p) inp = p inp 11 | 12 | instance Monad Parser where 13 | return v = Parser (\inp -> Just (v,inp)) 14 | p >>= f = Parser (\inp -> do (v,s) <- parse p inp 15 | parse (f v) s) 16 | 17 | instance MonadPlus Parser where 18 | mzero = Parser (\_ -> Nothing) 19 | mplus p q = Parser (\inp -> case parse p inp of 20 | Just result -> Just result 21 | Nothing -> parse q inp) 22 | 23 | listplus :: [Parser a] -> Parser a 24 | listplus lst = foldr mplus mzero lst 25 | 26 | failure :: Parser a 27 | failure = mzero 28 | 29 | item :: Parser Char 30 | item = Parser (\inp -> case inp of 31 | (c:cs) -> return (c,cs) 32 | [] -> Nothing) 33 | 34 | sat :: (Char -> Bool) -> Parser Char 35 | sat p = do x <- item 36 | if p x then return x else failure 37 | 38 | char :: Char -> Parser Char 39 | char x = sat (== x) 40 | 41 | string :: String -> Parser String 42 | string [] = return [] 43 | string (c:cs) = do char c 44 | string cs 45 | return (c:cs) 46 | 47 | star :: Parser a -> Parser [a] 48 | star p = mplus (plus p) (return []) 49 | 50 | plus :: Parser a -> Parser [a] 51 | plus p = do x <- p 52 | xs <- star p 53 | return (x:xs) 54 | 55 | nat :: Parser Integer 56 | nat = do xs <- plus (sat isDigit) 57 | return (read xs) 58 | 59 | int :: Parser Integer 60 | int = mplus nat (do char '-' 61 | x <- nat 62 | return (-x)) 63 | 64 | float :: Parser Float 65 | float = do x <- int 66 | char '.' 67 | y <- nat 68 | return (read ((show x)++"."++(show y))) 69 | 70 | whitespace :: Parser () 71 | whitespace = do star (sat isSpace) 72 | return () 73 | 74 | unitval :: Parser Val 75 | unitval = do string "nil" 76 | return UnitVal 77 | 78 | boolval :: Parser Val 79 | boolval = do s <- mplus (string "false") (string "true") 80 | case s of 81 | "false" -> return (BoolVal False) 82 | "true" -> return (BoolVal True) 83 | 84 | intval :: Parser Val 85 | intval = do x <- int 86 | return (IntVal x) 87 | 88 | floatval :: Parser Val 89 | floatval = do x <- float 90 | return (FloatVal x) 91 | 92 | charval :: Parser Val 93 | charval = do char '\'' 94 | c <- item 95 | char '\'' 96 | return (CharVal c) 97 | 98 | consname :: Parser String 99 | consname = do c <- sat isUpper 100 | cs <- star (mplus (sat isAlphaNum) (char '_')) 101 | return (c:cs) 102 | 103 | adtval :: Parser Val 104 | adtval = do char '(' 105 | whitespace 106 | cons <- consname 107 | vals <- star (do whitespace 108 | e <- val 109 | return e) 110 | whitespace 111 | char ')' 112 | return (ADTVal cons vals) 113 | 114 | strval :: Parser Val 115 | strval = do char '"' 116 | cs <- star (sat (/= '"')) 117 | char '"' 118 | let f [] = UnitVal 119 | f (c:s) = (ADTVal "Cons" [CharVal c,f s]) 120 | in return (f cs) 121 | 122 | val :: Parser Val 123 | val = listplus [unitval,boolval,floatval,intval,charval,adtval,strval] 124 | 125 | constexp :: Parser Exp 126 | constexp = do v <- val 127 | return (ConstExp v) 128 | 129 | varname :: Parser String 130 | varname = do c <- sat isLower 131 | cs <- star (mplus (sat isAlphaNum) (char '_')) 132 | return (c:cs) 133 | 134 | varexp :: Parser Exp 135 | varexp = do s <- varname 136 | return (VarExp s) 137 | 138 | pat2exp :: Pat -> Exp 139 | pat2exp (ConstPat v) = ConstExp v 140 | pat2exp (VarPat v) = VarExp v 141 | pat2exp (ADTPat c ps) = ADTExp c (map pat2exp ps) 142 | 143 | plambdaexp :: Parser Exp 144 | plambdaexp = do char '(' 145 | whitespace 146 | string "lambda" 147 | ps <- plus (do whitespace 148 | p <- pat 149 | return p) 150 | whitespace 151 | char ')' 152 | let f [] = (LambdaExp NilPat e) 153 | f (p:[]) = (LambdaExp p e) 154 | f (p:ps) = (LambdaExp p (f ps)) 155 | e = pat2exp (last ps) 156 | in return (f (init ps)) 157 | 158 | lambdaexp :: Parser Exp 159 | lambdaexp = do char '(' 160 | whitespace 161 | string "lambda" 162 | ps <- plus (do whitespace 163 | p <- pat 164 | return p) 165 | whitespace 166 | e <- expr 167 | whitespace 168 | char ')' 169 | let f [] = (LambdaExp NilPat e) 170 | f (p:[]) = (LambdaExp p e) 171 | f (p:ps) = (LambdaExp p (f ps)) 172 | in (return (f ps)) 173 | 174 | definedec :: Parser Dec 175 | definedec = do char '(' 176 | whitespace 177 | string "define" 178 | whitespace 179 | p <- pat 180 | whitespace 181 | e <- expr 182 | whitespace 183 | char ')' 184 | return (DefineDec p e) 185 | 186 | importdec :: Parser Dec 187 | importdec = do char '(' 188 | whitespace 189 | string "import" 190 | whitespace 191 | s <- star (mplus (sat isAlphaNum) (char '.')) 192 | whitespace 193 | char ')' 194 | let f '.' = '/' 195 | f c = c 196 | in return (ImportDec ((map f s)++".er")) 197 | 198 | patexp :: Parser (Pat,Exp) 199 | patexp = do char '(' 200 | whitespace 201 | p <- pat 202 | whitespace 203 | e <- expr 204 | whitespace 205 | char ')' 206 | return (p,e) 207 | 208 | patexps :: Parser [(Pat,Exp)] 209 | patexps = do char '(' 210 | pes <- star (do whitespace 211 | pe <- patexp 212 | return pe) 213 | whitespace 214 | char ')' 215 | return pes 216 | 217 | letrecexp :: Parser Exp 218 | letrecexp = do char '(' 219 | whitespace 220 | string "letrec" 221 | whitespace 222 | pes <- patexps 223 | whitespace 224 | e <- expr 225 | whitespace 226 | char ')' 227 | return (LetrecExp pes e) 228 | 229 | ifexp :: Parser Exp 230 | ifexp = do char '(' 231 | whitespace 232 | string "if" 233 | whitespace 234 | cond_exp <- expr 235 | whitespace 236 | then_exp <- expr 237 | whitespace 238 | else_exp <- expr 239 | whitespace 240 | char ')' 241 | return (IfExp cond_exp then_exp else_exp) 242 | 243 | caseexp :: Parser Exp 244 | caseexp = do char '(' 245 | whitespace 246 | string "case" 247 | whitespace 248 | case_exp <- expr 249 | whitespace 250 | pes <- patexps 251 | whitespace 252 | char ')' 253 | return (CaseExp case_exp pes) 254 | 255 | appexp :: Parser Exp 256 | appexp = do char '(' 257 | whitespace 258 | f_exp <- expr 259 | es <- star (do whitespace 260 | e <- expr 261 | return e) 262 | whitespace 263 | char ')' 264 | let f [] acc = AppExp acc (ConstExp UnitVal) 265 | f (e:[]) acc = AppExp acc e 266 | f (e:es) acc = AppExp (f es acc) e 267 | in return (f (reverse es) f_exp) 268 | 269 | adtexp :: Parser Exp 270 | adtexp = do char '(' 271 | whitespace 272 | cons <- consname 273 | exps <- star (do whitespace 274 | e <- expr 275 | return e) 276 | whitespace 277 | char ')' 278 | return (ADTExp cons exps) 279 | 280 | unaryopexp :: Parser Exp 281 | unaryopexp = do char '(' 282 | whitespace 283 | op <- listplus (map string ["!","print","eval"]) 284 | whitespace 285 | e <- expr 286 | whitespace 287 | char ')' 288 | return (UnaryOpExp op e) 289 | 290 | binaryopexp :: Parser Exp 291 | binaryopexp = do char '(' 292 | whitespace 293 | op <- listplus (map string ["&&","||","==","!=","<=","<",">=",">","+","-","*"]) 294 | whitespace 295 | x <- expr 296 | whitespace 297 | y <- expr 298 | whitespace 299 | char ')' 300 | return (BinaryOpExp op x y) 301 | 302 | listexp :: Parser Exp 303 | listexp = do char '[' 304 | whitespace 305 | es <- star (do whitespace 306 | e <- expr 307 | return e) 308 | whitespace 309 | char ']' 310 | let f [] = (ConstExp UnitVal) 311 | f (e:es) = (ADTExp "Cons" [e,(f es)]) 312 | in return (f es) 313 | 314 | nilpat :: Parser Pat 315 | nilpat = do char '_' 316 | return NilPat 317 | 318 | constpat :: Parser Pat 319 | constpat = do v <- val 320 | return (ConstPat v) 321 | 322 | varpat :: Parser Pat 323 | varpat = do s <- varname 324 | return (VarPat s) 325 | 326 | adtpat :: Parser Pat 327 | adtpat = do char '(' 328 | whitespace 329 | cons <- consname 330 | pats <- star (do whitespace 331 | p <- pat 332 | return p) 333 | whitespace 334 | char ')' 335 | return (ADTPat cons pats) 336 | 337 | pat :: Parser Pat 338 | pat = listplus [nilpat,constpat,varpat,adtpat] 339 | 340 | expr :: Parser Exp 341 | expr = listplus [constexp,varexp,unaryopexp,binaryopexp,lambdaexp,plambdaexp,letrecexp,ifexp,caseexp,appexp,adtexp,listexp] -------------------------------------------------------------------------------- /src/Interpreter.hs: -------------------------------------------------------------------------------- 1 | module Interpreter where 2 | 3 | import Common 4 | import qualified Data.Map as Map 5 | import Data.Maybe 6 | import Debug.Trace 7 | import Parser 8 | 9 | instance Eq Val where 10 | UnitVal == UnitVal = True 11 | (BoolVal x) == (BoolVal y) = x == y 12 | (IntVal x) == (IntVal y) = x == y 13 | (FloatVal x) == (FloatVal y) = x == y 14 | (IntVal x) == (FloatVal y) = (fromIntegral x) == y 15 | (FloatVal x) == (IntVal y) = x == (fromIntegral y) 16 | (CharVal x) == (CharVal y) = x == y 17 | (ADTVal x_adt x_val_list) == (ADTVal y_adt y_val_list) = (x_adt == y_adt) && (and [x==y|(x,y)<-zip x_val_list y_val_list]) 18 | _ == _ = False 19 | 20 | instance Ord Val where 21 | compare UnitVal UnitVal = EQ 22 | compare UnitVal _ = LT 23 | compare _ UnitVal = GT 24 | compare (BoolVal x) (BoolVal y) = compare x y 25 | compare (IntVal x) (IntVal y) = compare x y 26 | compare (FloatVal x) (FloatVal y) = compare x y 27 | compare (IntVal x) (FloatVal y) = compare (fromIntegral x) y 28 | compare (FloatVal x) (IntVal y) = compare x (fromIntegral y) 29 | compare (CharVal x) (CharVal y) = compare x y 30 | compare (ADTVal x_cons x_val_list) (ADTVal y_cons y_val_list) = 31 | if x_cons == y_cons 32 | then 33 | case x_val_list of 34 | [] -> 35 | case y_val_list of 36 | [] -> EQ 37 | _ -> error "type error" 38 | (x:xs) -> 39 | case y_val_list of 40 | (y:ys) -> 41 | case compare x y of 42 | LT -> LT 43 | GT -> GT 44 | EQ -> compare (ADTVal "" xs) (ADTVal "" ys) 45 | [] -> error "type error" 46 | else error "type error" 47 | compare _ _ = error "type error" 48 | 49 | instance Show Val where 50 | show UnitVal = "nil" 51 | show (BoolVal False) = "false" 52 | show (BoolVal True) = "true" 53 | show (IntVal x) = show x 54 | show (FloatVal x) = show x 55 | show (CharVal x) = show x 56 | show (ClosureVal _ _ _) = "__closure__" 57 | show (ADTVal cons_name val_list) = case getString (ADTVal cons_name val_list) of 58 | Just s -> "\"" ++ s ++ "\"" 59 | Nothing -> case getList (ADTVal cons_name val_list) of 60 | Just [] -> "nil" 61 | Just (car:cdr) -> "[" ++ (show car) ++ (foldr (++) "" [" "++(show val)|val<-cdr]) ++ "]" 62 | Nothing -> "(" ++ cons_name ++ (foldr (++) "" [" "++(show val)|val<-val_list]) ++ ")" 63 | 64 | instance Eq Pat where 65 | NilPat == NilPat = True 66 | (ConstPat x) == (ConstPat y) = (x == y) 67 | (VarPat x) == (VarPat y) = (x == y) 68 | (ADTPat cons0 pats0) == (ADTPat cons1 pats1) = (cons0 == cons1) && (pats0 == pats1) 69 | _ == _ = False 70 | 71 | instance Ord Pat where 72 | compare NilPat NilPat = EQ 73 | compare NilPat _ = LT 74 | compare (ConstPat _) NilPat = GT 75 | compare (ConstPat x) (ConstPat y) = compare x y 76 | compare (ConstPat _) _ = LT 77 | compare (VarPat _) NilPat = GT 78 | compare (VarPat _) (ConstPat _) = GT 79 | compare (VarPat x) (VarPat y) = compare x y 80 | compare (VarPat _) _ = LT 81 | compare (ADTPat cons0 pats0) (ADTPat cons1 pats1) = compare (cons0,pats0) (cons1,pats1) 82 | compare (ADTPat _ _) _ = GT 83 | 84 | getBool :: Val -> Maybe Bool 85 | getBool (BoolVal x) = return x 86 | getBool _ = Nothing 87 | 88 | getClosure :: Val -> Maybe Val 89 | getClosure (ClosureVal pat exp env) = return (ClosureVal pat exp env) 90 | getClosure _ = Nothing 91 | 92 | getString :: Val -> Maybe String 93 | getString UnitVal = return "" 94 | getString (ADTVal "Cons" [CharVal car,cdr]) = do cs <- getString cdr 95 | return (car:cs) 96 | getString _ = Nothing 97 | 98 | getList :: Val -> Maybe [Val] 99 | getList UnitVal = return [] 100 | getList (ADTVal "Cons" [car,cdr]) = do cdr_list <- getList cdr 101 | return (car:cdr_list) 102 | getList _ = Nothing 103 | 104 | match :: Pat -> Val -> Maybe Env 105 | match NilPat _ = Just Map.empty 106 | match (ConstPat pval) val = if pval == val then Just (Map.empty) else Nothing 107 | match (VarPat var) val = Just (Map.singleton var val) 108 | match (ADTPat pname plist) (ADTVal vname vlist) = 109 | let merge Nothing _ = Nothing 110 | merge _ Nothing = Nothing 111 | merge (Just env0) (Just env1) = Just (Map.union env0 env1) 112 | in if pname == vname then (foldl merge (Just Map.empty) [match p v|(p,v)<-zip plist vlist]) else Nothing 113 | 114 | eval :: Exp -> Env -> Maybe Val 115 | eval (ConstExp val) _ = Just val 116 | eval (VarExp var) env = Map.lookup var env 117 | eval (LambdaExp pat exp) env = Just (ClosureVal pat exp env) 118 | eval (LetrecExp pat_exp_list exp) env = 119 | let new_env = Map.union delta_env env 120 | Just delta_env = match (ADTPat "" pat_list) (ADTVal "" val_list) 121 | pat_list = [p|(p,_)<-pat_exp_list] 122 | val_list = [fromJust (eval e new_env)|(_,e)<-pat_exp_list] 123 | in eval exp new_env 124 | eval (IfExp cond_exp then_exp else_exp) env = 125 | do 126 | cond_val <- eval cond_exp env 127 | flag <- getBool cond_val 128 | if flag then eval then_exp env else eval else_exp env 129 | eval (CaseExp exp pat_exp_list) env = 130 | do 131 | val <- eval exp env 132 | let f [] = Nothing 133 | f ((p,e):p_e_list) = 134 | case match p val of 135 | Just delta_env -> eval e (Map.union delta_env env) 136 | Nothing -> f p_e_list 137 | in f pat_exp_list 138 | eval (AppExp f_exp x_exp) env = 139 | do 140 | f_val <- eval f_exp env 141 | (ClosureVal c_pat c_exp c_env) <- getClosure f_val 142 | x_val <- eval x_exp env 143 | delta_env <- match c_pat x_val 144 | eval c_exp (Map.union delta_env c_env) 145 | eval (ADTExp cons_name exp_list) env = 146 | let f [] = Just [] 147 | f (e:es) = 148 | do 149 | val <- eval e env 150 | vals <- f es 151 | return (val:vals) 152 | in 153 | do 154 | vals <- f exp_list 155 | return (ADTVal cons_name vals) 156 | 157 | eval (UnaryOpExp op x_exp) env = do x_val <- eval x_exp env 158 | case op of 159 | "!" -> do flag <- getBool x_val 160 | return (BoolVal (not flag)) 161 | "print" -> let s = case getString x_val of 162 | Just bs -> bs 163 | Nothing -> show x_val 164 | in trace s (return UnitVal) 165 | "eval" -> do s <- getString x_val 166 | (e,_) <- parse expr s 167 | eval e env 168 | _ -> Nothing 169 | 170 | eval (BinaryOpExp op x_exp y_exp) env = 171 | do 172 | x_val <- eval x_exp env 173 | y_val <- eval y_exp env 174 | if elem op ["&&","||"] 175 | then 176 | do 177 | x_flag <- getBool x_val 178 | y_flag <- getBool y_val 179 | let f = (Map.fromList [("&&",(&&)),("||",(||))]) Map.! op in return (BoolVal (f x_flag y_flag)) 180 | else 181 | if elem op ["==","!=","<","<=",">",">="] 182 | then 183 | let f = (Map.fromList [("==",(==)),("!=",(/=)),("<",(<)),("<=",(<=)),(">",(>)),(">=",(>=))]) Map.! op in return (BoolVal (f x_val y_val)) 184 | else 185 | if elem op ["+","-","*"] 186 | then 187 | case x_val of 188 | (IntVal x_int) -> case y_val of 189 | (IntVal y_int) -> return (IntVal (((Map.fromList [("+",(+)),("-",(-)),("*",(*))]) Map.! op) x_int y_int)) 190 | (FloatVal y_float) -> return (FloatVal (((Map.fromList [("+",(+)),("-",(-)),("*",(*))]) Map.! op) (fromIntegral x_int) y_float)) 191 | _ -> Nothing 192 | (FloatVal x_float) -> case y_val of 193 | (IntVal y_int) -> return (FloatVal (((Map.fromList [("+",(+)),("-",(-)),("*",(*))]) Map.! op) x_float (fromIntegral y_int))) 194 | (FloatVal y_float) -> return (FloatVal (((Map.fromList [("+",(+)),("-",(-)),("*",(*))]) Map.! op) x_float y_float)) 195 | _ -> Nothing 196 | _ -> Nothing 197 | else if op == "/" 198 | then case y_val of 199 | (IntVal 0) -> Nothing 200 | (FloatVal 0) -> Nothing 201 | (IntVal y_int) -> case x_val of 202 | (IntVal x_int) -> return (FloatVal ((fromIntegral x_int)/(fromIntegral y_int))) 203 | (FloatVal x_float) -> return (FloatVal (x_float/(fromIntegral y_int))) 204 | _ -> Nothing 205 | (FloatVal y_float) -> case x_val of 206 | (IntVal x_int) -> return (FloatVal ((fromIntegral x_int)/y_float)) 207 | (FloatVal x_float) -> return (FloatVal (x_float/y_float)) 208 | _ -> Nothing 209 | _ -> Nothing 210 | else Nothing 211 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # The Erumpo Programming Language 2 | 3 | ## Introduction 4 | 5 | Erumpo is a lisp dialect which intends to be both expressive and performant. Currently, the following features are implemented: 6 | 7 | - A monadic parser and REPL in Haskell, as the reference implementation of the language 8 | - S-exp syntax, call-by-value semantics 9 | - Primitive types and operators 10 | - First-class functions (closures) 11 | - Algebraic Data Types and Pattern Matching 12 | - `eval` expressions on strings, mechanism for run-time metaprogramming 13 | - A module system with `import` declarations 14 | 15 | The following features are still missing and will be implemented in this year: 16 | 17 | - Proper error propagation, providing useful compile-time/run-time error information 18 | - Type system 19 | - First-class continuations/Tail-call optimization 20 | - Type-safe compile-time metaprogramming via macros 21 | - A bytecode virtual machine, possibly with LLVM backend 22 | - Foreign Function Interface, multithreading facilities, etc 23 | 24 | ## Quick Start 25 | 26 | Use `ghc` to compile the `Main` module, or invoke the `main` IO action in the `Main` module under `ghci`. You will see the following message: 27 | 28 | Welcome to Erumpo REPL! 29 | λ >>> 30 | 31 | Under the Erumpo REPL, you can repeatedly type declarations/expressions and check the output. 32 | 33 | Erumpo is a purely functional language. Evaluating an expression does not change the top-level environment. In order to introduce top-level bindings, you can use a `define` declaration. 34 | 35 | Currently the REPL is the only way to run Erumpo programs. You may put the declarations of a long Erumpo program into a file with `.er` extension, and put it in the current directory. Then you can use an `import` declaration to import the declarations and reuse the program. 36 | 37 | ## Declarations 38 | 39 | In Erumpo, declarations are separated from expressions. Declarations are executed, produces some side-effects (like modifying the top-level environment), and do not return a value. Also, in an Erumpo program, there can only be declarations; naked top-level expressions are invalid. 40 | 41 | ### `define` Declarations 42 | 43 | A `define` declaration introduces top-level bindings. It has the following syntax: 44 | 45 | (define pat exp) 46 | 47 | Where `pat` is a pattern and `exp` is an expression. It means pattern matching `pat` to `exp` and if succeeds, create the appropriate top-level bindings. 48 | 49 | Examples: 50 | 51 | (define k 2) 52 | (define (Tuple x y) (Tuple 3 5)) 53 | 54 | When a `define` declaration is executed, `exp` is not immediately evaluated. Instead, it is saved and only evaluated when later evaluating an expression under REPL. When `pat` conflicts with an earlier identical `pat`, the earlier one will be overwritten. 55 | 56 | ### `import` Declarations 57 | 58 | An `import` declaration imports declarations from an Erumpo program. It has the following syntax: 59 | 60 | (import module_name) 61 | 62 | For example, `(import prelude)` means importing `prelude.er`, `(import prelude.list)` means importing `prelude/list.er`. 63 | 64 | You might want to `(import prelude)`, which loads the standard library. 65 | 66 | Nested imports are allowed; a valid Erumpo program can contain a list of `import` declarations following a list of `define` declarations. Later imports can shadow earlier imports, as in `define`'s case. 67 | 68 | Currently cyclic imports are not detected and may result in stack overflow. 69 | 70 | ## Expressions 71 | 72 | ### Overview 73 | 74 | In Erumpo, an expression is evaluated with call-by-value semantics and yields a value. Values are distinct from expressions; they can be regarded as normal forms of expressions which cannot be further reduced. 75 | 76 | An expression is evaluated in an environment. A environment is a set of bindings, which maps variable names to values. 77 | 78 | ### Primitive Types & Constant Expressions 79 | 80 | - A value of `Unit` type: `nil` 81 | - A value of `Bool` type : `true`/`false` 82 | - A value of `Int` type: `42` 83 | - A value of `Float` type: `0.1` 84 | - A value of `Char` type: `'c'` 85 | 86 | Note that the `Int` type supports arbitrarily large integers. 87 | 88 | We also have a string type, which is internally a list of `Char`. A string literal can be written as `"233"`. The list type is explained below. 89 | 90 | ### ADT Expressions & Pattern Matching 91 | 92 | We also have Algebraic Data Types. An ADT has one or more constructors; each constructor has a constructor name and takes a list of values. For example, the list type may be either `nil` or `(Cons car cdr)`, where `car` is the head element and `cdr` is another list. The constructor name must begin with an uppercase letter. 93 | 94 | An ADT expression has the following form: 95 | 96 | (Cons_name exp0 exp1 ..) 97 | 98 | When evaluated, `exp0`, `exp1` ... are evaluated in order, and the resulting values are used to created an ADT value with the `Cons_name` constructor. 99 | 100 | There is a syntactic sugar for writing lists: 101 | 102 | [exp0 exp1 ..] 103 | 104 | The notation is equivalent to `(Cons exp0 (Cons exp1 ..))`. 105 | 106 | Pattern matching is provided for handy manipulation of ADT. Pattern matching may occur under several circumstances; its semantics is to match a pattern with a value, and if succeeds, return an environment. There are several kinds of patterns: 107 | 108 | - Empty Pattern: `_`, matches any value, create no binding 109 | - Constant Pattern: `val`, matches any value equal to `val`, create no binding 110 | - Variable Pattern: `x`, matches any value `val`, create the binding from `x` to `val` 111 | - ADT Pattern: `(Cons_name pat0 pat1 ..)`, recursively matches an ADT value with constructor `Cons_name`, create bindings combined from results of matching `pat0`, `pat1`, etc. If any sub-pattern fails to match, the entire match fails. 112 | 113 | Currently there lacks a type checker, so it is up to the programmer to enforce the typing conventions, for example, every constructor must take a fixed number of values; violating the contract is non-standard behavior. 114 | 115 | ### Variable Expressions 116 | 117 | A variable expression is simply the variable's name, like `x` or `f`. The variable's name must begin with a lowercase letter to distinguish it from a constructor. Evaluating a variable expression under an environment simply fetches the value if the binding exists, otherwise the evaluation fails. 118 | 119 | ### `lambda` Expressions & Application Expressions 120 | 121 | A `lambda` expression denotes an anonymous function. Its syntax is as follows: 122 | 123 | (lambda pat0 pat1 .. exp) 124 | 125 | When evaluated, `pat0`, `pat1`, .. , `exp` and the current environment are all encapsulated into a closure value. 126 | 127 | An application expression applies a function to its parameter. Its syntax is as follows: 128 | 129 | (f_exp exp0 exp1 ..) 130 | 131 | When evaluated, `f_exp` is evaluated to get a closure value; then `exp0`, `exp1`, .. are evaluated to get parameter values `val0`, `val1`, .. ; then the values are matched against the patterns, and if succeeds, the resulting environment is combined with the closure environment, resulting in an environment to evaluate `exp`. 132 | 133 | The multi-parameter function definitions and applications support automatic currying. The zero-parameter `lambda` expression and application is equivalent to `lambda` with empty pattern and application to `nil`. 134 | 135 | The built-in operators and ADT constructors do not support automatic currying yet. 136 | 137 | ### `letrec` Expressions 138 | 139 | A `letrec` expression creates mutally recursive bindings for evaluating an expression. Its syntax is as follows : 140 | 141 | (letrec ((pat0 exp0) (pat1 exp1) ..) exp) 142 | 143 | Its semantics is similar to evaluate `exp` in a new environment; the new environment is created by evaluating `exp0`, `exp1`, .. in the new environment itself, then matching the resulting values with `pat0`, `pat1`, .. , creating new bindings which contribute to the new environment itself. 144 | 145 | `letrec` makes recursion possible in Erumpo. The method for implementing recursion is not fanciful combinators, but rather `letrec` which gives function names so that they can refer to their own names (and other functions' names) in their own definition. 146 | 147 | `letrec` is also related to the top-level "environment". After some `import`/`define` declarations are executed, we have a set of pattern/expression pairs. The evaluation of expression and pattern matching are not immediately carried out; instead, when later evaluating an expression under REPL, the pattern/expression pairs are wrapped into a `letrec` expression. 148 | 149 | ### `if` Expressions 150 | 151 | An `if` expression has the following syntax: 152 | 153 | (if cond_exp then_exp else_exp) 154 | 155 | When evaluated, first `cond_exp` is evaluated. If the resulting value is not `Bool`, evaluation fails, otherwise if it is `true`, then `then_exp` is evaluated, otherwise `else_exp` is evaluated. 156 | 157 | ### `case` Expressions 158 | 159 | An `case` expression has the following syntax: 160 | 161 | (case exp ((pat0 exp0) (pat1 exp1) ..)) 162 | 163 | When evaluated, first `exp` is evaluated, then it is matched with `pat0`; if succeeds, the resulting new bindings are added to the current environment to evaluate `exp0`; if fails, then it is matched with `pat1`, and so on. If none of the pattern matched, then the evaluation fails. 164 | 165 | ### Unary Operator Expressions 166 | 167 | An unary operator expression has the following syntax: 168 | 169 | (op exp) 170 | 171 | When evaluated, first `exp` is evaluated, the the operator `op` is applied to the value. Currently `op` can be: 172 | 173 | - `!`, the "not" operator for the `Bool` type 174 | - `print`, prints the value and returns `nil` 175 | - `eval`, takes the string value, parses it to an Erumpo expression and evaluates it under the current environment. 176 | 177 | ### Binary Operator Expressions 178 | 179 | A binary operator expression has the following syntax: 180 | 181 | (op x_exp y_exp) 182 | 183 | When evaluated, first `x_exp` and `y_exp` are evaluated, then the operator `op` is applied to the two values. Currently `op` can be: 184 | 185 | - `&&`/`||`: the "and"/"or" operator for the `Bool` type 186 | - `==`/`!=`/`<=`/`>=`/`<`/`>`: comparison operators for primive types and ADT types 187 | - `+`/`-`/`*`/`/`: arithmetic operators for `Int`/`Float` type 188 | 189 | For the precise semantics of comparison/arithmetic, refer the `Interpreter` module of the implementation. Structured comparison is enabled, for example, the comparison result of two strings (lists of `Char`s) is decided by lexicographical comparison. However, comparing two ADT values with different constructors will cause a type error. (for convenience, `nil` is less than any value) 190 | 191 | ## Implementation Internals 192 | 193 | ### Overview 194 | 195 | Currently Erumpo has an interpreter written in Haskell. The interpreter program is divided into the following 5 modules: 196 | 197 | - `Common.hs`, includes the common type definitions for the whole interpreter program 198 | - `Interpreter.hs`, includes the expression evaluator and utility functions for pattern matching, comparing/printing values, etc 199 | - `Main.hs`, launches an interactive REPL with empty environment 200 | - `Parser.hs`, includes a naive monadic PEG(Parsing Expression Grammars) parser. Support for syntactic sugar (the [] notation/multi-parameter functions) are implemented here and not visible to the interpreter 201 | - `REPL.hs`, includes the REPL and implements `declare`/`import` declarations 202 | 203 | ### Environment Model 204 | 205 | The evaluation of an Erumpo expression is done in an environment, which is a set of bindings from variable names to values. `Common.hs` includes the definition of the environment: `type Env = Map.Map String Val`. The Haskell standard module `Data.Map` is used, which internally is a persistent binary search tree. Using it simplifies the implementation (in C/C++ there is no persistent data structure in the standard libraries!), reduces variable insertion/lookup overhead and preserves enough information to support `eval` expressions on strings. 206 | 207 | ### Structured Comparison 208 | 209 | Erumpo supports structured comparison. For example, evaluating `(< [2 3 5 7] [2 4 6])` yields `true`. In general, there are two types of comparisons: comparison for equality (similar to the `Eq` type class in Haskell) and comparison for ordering (similar to the `Ord` type class in Haskell). 210 | 211 | When comparing two values of different types for equality, the result is `false`, but the result is fatal error when comparing them for ordering. The comparison for equality is used for matching constant patterns. 212 | 213 | For convenience, `nil` is less than any value. Then we can obtain a lexicographical order for ADT values. 214 | 215 | ### Monadic Code Style 216 | 217 | Error handling in other languages involves checking return values or using `try`/`catch` constructs to play with exceptions. These styles produce a lot of boilerplate code. Instead, the `Maybe` monad is used throughout the program for simple and effective error handling, and Haskell provides the `do` notation as a handy syntactic sugar. 218 | 219 | ## License 220 | 221 | 3-clause BSD license. Check `LICENSE` in this repository. --------------------------------------------------------------------------------