remove unit type/value in favor of unit tuples

This commit is contained in:
darkf 2013-11-09 02:02:00 -08:00
parent 502c711c96
commit b1a465f0e9
4 changed files with 9 additions and 20 deletions

2
AST.hs
View File

@ -20,7 +20,6 @@ data AST = Add AST AST
| Lambda [(Pattern, AST)] | Lambda [(Pattern, AST)]
| Call AST AST | Call AST AST
| Access AST AST | Access AST AST
| UnitConst
| Cons AST AST | Cons AST AST
| IfExpr AST AST AST | IfExpr AST AST AST
| TupleConst [AST] | TupleConst [AST]
@ -34,7 +33,6 @@ data Pattern = VarP String
| IntP Integer | IntP Integer
| StrP String | StrP String
| BoolP Bool | BoolP Bool
| UnitP
| ConsP Pattern Pattern | ConsP Pattern Pattern
| TupleP [Pattern] | TupleP [Pattern]
| ListP [Pattern] | ListP [Pattern]

View File

@ -25,7 +25,6 @@ instance Ord BIF where compare a b = if a == b then EQ else LT
data Value = IntV Integer data Value = IntV Integer
| StrV String | StrV String
| UnitV
| BoolV Bool | BoolV Bool
| StreamV Int | StreamV Int
| TupleV [Value] | TupleV [Value]
@ -51,6 +50,7 @@ type Env = [M.Map String Value] -- lexical environment (linked list)
type InterpState = StateT ([Handle], Env) IO -- interpreter state (open handles, global env) type InterpState = StateT ([Handle], Env) IO -- interpreter state (open handles, global env)
emptyEnv = [M.empty] emptyEnv = [M.empty]
unitv = TupleV []
-- look up a binding from the bottom up -- look up a binding from the bottom up
lookup :: Env -> String -> Maybe Value lookup :: Env -> String -> Maybe Value
@ -74,7 +74,6 @@ instance Show Value where
show (FnV _ _) = "<fn>" show (FnV _ _) = "<fn>"
show (StreamV _) = "<stream>" show (StreamV _) = "<stream>"
show (Builtin _) = "<built-in>" show (Builtin _) = "<built-in>"
show UnitV = "()"
-- value operators -- value operators
(IntV l) +$ (IntV r) = IntV (l + r) (IntV l) +$ (IntV r) = IntV (l + r)
@ -106,13 +105,13 @@ _fputbytes (TupleV [StreamV h, StrV str]) = do
(handles,_) <- get (handles,_) <- get
let handle = handles !! h let handle = handles !! h
io <- lift $ hPutStr handle str io <- lift $ hPutStr handle str
return UnitV return unitv
_fputstr (TupleV [StreamV h, StrV str]) = do _fputstr (TupleV [StreamV h, StrV str]) = do
(handles,_) <- get (handles,_) <- get
let handle = handles !! h let handle = handles !! h
io <- lift $ hPutStr handle str io <- lift $ hPutStr handle str
return UnitV return unitv
_fgetline (StreamV h) = do _fgetline (StreamV h) = do
(handles,_) <- get (handles,_) <- get
@ -148,7 +147,7 @@ _fclose handle@(StreamV h) = do
(handles,_) <- get (handles,_) <- get
let handle = handles !! h let handle = handles !! h
lift $ hClose handle lift $ hClose handle
return UnitV return unitv
_sockopen (TupleV [StrV host, IntV port]) = do _sockopen (TupleV [StrV host, IntV port]) = do
(handles,env) <- get (handles,env) <- get
@ -163,7 +162,7 @@ _sockopen (TupleV [StrV host, IntV port]) = do
_putstr str@(StrV _) = _fputstr $ TupleV [StreamV 0, str] _putstr str@(StrV _) = _fputstr $ TupleV [StreamV 0, str]
_putbytes str@(StrV _) = _fputbytes $ TupleV [StreamV 0, str] _putbytes str@(StrV _) = _fputbytes $ TupleV [StreamV 0, str]
_getline UnitV = _fgetline (StreamV 1) _getline (TupleV []) = _fgetline (StreamV 1)
_print v = _putbytes $ StrV $ show v ++ "\n" _print v = _putbytes $ StrV $ show v ++ "\n"
_repr v = return . StrV $ show v _repr v = return . StrV $ show v
@ -230,8 +229,6 @@ eval (IntConst i) = return $ IntV i
eval (StrConst s) = return $ StrV s eval (StrConst s) = return $ StrV s
eval (BoolConst b) = return $ BoolV b eval (BoolConst b) = return $ BoolV b
eval UnitConst = return UnitV
eval (Block body) = foldr1 (>>) $ map eval body eval (Block body) = foldr1 (>>) $ map eval body
eval (Cons a b) = do eval (Cons a b) = do
@ -338,9 +335,6 @@ patternBindings (BoolP b) (BoolV v)
| v == b = Just M.empty | v == b = Just M.empty
| otherwise = Nothing | otherwise = Nothing
patternBindings UnitP UnitV = Just M.empty
patternBindings UnitP _ = Nothing
patternBindings (StrP x) (StrV y) patternBindings (StrP x) (StrV y)
| x == y = Just M.empty | x == y = Just M.empty
| otherwise = Nothing | otherwise = Nothing

View File

@ -7,7 +7,7 @@ import System.Directory (doesFileExist)
import System.FilePath (FilePath, splitExtension) import System.FilePath (FilePath, splitExtension)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Parser (parseProgram) import Parser (parseProgram)
import Interp (evalFileV, evalProgram, initIO, interpret, InterpState, Value(UnitV)) import Interp (evalFileV, evalProgram, initIO, interpret, InterpState, Value)
-- returns Nothing if all files exist, or Just path for the first one that doesn't -- returns Nothing if all files exist, or Just path for the first one that doesn't
allExist :: [FilePath] -> IO (Maybe FilePath) allExist :: [FilePath] -> IO (Maybe FilePath)

View File

@ -1,6 +1,7 @@
{-# Language TemplateHaskell, QuasiQuotes, FlexibleContexts #-} {-# Language TemplateHaskell, QuasiQuotes, FlexibleContexts #-}
module Parser where module Parser where
import Data.Maybe (fromMaybe)
import Text.Peggy hiding (space) import Text.Peggy hiding (space)
import AST import AST
@ -21,9 +22,7 @@ semistatements :: [AST]
args :: AST args :: AST
= expr ("," expr)+ { TupleConst ($1 : $2) } = expr ("," expr)+ { TupleConst ($1 : $2) }
/ expr? { case $1 of / expr? { fromMaybe (TupleConst []) $1 }
Just x -> x
Nothing -> UnitConst }
patternlist :: Pattern patternlist :: Pattern
= pattern ("," pattern)+ { ListP ($1 : $2) } = pattern ("," pattern)+ { ListP ($1 : $2) }
@ -47,9 +46,7 @@ pattern :: Pattern
funpattern :: Pattern funpattern :: Pattern
= pattern ("," pattern)+ { TupleP ($1 : $2) } = pattern ("," pattern)+ { TupleP ($1 : $2) }
/ pattern? { case $1 of / pattern? { fromMaybe (TupleP []) $1 }
Just x -> x
Nothing -> UnitP }
listseq :: AST listseq :: AST
= expr ("," expr)+ { ListConst ($1 : $2) } = expr ("," expr)+ { ListConst ($1 : $2) }