remove unit type/value in favor of unit tuples
This commit is contained in:
parent
502c711c96
commit
b1a465f0e9
2
AST.hs
2
AST.hs
|
@ -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]
|
||||||
|
|
16
Interp.hs
16
Interp.hs
|
@ -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
|
||||||
|
|
2
Lamb.hs
2
Lamb.hs
|
@ -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)
|
||||||
|
|
|
@ -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) }
|
||||||
|
|
Loading…
Reference in New Issue