Compare commits
No commits in common. "master" and "unic" have entirely different histories.
19
AST.hs
19
AST.hs
|
@ -3,7 +3,6 @@
|
||||||
-- Licensed under the terms of the zlib license, see LICENSE for details
|
-- Licensed under the terms of the zlib license, see LICENSE for details
|
||||||
|
|
||||||
module AST where
|
module AST where
|
||||||
import qualified Data.Text as T
|
|
||||||
|
|
||||||
data AST = Add AST AST
|
data AST = Add AST AST
|
||||||
| Sub AST AST
|
| Sub AST AST
|
||||||
|
@ -13,31 +12,29 @@ data AST = Add AST AST
|
||||||
| NotEquals AST AST
|
| NotEquals AST AST
|
||||||
| LessThan AST AST
|
| LessThan AST AST
|
||||||
| GreaterThan AST AST
|
| GreaterThan AST AST
|
||||||
| BitAnd AST AST
|
|
||||||
| BitOr AST AST
|
|
||||||
| BitNot AST
|
|
||||||
| BitShift AST AST Bool
|
|
||||||
| Block [AST]
|
| Block [AST]
|
||||||
| FunDef T.Text (Pattern, AST)
|
| FunDef String (Pattern, AST)
|
||||||
| Defun T.Text AST
|
| Defun String AST
|
||||||
| Def Pattern AST
|
| Def Pattern AST
|
||||||
| Var T.Text
|
| Var String
|
||||||
| 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]
|
||||||
| ListConst [AST]
|
| ListConst [AST]
|
||||||
| BoolConst Bool
|
| BoolConst Bool
|
||||||
| StrConst T.Text
|
| StrConst String
|
||||||
| IntConst Integer
|
| IntConst Integer
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data Pattern = VarP T.Text
|
data Pattern = VarP String
|
||||||
| IntP Integer
|
| IntP Integer
|
||||||
| StrP T.Text
|
| StrP String
|
||||||
| BoolP Bool
|
| BoolP Bool
|
||||||
|
| UnitP
|
||||||
| ConsP Pattern Pattern
|
| ConsP Pattern Pattern
|
||||||
| TupleP [Pattern]
|
| TupleP [Pattern]
|
||||||
| ListP [Pattern]
|
| ListP [Pattern]
|
||||||
|
|
414
Interp.hs
414
Interp.hs
|
@ -3,27 +3,16 @@
|
||||||
-- Licensed under the terms of the zlib license, see LICENSE for details
|
-- Licensed under the terms of the zlib license, see LICENSE for details
|
||||||
|
|
||||||
module Interp where
|
module Interp where
|
||||||
import Prelude hiding (lookup, (<$))
|
import Prelude hiding (lookup)
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map as M
|
||||||
import qualified Data.ByteString.Char8 as BSC
|
import qualified Data.ByteString.Char8 as BSC
|
||||||
import qualified Network.Socket as SO
|
import qualified Network.Socket as SO
|
||||||
import qualified Data.Text as T
|
import Data.List (intercalate)
|
||||||
import qualified Data.Text.IO as TIO
|
import Control.Monad.Trans (lift)
|
||||||
import Data.List (intercalate, foldl1')
|
|
||||||
import Data.Time.Clock.POSIX (getPOSIXTime)
|
|
||||||
import Data.Bits
|
|
||||||
import Control.Applicative ((<$>))
|
|
||||||
import Control.Exception (try, SomeException)
|
|
||||||
import Control.Concurrent (ThreadId, forkIO, threadDelay, killThread)
|
|
||||||
import Control.Concurrent.STM (atomically)
|
|
||||||
import Control.Concurrent.STM.TVar (TVar, newTVarIO, readTVar, writeTVar)
|
|
||||||
import Control.Monad.IO.Class (liftIO)
|
|
||||||
import Control.Monad.Trans.State (StateT, runStateT, evalStateT, get, put)
|
import Control.Monad.Trans.State (StateT, runStateT, evalStateT, get, put)
|
||||||
import System.IO (Handle, hPutStr, hGetLine, hClose, hIsEOF, hSetBuffering,
|
import System.IO (Handle, hPutStr, hGetLine, hFlush, hClose, hIsEOF, openBinaryFile, hSetBinaryMode, IOMode(..), stdout, stdin)
|
||||||
hSetBinaryMode, openBinaryFile, IOMode(..), BufferMode(NoBuffering), stdout, stdin)
|
|
||||||
import System.Directory (doesFileExist)
|
import System.Directory (doesFileExist)
|
||||||
import System.FilePath (FilePath, splitExtension, takeBaseName, takeDirectory, (</>))
|
import System.FilePath (FilePath, splitExtension, takeBaseName)
|
||||||
import System.Environment (getExecutablePath)
|
|
||||||
import AST
|
import AST
|
||||||
import Parser (parseProgram)
|
import Parser (parseProgram)
|
||||||
|
|
||||||
|
@ -34,14 +23,13 @@ instance Eq BIF where a == b = False
|
||||||
instance Ord BIF where compare a b = if a == b then EQ else LT
|
instance Ord BIF where compare a b = if a == b then EQ else LT
|
||||||
|
|
||||||
data Value = IntV Integer
|
data Value = IntV Integer
|
||||||
| StrV T.Text
|
| StrV String
|
||||||
|
| UnitV
|
||||||
| BoolV Bool
|
| BoolV Bool
|
||||||
| StreamV Handle
|
| StreamV Int
|
||||||
| TupleV [Value]
|
| TupleV [Value]
|
||||||
| ListV [Value]
|
| ListV [Value]
|
||||||
| DictV (M.Map Value Value)
|
| DictV (M.Map Value Value)
|
||||||
| RefV (TVar Value)
|
|
||||||
| Thread ThreadId
|
|
||||||
| Builtin BIF
|
| Builtin BIF
|
||||||
| FnV Env [(Pattern, AST)] -- closure pattern->body bindings
|
| FnV Env [(Pattern, AST)] -- closure pattern->body bindings
|
||||||
deriving (Eq)
|
deriving (Eq)
|
||||||
|
@ -52,47 +40,44 @@ instance Ord Value where
|
||||||
compare (BoolV a) (BoolV b) = compare a b
|
compare (BoolV a) (BoolV b) = compare a b
|
||||||
compare (TupleV a) (TupleV b) = compare a b
|
compare (TupleV a) (TupleV b) = compare a b
|
||||||
compare (ListV a) (ListV b) = compare a b
|
compare (ListV a) (ListV b) = compare a b
|
||||||
compare (StreamV a) (StreamV b) = if a == b then EQ else LT
|
compare (StreamV a) (StreamV b) = compare a b
|
||||||
compare (Builtin a) (Builtin b) = compare a b
|
compare (Builtin a) (Builtin b) = compare a b
|
||||||
compare (FnV a b) (FnV x y) = if a == x && b == y then EQ else LT
|
compare (FnV a b) (FnV x y) = if a == x && b == y then EQ else LT
|
||||||
compare (DictV a) (DictV b) = compare a b
|
compare (DictV a) (DictV b) = compare a b
|
||||||
compare _ _ = error "compare: not valid"
|
compare _ _ = error "compare: not valid"
|
||||||
|
|
||||||
type Env = [M.Map T.Text Value] -- lexical environment (linked list)
|
type Env = [M.Map String Value] -- lexical environment (linked list)
|
||||||
type InterpState = StateT Env IO -- interpreter state (open handles, global env)
|
type InterpState = StateT ([Handle], Env) IO -- interpreter state (open handles, global env)
|
||||||
|
|
||||||
type StrDict = M.Map T.Text Value
|
|
||||||
type ValueDict = M.Map Value Value
|
|
||||||
|
|
||||||
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 -> T.Text -> Maybe Value
|
lookup :: Env -> String -> Maybe Value
|
||||||
lookup [] _ = Nothing
|
lookup [] _ = Nothing
|
||||||
lookup (env:xs) name = maybe (lookup xs name) Just (M.lookup name env)
|
lookup (env:xs) name =
|
||||||
|
case M.lookup name env of
|
||||||
|
Nothing -> lookup xs name
|
||||||
|
Just x -> Just x
|
||||||
|
|
||||||
-- bind in the local environment
|
-- bind in the local environment
|
||||||
bind :: Env -> T.Text -> Value -> Env
|
bind :: Env -> String -> Value -> Env
|
||||||
bind (env:xs) name value = (M.insert name value env):xs
|
bind (env:xs) name value = (M.insert name value env):xs
|
||||||
|
|
||||||
instance Show Value where
|
instance Show Value where
|
||||||
show (IntV i) = show i
|
show (IntV i) = show i
|
||||||
show (StrV s) = show s
|
show (StrV s) = show s
|
||||||
show (BoolV b) = show b
|
show (BoolV b) = show b
|
||||||
show (TupleV []) = "(,)"
|
|
||||||
show (TupleV v) = "(" ++ intercalate "," (map show v) ++ ")"
|
show (TupleV v) = "(" ++ intercalate "," (map show v) ++ ")"
|
||||||
show (ListV v) = show v
|
show (ListV v) = show v
|
||||||
show (DictV d) = "<dict " ++ show d ++ ">"
|
show (DictV d) = "<dict " ++ show d ++ ">"
|
||||||
show (FnV _ _) = "<fn>"
|
show (FnV _ _) = "<fn>"
|
||||||
show (StreamV _) = "<stream>"
|
show (StreamV _) = "<stream>"
|
||||||
show (Builtin _) = "<built-in>"
|
show (Builtin _) = "<built-in>"
|
||||||
show (RefV _) = "<ref>"
|
show UnitV = "()"
|
||||||
show (Thread t) = "<thread " ++ show t ++ ">"
|
|
||||||
|
|
||||||
-- value operators
|
-- value operators
|
||||||
(IntV l) +$ (IntV r) = IntV (l + r)
|
(IntV l) +$ (IntV r) = IntV (l + r)
|
||||||
(StrV l) +$ (StrV r) = StrV (l `T.append` r)
|
(StrV l) +$ (StrV r) = StrV (l ++ r)
|
||||||
(ListV l) +$ (ListV r) = ListV (l ++ r)
|
(ListV l) +$ (ListV r) = ListV (l ++ r)
|
||||||
l +$ r = error $ "cannot + " ++ show l ++ " and " ++ show r
|
l +$ r = error $ "cannot + " ++ show l ++ " and " ++ show r
|
||||||
|
|
||||||
|
@ -111,206 +96,132 @@ l <$ r = error $ "cannot < " ++ show l ++ " and " ++ show r
|
||||||
(IntV l) >$ (IntV r) = BoolV (l > r)
|
(IntV l) >$ (IntV r) = BoolV (l > r)
|
||||||
l >$ r = error $ "cannot > " ++ show l ++ " and " ++ show r
|
l >$ r = error $ "cannot > " ++ show l ++ " and " ++ show r
|
||||||
|
|
||||||
(IntV l) &$ (IntV r) = IntV (l .&. r)
|
|
||||||
l &$ r = error $ "cannot & " ++ show l ++ " and " ++ show r
|
|
||||||
|
|
||||||
(IntV l) |$ (IntV r) = IntV (l .|. r)
|
|
||||||
l |$ r = error $ "cannot | " ++ show l ++ " and " ++ show r
|
|
||||||
|
|
||||||
(IntV l) <<$ (IntV r) = IntV (l `shiftL` fromInteger r)
|
|
||||||
l <<$ r = error $ "cannot << " ++ show l ++ " and " ++ show r
|
|
||||||
|
|
||||||
(IntV l) >>$ (IntV r) = IntV (l `shiftR` fromInteger r)
|
|
||||||
l >>$ r = error $ "cannot >> " ++ show l ++ " and " ++ show r
|
|
||||||
|
|
||||||
bitNot (IntV v) = IntV (complement v)
|
|
||||||
bitNot v = error $ "cannot ~ " ++ show v
|
|
||||||
|
|
||||||
l ==$ r = BoolV (l == r)
|
l ==$ r = BoolV (l == r)
|
||||||
l !=$ r = BoolV (l /= r)
|
l !=$ r = BoolV (l /= r)
|
||||||
|
|
||||||
toDict :: StrDict -> Value
|
|
||||||
toDict m = DictV (M.mapKeys StrV m) -- wrap keys in StrV
|
|
||||||
|
|
||||||
fromDict :: ValueDict -> StrDict
|
|
||||||
fromDict m = M.mapKeys (\(StrV k) -> k) m -- unwrap keys
|
|
||||||
|
|
||||||
-- some built-in functions
|
-- some built-in functions
|
||||||
|
|
||||||
_fputstr (TupleV [StreamV handle, StrV str]) =
|
_fputbytes (TupleV [StreamV h, StrV str]) = do
|
||||||
liftIO $ TIO.hPutStr handle str >> return unitv
|
(handles,_) <- get
|
||||||
|
let handle = handles !! h
|
||||||
|
io <- lift $ hPutStr handle str >> hFlush handle
|
||||||
|
return UnitV
|
||||||
|
|
||||||
_fgetline (StreamV handle) = do
|
_fputstr (TupleV [StreamV h, StrV str]) = do
|
||||||
str <- liftIO $ TIO.hGetLine handle
|
(handles,_) <- get
|
||||||
if T.last str == '\r' then -- remove trailing CR
|
let handle = handles !! h
|
||||||
return . StrV $ T.init str
|
io <- lift $ hPutStr handle str >> hFlush handle
|
||||||
|
return UnitV
|
||||||
|
|
||||||
|
_fgetline (StreamV h) = do
|
||||||
|
(handles,_) <- get
|
||||||
|
let handle = handles !! h
|
||||||
|
str <- lift $ hGetLine handle
|
||||||
|
if last str == '\r' then -- remove trailing CR
|
||||||
|
return . StrV $ init str
|
||||||
else return $ StrV str
|
else return $ StrV str
|
||||||
|
|
||||||
_freadbytes (TupleV [StreamV handle, IntV n]) = do
|
_freadbytes (TupleV [StreamV h, IntV n]) = do
|
||||||
liftIO $ StrV . T.take (fromIntegral n) <$> TIO.hGetContents handle
|
(handles,_) <- get
|
||||||
|
let handle = handles !! h
|
||||||
_freadcontents (StreamV handle) = do
|
str <- lift $ BSC.hGet handle (fromIntegral n :: Int)
|
||||||
liftIO $ StrV <$> TIO.hGetContents handle
|
return . StrV $ BSC.unpack str
|
||||||
|
|
||||||
_fopen (TupleV [StrV path, StrV mode]) = do
|
_fopen (TupleV [StrV path, StrV mode]) = do
|
||||||
let mode' = case T.unpack mode of
|
(handles,env) <- get
|
||||||
|
let mode' = case mode of
|
||||||
"r" -> ReadMode
|
"r" -> ReadMode
|
||||||
"w" -> WriteMode
|
"w" -> WriteMode
|
||||||
"rw" -> ReadWriteMode
|
"rw" -> ReadWriteMode
|
||||||
StreamV <$> liftIO (openBinaryFile (T.unpack path) mode')
|
handle <- lift $ openBinaryFile path mode'
|
||||||
|
put (handles ++ [handle], env)
|
||||||
|
return . StreamV $ length handles
|
||||||
|
|
||||||
_feof (StreamV handle) = do
|
_feof (StreamV h) = do
|
||||||
BoolV <$> liftIO (hIsEOF handle)
|
(handles,_) <- get
|
||||||
|
let handle = handles !! h
|
||||||
|
isEof <- lift $ hIsEOF handle
|
||||||
|
return $ BoolV isEof
|
||||||
|
|
||||||
_fclose (StreamV handle) = do
|
_fclose handle@(StreamV h) = do
|
||||||
liftIO (hClose handle) >> return unitv
|
(handles,_) <- get
|
||||||
|
let handle = handles !! h
|
||||||
|
lift $ hClose handle
|
||||||
|
return UnitV
|
||||||
|
|
||||||
_sockopen (TupleV [StrV host, IntV port]) = do
|
_sockopen (TupleV [StrV host, IntV port]) = do
|
||||||
liftIO $ SO.withSocketsDo $ do
|
(handles,env) <- get
|
||||||
addr:_ <- SO.getAddrInfo Nothing (Just $ T.unpack host) (Just $ show port)
|
handle <- lift $ SO.withSocketsDo $ do
|
||||||
|
addr:_ <- SO.getAddrInfo Nothing (Just host) (Just $ show port)
|
||||||
sock <- SO.socket (SO.addrFamily addr) SO.Stream SO.defaultProtocol
|
sock <- SO.socket (SO.addrFamily addr) SO.Stream SO.defaultProtocol
|
||||||
SO.connect sock (SO.addrAddress addr)
|
SO.connect sock (SO.addrAddress addr)
|
||||||
handle <- SO.socketToHandle sock ReadWriteMode
|
handle <- SO.socketToHandle sock ReadWriteMode
|
||||||
hSetBuffering handle NoBuffering
|
return handle
|
||||||
return $ StreamV handle
|
put (handles ++ [handle], env)
|
||||||
|
return . StreamV $ length handles
|
||||||
|
|
||||||
_putstr str@(StrV _) = _fputstr $ TupleV [StreamV stdout, str]
|
_putstr str@(StrV _) = _fputstr $ TupleV [StreamV 0, str]
|
||||||
_putbytes str@(StrV _) = _fputstr $ TupleV [StreamV stdout, str]
|
_putbytes str@(StrV _) = _fputbytes $ TupleV [StreamV 0, str]
|
||||||
_getline (TupleV []) = _fgetline (StreamV stdin)
|
_getline UnitV = _fgetline (StreamV 1)
|
||||||
|
|
||||||
_print v = _putbytes $ StrV $ T.pack (show v) `T.snoc` '\n'
|
_print v = _putbytes $ StrV $ show v ++ "\n"
|
||||||
_repr v = return . StrV $ T.pack $ show v
|
_repr v = return . StrV $ show v
|
||||||
|
|
||||||
_itos (IntV i) = return $ StrV $ T.pack $ show i
|
_itos (IntV i) = return $ StrV $ show i
|
||||||
_itos v = error $ "itos: not an int: " ++ show v
|
_itos v = error $ "itos: not an int: " ++ show v
|
||||||
|
|
||||||
_stoi (StrV s) = return $ IntV $ read $ T.unpack s
|
|
||||||
_stoi v = error $ "stoi: not a string: " ++ show v
|
|
||||||
|
|
||||||
_ord (StrV s) = return $ IntV $ toInteger $ fromEnum $ T.head s
|
|
||||||
_ord v = error $ "ord: not a string: " ++ show v
|
|
||||||
|
|
||||||
_chr (IntV i) = return $ StrV $ T.singleton (toEnum (fromInteger i) :: Char)
|
|
||||||
_chr v = error $ "chr: not an integer: " ++ show v
|
|
||||||
|
|
||||||
_ref v = RefV <$> liftIO (newTVarIO v)
|
|
||||||
|
|
||||||
_readRef (RefV r) = liftIO $ atomically $ readTVar r
|
|
||||||
|
|
||||||
_setRef (TupleV [RefV r, v]) =
|
|
||||||
liftIO (atomically $ writeTVar r v) >> return v
|
|
||||||
|
|
||||||
_time (TupleV []) = fmap IntV $ liftIO $ round <$> getPOSIXTime
|
|
||||||
|
|
||||||
_sleep (IntV milliseconds) = liftIO (threadDelay (fromInteger $ 1000 * milliseconds)) >> return unitv
|
|
||||||
|
|
||||||
_loop args@(TupleV [fn@(FnV _ _), arg]) = do
|
_loop args@(TupleV [fn@(FnV _ _), arg]) = do
|
||||||
v <- apply fn arg
|
v <- apply fn arg
|
||||||
if v /= BoolV False then
|
if v /= BoolV False then
|
||||||
_loop $ TupleV [fn, v]
|
_loop $ TupleV [fn, v]
|
||||||
else return arg
|
else return arg
|
||||||
|
|
||||||
_eval (TupleV [StrV code, DictV env]) = do
|
|
||||||
let trySome :: IO a -> IO (Either SomeException a)
|
|
||||||
trySome = try
|
|
||||||
state = [fromDict env]
|
|
||||||
ret <- liftIO . trySome $ evalStateT (evalString code) state
|
|
||||||
case ret of
|
|
||||||
Left err -> return $ TupleV [StrV (T.pack "err"), StrV $ T.pack (show err)]
|
|
||||||
Right v -> return v
|
|
||||||
|
|
||||||
_eval (TupleV [code@(StrV _), (ListV env)]) =
|
|
||||||
let env' = map (\(TupleV [k,v]) -> (k,v)) env in
|
|
||||||
_eval (TupleV [code, DictV $ M.fromList env'])
|
|
||||||
|
|
||||||
_eval _ = error "eval: invalid args (want code and environment)"
|
|
||||||
|
|
||||||
_thread f@FnV{} = do
|
|
||||||
state <- get
|
|
||||||
fmap Thread $ liftIO $ forkIO $ (evalStateT (apply f unitv) state >> return ())
|
|
||||||
_thread _ = error "thread!: need a function"
|
|
||||||
|
|
||||||
_kill (Thread thread) = liftIO (killThread thread) >> return unitv
|
|
||||||
_kill _ = error "kill!: need a thread"
|
|
||||||
|
|
||||||
-- returns a dictionary of a new environment with only the standard
|
|
||||||
-- default-imported functions
|
|
||||||
_newStdEnv (TupleV []) = do
|
|
||||||
let [stdEnv] = initialState
|
|
||||||
return $ toDict stdEnv
|
|
||||||
|
|
||||||
_globals (TupleV []) = do
|
|
||||||
env <- get
|
|
||||||
return $ toDict (last env)
|
|
||||||
|
|
||||||
_locals (TupleV []) = do
|
|
||||||
locals:_ <- get
|
|
||||||
return $ toDict locals
|
|
||||||
|
|
||||||
-- import a module name as a module
|
-- import a module name as a module
|
||||||
_Import (StrV modname) = do
|
_Import (StrV modname) = do
|
||||||
env <- get -- save current state
|
(h,env) <- get -- save current state
|
||||||
put initialState
|
put initialState
|
||||||
(path,modname) <- liftIO $ findModule $ T.unpack modname -- find the module file
|
(path,modname) <- lift $ findModule modname -- find the module file
|
||||||
evalFile path -- evaluate the module file
|
evalFile path -- evaluate the module file
|
||||||
[modenv] <- get -- get the module env
|
(_,[modenv]) <- get -- get the module env
|
||||||
let [initialEnv] = initialState
|
let (_, [initialEnv]) = initialState
|
||||||
--let modenv' = M.difference modenv initialEnv -- subtract prelude stuff
|
let modenv' = M.difference modenv initialEnv -- subtract prelude stuff
|
||||||
let mod = toDict modenv
|
-- convert String to StrV in env keys
|
||||||
let env' = bind env (T.pack modname) mod -- bind it
|
let modenv'' = map (\(k,v) -> (StrV k, v)) $ M.toAscList modenv'
|
||||||
put env' -- restore state
|
let mod = DictV (M.fromAscList modenv'') -- package module into a dict
|
||||||
|
let env' = bind env modname mod -- bind it
|
||||||
|
put (h,env') -- restore state
|
||||||
return mod -- return module value
|
return mod -- return module value
|
||||||
|
|
||||||
where
|
where
|
||||||
findModule :: FilePath -> IO (FilePath, String)
|
findModule :: FilePath -> IO (FilePath, String)
|
||||||
findModule modname = do
|
findModule modname = do
|
||||||
execPath <- fmap takeDirectory getExecutablePath
|
let path = modname ++ ".lamb"
|
||||||
findModuleIn [".", execPath </> "mods"] -- search paths for modules
|
exists <- doesFileExist path
|
||||||
where
|
if exists then
|
||||||
findModuleIn [] = error $ "module " ++ modname ++ " couldn't be found"
|
return (path, takeBaseName path)
|
||||||
findModuleIn (dir:xs) = do
|
else error $ "module " ++ modname ++ " couldn't be found"
|
||||||
let path = dir </> modname ++ ".lamb"
|
|
||||||
exists <- doesFileExist path
|
|
||||||
if exists then return (path, takeBaseName path)
|
|
||||||
else findModuleIn xs
|
|
||||||
|
|
||||||
bif = Builtin . BIF
|
initialState = ([stdout, stdin],
|
||||||
initialState = [M.fromList $ map (\(k,v) -> (T.pack k, v)) $ [
|
[M.fromList [("id", FnV emptyEnv [(VarP "x", Var "x")]),
|
||||||
("id", FnV emptyEnv [(VarP (T.pack "x"), Var (T.pack "x"))]),
|
("loop", Builtin $ BIF _loop),
|
||||||
("loop", bif _loop),
|
("repr", Builtin $ BIF _repr),
|
||||||
("ref!", bif _ref),
|
("stdout", StreamV 0),
|
||||||
("readRef!", bif _readRef),
|
("stdin", StreamV 1),
|
||||||
("setRef!", bif _setRef),
|
("print", Builtin $ BIF _print),
|
||||||
("time!", bif _time),
|
("putstr", Builtin $ BIF _putstr),
|
||||||
("sleep!", bif _sleep),
|
("putstrln", Builtin $ BIF (\x -> _putstr $ x +$ StrV "\n")),
|
||||||
("repr", bif _repr),
|
("getline", Builtin $ BIF _getline),
|
||||||
("stdout", StreamV stdout),
|
("fgetline", Builtin $ BIF _fgetline),
|
||||||
("stdin", StreamV stdin),
|
("putbytes", Builtin $ BIF _putbytes),
|
||||||
("print", bif _print),
|
("fputbytes", Builtin $ BIF _fputbytes),
|
||||||
("putstr", bif _putstr),
|
("fputstr", Builtin $ BIF _fputstr),
|
||||||
("putstrln", bif (\x -> _putstr $ x +$ StrV (T.singleton '\n'))),
|
("freadbytes", Builtin $ BIF _freadbytes),
|
||||||
("getline", bif _getline),
|
("feof", Builtin $ BIF _feof),
|
||||||
("fgetline", bif _fgetline),
|
("fclose", Builtin $ BIF _fclose),
|
||||||
("putbytes", bif _putbytes),
|
("fopen", Builtin $ BIF _fopen),
|
||||||
("fputbytes", bif _fputstr),
|
("sockopen", Builtin $ BIF _sockopen),
|
||||||
("fputstr", bif _fputstr),
|
("itos", Builtin $ BIF _itos),
|
||||||
("freadbytes", bif _freadbytes),
|
("import", Builtin $ BIF _Import)]])
|
||||||
("freadcontents", bif _freadcontents),
|
|
||||||
("feof", bif _feof),
|
|
||||||
("fclose", bif _fclose),
|
|
||||||
("fopen", bif _fopen),
|
|
||||||
("sockopen", bif _sockopen),
|
|
||||||
("itos", bif _itos),
|
|
||||||
("stoi", bif _stoi),
|
|
||||||
("ord", bif _ord),
|
|
||||||
("chr", bif _chr),
|
|
||||||
("globals", bif _globals),
|
|
||||||
("locals", bif _locals),
|
|
||||||
("newStdEnv", bif _newStdEnv),
|
|
||||||
("thread!", bif _thread),
|
|
||||||
("kill!", bif _kill),
|
|
||||||
("eval", bif _eval),
|
|
||||||
("import", bif _Import)]]
|
|
||||||
|
|
||||||
eval :: AST -> InterpState Value
|
eval :: AST -> InterpState Value
|
||||||
|
|
||||||
|
@ -318,6 +229,8 @@ 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
|
||||||
|
@ -325,14 +238,13 @@ eval (Cons a b) = do
|
||||||
b' <- eval b
|
b' <- eval b
|
||||||
case b' of
|
case b' of
|
||||||
ListV v' -> return $ ListV $ a':v'
|
ListV v' -> return $ ListV $ a':v'
|
||||||
StrV v' ->
|
_ -> error "cons: RHS must be a list"
|
||||||
case a' of
|
|
||||||
StrV c | T.length c == 1 -> return $ StrV $ T.cons (T.head c) v'
|
|
||||||
_ -> error "cons: LHS must be a char"
|
|
||||||
_ -> error "cons: RHS must be a list or string"
|
|
||||||
|
|
||||||
eval (ListConst v) = ListV <$> mapM eval v
|
eval (ListConst v) =
|
||||||
eval (TupleConst v) = TupleV <$> mapM eval v
|
mapM eval v >>= \xs ->
|
||||||
|
return $ ListV xs
|
||||||
|
|
||||||
|
eval (TupleConst v) = mapM eval v >>= return . TupleV
|
||||||
|
|
||||||
eval (IfExpr c t e) = eval c >>= \cond ->
|
eval (IfExpr c t e) = eval c >>= \cond ->
|
||||||
case cond of
|
case cond of
|
||||||
|
@ -340,35 +252,37 @@ eval (IfExpr c t e) = eval c >>= \cond ->
|
||||||
BoolV False -> eval e
|
BoolV False -> eval e
|
||||||
_ -> error "if: condition must be a boolean"
|
_ -> error "if: condition must be a boolean"
|
||||||
|
|
||||||
eval (Var var) = get >>= \env ->
|
eval (Var var) = get >>= \(_,env) ->
|
||||||
maybe (error $ "unbound variable " ++ T.unpack var) return (lookup env var)
|
case lookup env var of
|
||||||
|
Just v -> return v
|
||||||
|
Nothing -> error $ "unbound variable " ++ var
|
||||||
|
|
||||||
eval (Defun name fn) = do
|
eval (Defun name fn) = do
|
||||||
env <- get
|
(s,env) <- get
|
||||||
case lookup env name of
|
case lookup env name of
|
||||||
Nothing -> -- bind new fn
|
Nothing -> -- bind new fn
|
||||||
eval fn >>= \fn' ->
|
eval fn >>= \fn' ->
|
||||||
put (bind env name fn') >> return fn'
|
put (s, bind env name fn') >> return fn'
|
||||||
Just oldfn -> -- add pattern to old fn
|
Just oldfn -> -- add pattern to old fn
|
||||||
let FnV cls oldpats = oldfn
|
let FnV cls oldpats = oldfn
|
||||||
Lambda [(pat, body)] = fn
|
Lambda [(pat, body)] = fn
|
||||||
newfn = FnV cls (oldpats ++ [(pat, body)]) in
|
newfn = FnV cls (oldpats ++ [(pat, body)]) in
|
||||||
put (bind env name newfn) >> return newfn
|
put (s, bind env name newfn) >> return newfn
|
||||||
|
|
||||||
eval (Def pat v') = do
|
eval (Def pat v') = do
|
||||||
v <- eval v'
|
v <- eval v'
|
||||||
locals:xs <- get
|
(s,locals:xs) <- get
|
||||||
case patternBindings pat v of
|
case patternBindings pat v of
|
||||||
Nothing -> error $ "pattern binding doesn't satisfy: " ++ show v ++ " with " ++ show pat
|
Nothing -> error $ "pattern binding doesn't satisfy: " ++ show v ++ " with " ++ show pat
|
||||||
Just bindings -> do
|
Just bindings ->
|
||||||
put $ (M.union bindings locals):xs -- update our local bindings
|
put (s, (M.union bindings locals):xs) >> -- update our local bindings
|
||||||
return v
|
return v
|
||||||
|
|
||||||
eval (Lambda pats) = do
|
eval (Lambda pats) =
|
||||||
env <- get
|
get >>= \(_,env) ->
|
||||||
if length env == 1 then -- if in global env just use [], denoting the current global scope
|
if length env == 1 then -- if in global env just use [], denoting the current global scope
|
||||||
return $ FnV [] pats
|
return $ FnV [] pats
|
||||||
else return $ FnV env pats
|
else return $ FnV env pats
|
||||||
|
|
||||||
eval (Add l r) = do { l <- eval l; r <- eval r; return $ l +$ r }
|
eval (Add l r) = do { l <- eval l; r <- eval r; return $ l +$ r }
|
||||||
eval (Sub l r) = do { l <- eval l; r <- eval r; return $ l -$ r }
|
eval (Sub l r) = do { l <- eval l; r <- eval r; return $ l -$ r }
|
||||||
|
@ -380,11 +294,6 @@ eval (NotEquals l r) = do { l <- eval l; r <- eval r; return $ l !=$ r }
|
||||||
eval (LessThan l r) = do { l <- eval l; r <- eval r; return $ l <$ r }
|
eval (LessThan l r) = do { l <- eval l; r <- eval r; return $ l <$ r }
|
||||||
eval (GreaterThan l r) = do { l <- eval l; r <- eval r; return $ l >$ r }
|
eval (GreaterThan l r) = do { l <- eval l; r <- eval r; return $ l >$ r }
|
||||||
|
|
||||||
eval (BitAnd l r) = do { l <- eval l; r <- eval r; return $ l &$ r }
|
|
||||||
eval (BitOr l r) = do { l <- eval l; r <- eval r; return $ l |$ r }
|
|
||||||
eval (BitShift l r dir) = do { l <- eval l; r <- eval r; return $ (if dir then (<<$) else (>>$)) l r }
|
|
||||||
eval (BitNot v) = do { v <- eval v; return $ bitNot v }
|
|
||||||
|
|
||||||
eval (Access left (Var right)) = do
|
eval (Access left (Var right)) = do
|
||||||
lhs <- eval left
|
lhs <- eval left
|
||||||
case lhs of
|
case lhs of
|
||||||
|
@ -393,30 +302,30 @@ eval (Access left (Var right)) = do
|
||||||
Just (FnV [] fn) -> -- use the module's global scope
|
Just (FnV [] fn) -> -- use the module's global scope
|
||||||
return $ FnV (mapToEnv dict) fn
|
return $ FnV (mapToEnv dict) fn
|
||||||
Just v -> return v
|
Just v -> return v
|
||||||
Nothing -> return $ TupleV [StrV (T.pack "nothing")]
|
Nothing -> return $ TupleV [StrV "nothing"]
|
||||||
_ -> error $ "op/: need a dict, got " ++ show lhs
|
_ -> error $ "op/: need a dict, got " ++ show lhs
|
||||||
where
|
where
|
||||||
mapToEnv :: M.Map Value Value -> Env
|
mapToEnv :: M.Map Value Value -> Env
|
||||||
mapToEnv m = [fromDict m]
|
mapToEnv m = [M.fromAscList $ map (\(StrV k,v) -> (k,v)) (M.toAscList m)]
|
||||||
eval (Access _ _) = error "op/: RHS must be an identifier"
|
eval (Access _ _) = error "op/: RHS must be an identifier"
|
||||||
|
|
||||||
eval (Call lhs arg) = do
|
eval (Call lhs arg) = do
|
||||||
env <- get
|
(h,env) <- get
|
||||||
v <- eval lhs
|
v <- eval lhs
|
||||||
case v of
|
case v of
|
||||||
fn@(FnV cls _) -> do
|
fn@(FnV cls _) -> do
|
||||||
arg' <- eval arg
|
arg' <- eval arg
|
||||||
let cls' = if cls == [] then [last env] else cls -- if [], use current global env
|
let cls' = if cls == [] then [last env] else cls -- if [], use current global env
|
||||||
put cls' -- enter closure env
|
put (h,cls') -- enter closure env
|
||||||
v <- apply fn arg'
|
v <- apply fn arg'
|
||||||
put env -- restore env
|
put (h,env) -- restore env
|
||||||
return v
|
return v
|
||||||
fn@(Builtin _) -> eval arg >>= apply fn
|
fn@(Builtin _) -> eval arg >>= apply fn
|
||||||
_ -> error $ "call: " ++ show v ++ " is not a function"
|
_ -> error $ "call: " ++ show v ++ " is not a function"
|
||||||
|
|
||||||
eval x = error $ "eval: unhandled: " ++ show x
|
eval x = error $ "eval: unhandled: " ++ show x
|
||||||
|
|
||||||
patternBindings :: Pattern -> Value -> Maybe (M.Map T.Text Value)
|
patternBindings :: Pattern -> Value -> Maybe (M.Map String Value)
|
||||||
patternBindings (VarP n) v = Just $ M.fromList [(n, v)]
|
patternBindings (VarP n) v = Just $ M.fromList [(n, v)]
|
||||||
|
|
||||||
patternBindings (IntP n) (IntV v)
|
patternBindings (IntP n) (IntV v)
|
||||||
|
@ -428,31 +337,27 @@ 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
|
||||||
patternBindings (StrP _) _ = Nothing
|
patternBindings (StrP _) _ = Nothing
|
||||||
|
|
||||||
-- cons on strings
|
-- cons on strings
|
||||||
-- x:[] matches with y:""
|
patternBindings (ConsP x (ListP [])) (StrV (y:[])) = patternBindings x (StrV [y])
|
||||||
patternBindings (ConsP x (ListP [])) (StrV str) =
|
|
||||||
case T.uncons str of
|
|
||||||
Just (y, ys) | T.null ys -> -- str matches y:[]
|
|
||||||
patternBindings x (StrV $ T.singleton y)
|
|
||||||
_ -> Nothing
|
|
||||||
-- "xy":xs pattern
|
-- "xy":xs pattern
|
||||||
patternBindings (ConsP (StrP xp) xsp) (StrV str) =
|
patternBindings (ConsP (StrP xp) xsp) (StrV str) =
|
||||||
let len = T.length xp in
|
let len = length xp in
|
||||||
if T.take len str == xp then -- matches
|
if take len str == xp then -- matches
|
||||||
patternBindings xsp $ StrV (T.drop len str) -- match the rest of the string
|
patternBindings xsp $ StrV (drop len str) -- match the rest of the string
|
||||||
else Nothing -- no match
|
else Nothing -- no match
|
||||||
patternBindings (ConsP xp xsp) (StrV str) =
|
patternBindings (ConsP xp xsp) (StrV (x:xs)) =
|
||||||
case T.uncons str of
|
do
|
||||||
Just (x, xs) -> do
|
xe <- patternBindings xp (StrV [x])
|
||||||
xe <- patternBindings xp (StrV $ T.singleton x)
|
xse <- patternBindings xsp $ StrV xs
|
||||||
xse <- patternBindings xsp $ StrV xs
|
Just $ M.union xe xse
|
||||||
Just $ M.union xe xse
|
|
||||||
_ -> Nothing
|
|
||||||
|
|
||||||
-- cons on lists
|
-- cons on lists
|
||||||
patternBindings (ConsP x (ListP [])) (ListV (y:[])) = patternBindings x y
|
patternBindings (ConsP x (ListP [])) (ListV (y:[])) = patternBindings x y
|
||||||
|
@ -485,8 +390,6 @@ patternBindings (TupleP (x:xs)) (TupleV (y:ys)) =
|
||||||
Just $ M.union env' env
|
Just $ M.union env' env
|
||||||
patternBindings (TupleP _) _ = Nothing -- not a tuple
|
patternBindings (TupleP _) _ = Nothing -- not a tuple
|
||||||
|
|
||||||
patternBindings p x = error $ "patternBindings failure: matching " ++ show x ++ " with pattern " ++ show p
|
|
||||||
|
|
||||||
-- applies a function
|
-- applies a function
|
||||||
apply :: Value -> Value -> InterpState Value
|
apply :: Value -> Value -> InterpState Value
|
||||||
apply (FnV _ pats) arg =
|
apply (FnV _ pats) arg =
|
||||||
|
@ -497,9 +400,9 @@ apply (FnV _ pats) arg =
|
||||||
case patternBindings pat arg of
|
case patternBindings pat arg of
|
||||||
Just bindings -> -- satisfies
|
Just bindings -> -- satisfies
|
||||||
do
|
do
|
||||||
env <- get
|
(s,env) <- get
|
||||||
let newenv = bindings:env
|
let newenv = bindings:env
|
||||||
put newenv
|
put (s, newenv)
|
||||||
eval body
|
eval body
|
||||||
Nothing -> -- doesn't satisfy this pattern
|
Nothing -> -- doesn't satisfy this pattern
|
||||||
apply' xs
|
apply' xs
|
||||||
|
@ -508,21 +411,16 @@ apply (Builtin (BIF fn)) arg = fn arg
|
||||||
|
|
||||||
-- some helper programs for evaluation
|
-- some helper programs for evaluation
|
||||||
|
|
||||||
-- sets up stdin/stdout for binary mode and makes them unbuffered
|
-- sets up stdin/stdout for binary mode
|
||||||
initIO :: IO ()
|
initIO :: IO ()
|
||||||
initIO = do
|
initIO = do
|
||||||
hSetBinaryMode stdin True
|
hSetBinaryMode stdin True
|
||||||
hSetBinaryMode stdout True
|
hSetBinaryMode stdout True
|
||||||
hSetBuffering stdout NoBuffering
|
|
||||||
|
|
||||||
-- Takes an interpreter state and evaluates it with the empty initial state.
|
|
||||||
interpret :: InterpState a -> IO a
|
|
||||||
interpret state = evalStateT state initialState
|
|
||||||
|
|
||||||
evalProgram :: [AST] -> InterpState Value
|
evalProgram :: [AST] -> InterpState Value
|
||||||
evalProgram nodes = foldl1' (>>) $ map eval nodes
|
evalProgram nodes = foldr1 (>>) $ map eval nodes
|
||||||
|
|
||||||
evalString :: T.Text -> InterpState Value
|
evalString :: String -> InterpState Value
|
||||||
evalString program =
|
evalString program =
|
||||||
case parseProgram program of
|
case parseProgram program of
|
||||||
Left err -> error $ show err
|
Left err -> error $ show err
|
||||||
|
@ -533,15 +431,15 @@ isLiterate path = snd (splitExtension path) == ".lilamb"
|
||||||
|
|
||||||
-- Takes the lines of a literate program and returns the lines for a new executable program
|
-- Takes the lines of a literate program and returns the lines for a new executable program
|
||||||
-- from lines beginning with four spaces.
|
-- from lines beginning with four spaces.
|
||||||
parseLiterate :: [T.Text] -> [T.Text]
|
parseLiterate :: [String] -> [String]
|
||||||
parseLiterate lns = [T.drop 4 line | line <- lns, T.take 4 line == T.pack " "]
|
parseLiterate lns = [drop 4 line | line <- lns, take 4 line == " "]
|
||||||
|
|
||||||
evalFile :: FilePath -> InterpState Value
|
evalFile :: FilePath -> InterpState Value
|
||||||
evalFile path = do
|
evalFile path = do
|
||||||
contents <- liftIO $ if path == "-" then TIO.getContents else TIO.readFile path
|
contents <- lift $ if path == "-" then getContents else readFile path
|
||||||
if isLiterate path then
|
if isLiterate path then
|
||||||
evalString . T.unlines . parseLiterate . T.lines $ contents
|
evalString . unlines . parseLiterate . lines $ contents
|
||||||
else evalString contents
|
else evalString contents
|
||||||
|
|
||||||
evalFileV :: FilePath -> IO Value
|
evalFileV :: FilePath -> IO Value
|
||||||
evalFileV = interpret . evalFile
|
evalFileV path = evalStateT (evalFile path) initialState
|
17
LICENSE
17
LICENSE
|
@ -1,17 +0,0 @@
|
||||||
Copyright (c) 2013 darkf
|
|
||||||
|
|
||||||
This software is provided 'as-is', without any express or implied
|
|
||||||
warranty. In no event will the authors be held liable for any damages
|
|
||||||
arising from the use of this software.
|
|
||||||
|
|
||||||
Permission is granted to anyone to use this software for any purpose,
|
|
||||||
including commercial applications, and to alter it and redistribute it
|
|
||||||
freely, subject to the following restrictions:
|
|
||||||
|
|
||||||
1. The origin of this software must not be misrepresented; you must not
|
|
||||||
claim that you wrote the original software. If you use this software
|
|
||||||
in a product, an acknowledgment in the product documentation would be
|
|
||||||
appreciated but is not required.
|
|
||||||
2. Altered source versions must be plainly marked as such, and must not be
|
|
||||||
misrepresented as being the original software.
|
|
||||||
3. This notice may not be removed or altered from any source distribution.
|
|
52
Lamb.hs
52
Lamb.hs
|
@ -5,46 +5,22 @@
|
||||||
import System.Environment (getArgs)
|
import System.Environment (getArgs)
|
||||||
import System.Directory (doesFileExist)
|
import System.Directory (doesFileExist)
|
||||||
import System.FilePath (FilePath, splitExtension)
|
import System.FilePath (FilePath, splitExtension)
|
||||||
import Control.Applicative ((<$>))
|
import Interp (evalFileV, initIO, Value(UnitV))
|
||||||
import Control.Monad (filterM)
|
|
||||||
import Control.Monad.IO.Class (liftIO)
|
|
||||||
import Parser (parseProgram)
|
|
||||||
import Interp (evalFileV, evalProgram, initIO, interpret, InterpState, Value)
|
|
||||||
|
|
||||||
exists :: FilePath -> IO Bool
|
-- returns Nothing if all files exist, or Just path for the first one that doesn't
|
||||||
exists "-" = return True
|
allExist :: [FilePath] -> IO (Maybe FilePath)
|
||||||
exists path = not <$> doesFileExist path
|
allExist [] = return Nothing
|
||||||
|
allExist ("-":xs) = allExist xs
|
||||||
findMissing :: [FilePath] -> IO [FilePath]
|
allExist (x:xs) = do
|
||||||
findMissing = filterM exists
|
exists <- doesFileExist x
|
||||||
|
if exists then allExist xs
|
||||||
repl :: InterpState Value
|
else return $ Just x
|
||||||
repl = do
|
|
||||||
liftIO $ putStr ">> "
|
|
||||||
line <- liftIO getLine
|
|
||||||
case parseProgram line of
|
|
||||||
Left err -> do
|
|
||||||
liftIO $ putStrLn $ "parse error: " ++ show err
|
|
||||||
Right prg -> do
|
|
||||||
ev <- evalProgram prg
|
|
||||||
liftIO $ print ev
|
|
||||||
repl
|
|
||||||
|
|
||||||
repl' :: IO ()
|
|
||||||
repl' = interpret repl >> return ()
|
|
||||||
|
|
||||||
main = do
|
main = do
|
||||||
args <- getArgs
|
args <- getArgs
|
||||||
if null args
|
exist <- allExist args
|
||||||
then do -- no arguments, launch REPL
|
case exist of
|
||||||
initIO
|
Just file -> putStrLn $ "error: file " ++ file ++ " doesn't exist"
|
||||||
repl'
|
Nothing ->
|
||||||
else do
|
initIO >>
|
||||||
missing <- findMissing args
|
|
||||||
if null missing
|
|
||||||
then do
|
|
||||||
initIO
|
|
||||||
mapM_ evalFileV args
|
mapM_ evalFileV args
|
||||||
else do
|
|
||||||
let reportMissing file = putStrLn $ "error: file " ++ file ++ " doesn't exist"
|
|
||||||
mapM_ reportMissing missing
|
|
||||||
|
|
39
Parser.hs
39
Parser.hs
|
@ -1,9 +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 qualified Data.Text as T
|
|
||||||
import AST
|
import AST
|
||||||
|
|
||||||
[peggy|
|
[peggy|
|
||||||
|
@ -23,7 +21,9 @@ semistatements :: [AST]
|
||||||
|
|
||||||
args :: AST
|
args :: AST
|
||||||
= expr ("," expr)+ { TupleConst ($1 : $2) }
|
= expr ("," expr)+ { TupleConst ($1 : $2) }
|
||||||
/ expr? { fromMaybe (TupleConst []) $1 }
|
/ expr? { case $1 of
|
||||||
|
Just x -> x
|
||||||
|
Nothing -> UnitConst }
|
||||||
|
|
||||||
patternlist :: Pattern
|
patternlist :: Pattern
|
||||||
= pattern ("," pattern)+ { ListP ($1 : $2) }
|
= pattern ("," pattern)+ { ListP ($1 : $2) }
|
||||||
|
@ -42,12 +42,14 @@ pattern :: Pattern
|
||||||
/ patterntuple
|
/ patterntuple
|
||||||
/ "true" { BoolP True } / "false" { BoolP False }
|
/ "true" { BoolP True } / "false" { BoolP False }
|
||||||
/ identifier { VarP $1 }
|
/ identifier { VarP $1 }
|
||||||
/ stringlit { StrP (T.pack $1) }
|
/ stringlit { StrP $1 }
|
||||||
/ integer { IntP $1 }
|
/ integer { IntP $1 }
|
||||||
|
|
||||||
funpattern :: Pattern
|
funpattern :: Pattern
|
||||||
= pattern ("," pattern)+ { TupleP ($1 : $2) }
|
= pattern ("," pattern)+ { TupleP ($1 : $2) }
|
||||||
/ pattern? { fromMaybe (TupleP []) $1 }
|
/ pattern? { case $1 of
|
||||||
|
Just x -> x
|
||||||
|
Nothing -> UnitP }
|
||||||
|
|
||||||
listseq :: AST
|
listseq :: AST
|
||||||
= expr ("," expr)+ { ListConst ($1 : $2) }
|
= expr ("," expr)+ { ListConst ($1 : $2) }
|
||||||
|
@ -76,41 +78,29 @@ expr :: AST
|
||||||
= expr "::" expr { Cons $1 $2 }
|
= expr "::" expr { Cons $1 $2 }
|
||||||
/ expr "+" fact { Add $1 $2 }
|
/ expr "+" fact { Add $1 $2 }
|
||||||
/ expr "-" fact { Sub $1 $2 }
|
/ expr "-" fact { Sub $1 $2 }
|
||||||
/ expr "&" fact { BitAnd $1 $2 }
|
|
||||||
/ expr "|" fact { BitOr $1 $2 }
|
|
||||||
/ expr "<<" fact { BitShift $1 $2 True }
|
|
||||||
/ expr ">>" fact { BitShift $1 $2 False }
|
|
||||||
/ expr "==" fact { Equals $1 $2 }
|
/ expr "==" fact { Equals $1 $2 }
|
||||||
/ expr "!=" fact { NotEquals $1 $2 }
|
/ expr "!=" fact { NotEquals $1 $2 }
|
||||||
/ expr "<" fact { LessThan $1 $2 }
|
/ expr "<" fact { LessThan $1 $2 }
|
||||||
/ expr ">" fact { GreaterThan $1 $2 }
|
/ expr ">" fact { GreaterThan $1 $2 }
|
||||||
/ "~" expr { BitNot $1 }
|
|
||||||
/ def
|
/ def
|
||||||
/ lambda
|
/ lambda
|
||||||
/ identifier "(" funpattern ")" "->" expr { Defun $1 (Lambda [($2, $3)]) }
|
/ identifier "(" funpattern ")" "->" expr { Defun $1 (Lambda [($2, $3)]) }
|
||||||
/ fact
|
/ fact
|
||||||
|
|
||||||
fact :: AST
|
fact :: AST
|
||||||
= fact "*" call { Mul $1 $2 }
|
= fact "*" term { Mul $1 $2 }
|
||||||
/ fact "/" call { Div $1 $2 }
|
/ fact "/" term { Div $1 $2 }
|
||||||
/ call
|
|
||||||
|
|
||||||
call :: AST
|
|
||||||
= call "(" args ")" { Call $1 $2 }
|
|
||||||
/ access
|
|
||||||
|
|
||||||
access :: AST
|
|
||||||
= access "\\" identifier { Access $1 (Var $2) }
|
|
||||||
/ term
|
/ term
|
||||||
|
|
||||||
term :: AST
|
term :: AST
|
||||||
= tuple
|
= term "(" args ")" { Call $1 $2 }
|
||||||
|
/ tuple
|
||||||
/ "(" expr ")"
|
/ "(" expr ")"
|
||||||
/ "[" listseq "]"
|
/ "[" listseq "]"
|
||||||
/ ifcond
|
/ ifcond
|
||||||
/ doblock
|
/ doblock
|
||||||
/ "true" { BoolConst True } / "false" { BoolConst False }
|
/ "true" { BoolConst True } / "false" { BoolConst False }
|
||||||
/ stringlit { StrConst (T.pack $1) }
|
/ stringlit { StrConst $1 }
|
||||||
/ integer { IntConst $1 }
|
/ integer { IntConst $1 }
|
||||||
/ identifier { Var $1 }
|
/ identifier { Var $1 }
|
||||||
|
|
||||||
|
@ -129,10 +119,9 @@ escChar :: Char
|
||||||
/ 'n' { '\n' }
|
/ 'n' { '\n' }
|
||||||
/ 'r' { '\r' }
|
/ 'r' { '\r' }
|
||||||
/ 't' { '\t' }
|
/ 't' { '\t' }
|
||||||
/ '0' { '\0' }
|
|
||||||
|
|
||||||
identifier ::: T.Text
|
identifier ::: String
|
||||||
= [a-zA-Z_] [a-zA-Z0-9_'?!]* { T.pack ($1 : $2) }
|
= [a-zA-Z_] [a-zA-Z0-9_'?!]* { $1 : $2 }
|
||||||
|
|
||||||
integer ::: Integer
|
integer ::: Integer
|
||||||
= [0-9] [0-9]* { read ($1 : $2) }
|
= [0-9] [0-9]* { read ($1 : $2) }
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
map_insert(assoc, pair) -> pair :: assoc.
|
map_insert(assoc, pair) -> pair :: assoc.
|
||||||
|
|
||||||
-- lookup by key
|
-- lookup by key
|
||||||
map_lookup([], _) -> ("nothing",).
|
map_lookup([], _) -> ("nothing").
|
||||||
map_lookup((k,v)::xs, key) ->
|
map_lookup((k,v)::xs, key) ->
|
||||||
if k == key then ("just", v)
|
if k == key then ("just", v)
|
||||||
else map_lookup(xs, key).
|
else map_lookup(xs, key).
|
||||||
|
@ -21,5 +21,5 @@ m = map_insert(m, ("ready", "go")).
|
||||||
print(m).
|
print(m).
|
||||||
print(map_remove(m, "k")).
|
print(map_remove(m, "k")).
|
||||||
("just", x) = map_lookup(m, "hi").
|
("just", x) = map_lookup(m, "hi").
|
||||||
("nothing",) = map_lookup(m, "foo").
|
("nothing") = map_lookup(m, "foo").
|
||||||
print(x).
|
print(x).
|
|
@ -1,16 +0,0 @@
|
||||||
-- Refs are global mutable (changing) values.
|
|
||||||
-- They let you break referential transparency (purity) to make some things easier.
|
|
||||||
|
|
||||||
x = ref!(1337). -- Construct a new ref, set to the value 1337
|
|
||||||
print(x). -- Should print <ref>
|
|
||||||
print(readRef!(x)). -- Should print 1337
|
|
||||||
|
|
||||||
setRef!(x, 42). -- Set it to 42
|
|
||||||
print(readRef!(x)).
|
|
||||||
|
|
||||||
-- Apply a function on the current value in the reference and set it to the new value.
|
|
||||||
modifyRef!(ref, f) ->
|
|
||||||
setRef!(ref, f(readRef!(ref))).
|
|
||||||
|
|
||||||
modifyRef!(x, \v -> v*2). -- Double x
|
|
||||||
print(readRef!(x)). -- 84
|
|
13
lamb.cabal
13
lamb.cabal
|
@ -1,13 +0,0 @@
|
||||||
name: lamb
|
|
||||||
version: 0.0.1
|
|
||||||
synopsis: The Lamb programming language
|
|
||||||
author: darkf
|
|
||||||
build-type: Simple
|
|
||||||
cabal-version: >= 1.8
|
|
||||||
|
|
||||||
executable lamb
|
|
||||||
main-is: Lamb.hs
|
|
||||||
build-depends: base, peggy, containers, transformers, directory, filepath, bytestring, network, text, time, stm
|
|
||||||
hs-source-dirs: .
|
|
||||||
extensions: DoAndIfThenElse
|
|
||||||
other-modules: AST, Interp, Parser
|
|
|
@ -1,28 +0,0 @@
|
||||||
import("std/list").
|
|
||||||
import("std/str").
|
|
||||||
|
|
||||||
charset = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/".
|
|
||||||
|
|
||||||
_b64(n) ->
|
|
||||||
list\map(\shift -> list\at(charset, (n >> shift) & 63),
|
|
||||||
[18, 12, 6, 0]).
|
|
||||||
|
|
||||||
f([]) -> [].
|
|
||||||
f(a :: b :: c :: xs) -> do
|
|
||||||
v = (a << 16) | (b << 8) | c;
|
|
||||||
_b64(v) + f(xs)
|
|
||||||
end.
|
|
||||||
f(a :: b :: []) -> do
|
|
||||||
v = (a << 16) | (b << 8);
|
|
||||||
list\take(3, _b64(v)) + ["="]
|
|
||||||
end.
|
|
||||||
f(a :: []) -> do
|
|
||||||
v = a << 16;
|
|
||||||
list\take(2, _b64(v)) + ["=="]
|
|
||||||
end.
|
|
||||||
|
|
||||||
base64_encode(s) -> do
|
|
||||||
bytes = list\map(ord, s);
|
|
||||||
str\concat(f(bytes))
|
|
||||||
end.
|
|
||||||
|
|
|
@ -1,6 +0,0 @@
|
||||||
-- Standard basic library for the Lamb programming language
|
|
||||||
-- Copyright (c) 2013 darkf
|
|
||||||
-- Licensed under the terms of the zlib license, see LICENSE for details
|
|
||||||
|
|
||||||
const(x) -> \_ -> x.
|
|
||||||
compose(f, g) -> \x -> f(g(x)).
|
|
|
@ -1,146 +0,0 @@
|
||||||
import("std/list").
|
|
||||||
|
|
||||||
fst((x, _)) -> x.
|
|
||||||
|
|
||||||
-- maybe stuff
|
|
||||||
|
|
||||||
is_just(("just", _)) -> true.
|
|
||||||
is_just(_) -> false.
|
|
||||||
|
|
||||||
is_nothing(("nothing",)) -> true.
|
|
||||||
is_nothing(_) -> false.
|
|
||||||
|
|
||||||
unwrap_maybe(("just", x)) -> x.
|
|
||||||
|
|
||||||
-- association list
|
|
||||||
|
|
||||||
-- insert a pair into a map
|
|
||||||
map_insert(assoc, key, value) -> (key, value) :: assoc.
|
|
||||||
|
|
||||||
-- lookup by key
|
|
||||||
map_lookup([], _) -> ("nothing",).
|
|
||||||
map_lookup((k,v)::xs, key) ->
|
|
||||||
if k == key then ("just", v)
|
|
||||||
else map_lookup(xs, key).
|
|
||||||
|
|
||||||
-- remove a key from a map
|
|
||||||
map_remove([], key) -> [].
|
|
||||||
map_remove((k,v)::xs, key) ->
|
|
||||||
if k == key then xs
|
|
||||||
else (k,v) :: map_remove(xs, key).
|
|
||||||
|
|
||||||
spanS(_, "") -> ("", "").
|
|
||||||
spanS(p, x::xs) ->
|
|
||||||
if p(x) then do
|
|
||||||
(ys, zs) = spanS(p, xs);
|
|
||||||
(x::ys, zs)
|
|
||||||
end
|
|
||||||
else
|
|
||||||
("", (x::xs)).
|
|
||||||
|
|
||||||
parse_uri("http://" :: rest) -> do
|
|
||||||
(host, request_) = spanS(\x -> x != "/", rest);
|
|
||||||
(hostname, port_) = spanS(\x -> x != ":", host);
|
|
||||||
|
|
||||||
request = if request_ == "" then "/" else request_;
|
|
||||||
port = if port_ == "" then 80 else do ":"::p = port_; stoi(p) end;
|
|
||||||
|
|
||||||
(hostname, port, request)
|
|
||||||
end.
|
|
||||||
|
|
||||||
parse_uri(uri) -> ("err", "invalid schema (URI: " + repr(uri) + ")").
|
|
||||||
|
|
||||||
-- print(parse_uri("http://localhost")).
|
|
||||||
-- print(parse_uri("http://localhost/foo/bar.html")).
|
|
||||||
-- print(parse_uri("http://localhost:123")).
|
|
||||||
-- print(parse_uri("http://localhost:123/foo/bar.html")).
|
|
||||||
|
|
||||||
-- print(spanS((\x -> x != "/"), "foobar/")).
|
|
||||||
|
|
||||||
-- TODO: fix recursive functions inside functions
|
|
||||||
|
|
||||||
get_response_body("\r\n\r\n"::body) -> body.
|
|
||||||
get_response_body(x::xs) -> get_response_body(xs).
|
|
||||||
|
|
||||||
concatS([]) -> "".
|
|
||||||
concatS(x::xs) -> x + concatS(xs).
|
|
||||||
|
|
||||||
concatMapS(f, xs) -> concatS(list\map(f, xs)).
|
|
||||||
|
|
||||||
initS(_::"") -> "".
|
|
||||||
initS(c::cs) -> c :: initS(cs).
|
|
||||||
|
|
||||||
lengthS("") -> 0.
|
|
||||||
lengthS(_::cs) -> 1 + lengthS(cs).
|
|
||||||
|
|
||||||
-- NOT complete by any means
|
|
||||||
urlencode("") -> "".
|
|
||||||
urlencode("&"::xs) -> "%26" + urlencode(xs).
|
|
||||||
urlencode(" "::xs) -> "+" :: urlencode(xs).
|
|
||||||
urlencode("\r"::xs) -> "%0D" + urlencode(xs).
|
|
||||||
urlencode("\n"::xs) -> "%0A" + urlencode(xs).
|
|
||||||
urlencode(c::xs) -> c :: urlencode(xs).
|
|
||||||
|
|
||||||
http_get(uri) -> do
|
|
||||||
f((hostname, port, request)) -> do
|
|
||||||
putstrln("hostname: " + repr(hostname) + " port: " + repr(port) + " request: " + repr(request));
|
|
||||||
|
|
||||||
sock = sockopen(hostname, port);
|
|
||||||
fputstr(sock, "GET " + request + " HTTP/1.0\r\n");
|
|
||||||
fputstr(sock, "Host: " + hostname + "\r\n");
|
|
||||||
fputstr(sock, "User-Agent: Mozilla/5.0 (Windows NT 6.2; WOW64) lamb\r\n");
|
|
||||||
fputstr(sock, "\r\n");
|
|
||||||
|
|
||||||
response = freadcontents(sock);
|
|
||||||
(code, _) = spanS(\x -> x != "\n", response);
|
|
||||||
putstrln("code: " + code);
|
|
||||||
|
|
||||||
resp = get_response_body(response);
|
|
||||||
("ok", resp)
|
|
||||||
end;
|
|
||||||
f(err) -> err;
|
|
||||||
f(parse_uri(uri))
|
|
||||||
end.
|
|
||||||
|
|
||||||
http_post(uri, data) -> do
|
|
||||||
f((hostname, port, request)) -> do
|
|
||||||
putstrln("hostname: " + repr(hostname) + " port: " + repr(port) + " request: " + repr(request));
|
|
||||||
|
|
||||||
--fputstr = (\_, s -> putstrln("SEND: " + s));
|
|
||||||
|
|
||||||
body_ = concatMapS(\(k,v) -> k + "=" + urlencode(v) + "&", data);
|
|
||||||
body = initS(body_);
|
|
||||||
|
|
||||||
sock = sockopen(hostname, port);
|
|
||||||
fputstr(sock, "POST " + request + " HTTP/1.0\r\n");
|
|
||||||
fputstr(sock, "Host: " + hostname + "\r\n");
|
|
||||||
fputstr(sock, "User-Agent: Mozilla/5.0 (Windows NT 6.2; WOW64) lamb\r\n");
|
|
||||||
fputstr(sock, "Content-Type: application/x-www-form-urlencoded\r\n");
|
|
||||||
fputstr(sock, "Content-Length: " + repr(lengthS(body)) + "\r\n");
|
|
||||||
fputstr(sock, "\r\n");
|
|
||||||
fputstr(sock, body);
|
|
||||||
|
|
||||||
response = freadcontents(sock);
|
|
||||||
(code, _) = spanS(\x -> x != "\n", response);
|
|
||||||
putstrln("code: " + code);
|
|
||||||
|
|
||||||
resp = get_response_body(response);
|
|
||||||
("ok", resp)
|
|
||||||
end;
|
|
||||||
f(err) -> err;
|
|
||||||
f(parse_uri(uri))
|
|
||||||
end.
|
|
||||||
|
|
||||||
|
|
||||||
-- print(http_get("http://127.0.0.1:123/foo/bar.html")).
|
|
||||||
-- print(http_get("nope://localhost:123/foo/bar.html")).
|
|
||||||
|
|
||||||
-- print(http_get("http://thefuckingweather.com/?where=12345")).
|
|
||||||
|
|
||||||
-- print(concatS(["foo", "bar"])).
|
|
||||||
|
|
||||||
-- print(http_post("http://127.0.0.1:123/foo/bar.html", [("foo", "bar")])).
|
|
||||||
|
|
||||||
-- print(http_post("http://ix.io", [("f:1", "hi from lamb! :D & goodbye!")])).
|
|
||||||
|
|
||||||
async_http_get(url, k) -> thread!(\_ -> k(http_get(url))).
|
|
|
@ -1,77 +0,0 @@
|
||||||
-- Standard List library for the Lamb programming language
|
|
||||||
-- Copyright (c) 2013 darkf
|
|
||||||
-- Licensed under the terms of the zlib license, see LICENSE for details
|
|
||||||
|
|
||||||
-- list membership test
|
|
||||||
memberOf?([], _) -> false.
|
|
||||||
memberOf?(x::xs, member) ->
|
|
||||||
if x == member then true
|
|
||||||
else memberOf?(xs, member).
|
|
||||||
|
|
||||||
-- map function: map(\x -> x*2, [1, 2, 3]) == [2, 4, 6]
|
|
||||||
map(f, []) -> [].
|
|
||||||
map(f, "") -> [].
|
|
||||||
map(f, x::xs) -> f(x) :: map(f, xs).
|
|
||||||
|
|
||||||
-- list folds
|
|
||||||
foldl(f, v, "") -> v.
|
|
||||||
foldl(f, v, []) -> v.
|
|
||||||
foldl(f, v, x::xs) -> do
|
|
||||||
foldl(f, f(v, x), xs)
|
|
||||||
end.
|
|
||||||
|
|
||||||
foldr(f, v, "") -> v.
|
|
||||||
foldr(f, v, []) -> v.
|
|
||||||
foldr(f, v, x::xs) -> do
|
|
||||||
f(x, foldr(f, v, xs))
|
|
||||||
end.
|
|
||||||
|
|
||||||
sum(lst) -> foldl(\x,y -> x + y, 0, lst).
|
|
||||||
product(lst) -> foldl(\x,y -> x * y, 1, lst).
|
|
||||||
reverse(lst) -> foldl(\x,xs -> x :: xs, [], lst).
|
|
||||||
length(lst) -> foldl(\y,_ -> 1 + y, 0, lst).
|
|
||||||
|
|
||||||
filter(f, []) -> [].
|
|
||||||
filter(f, x::xs) ->
|
|
||||||
if f(x) then x :: filter(f, xs)
|
|
||||||
else filter(f, xs).
|
|
||||||
|
|
||||||
-- index function
|
|
||||||
-- out of values (hey, this isn't the Circus of Values!)
|
|
||||||
at([], _) -> 0 - 1. -- (-1)
|
|
||||||
at("", _) -> 0 - 1. -- (-1)
|
|
||||||
-- we've hit our target item
|
|
||||||
at(x::_, 0) -> x.
|
|
||||||
-- we've got more to go, keep iterating
|
|
||||||
at(x::xs, i) -> at(xs, i-1).
|
|
||||||
|
|
||||||
-- find (linear search)
|
|
||||||
find'([], _, _) -> 0 - 1. -- (-1)
|
|
||||||
find'(x::xs, item, i) ->
|
|
||||||
if x == item then i
|
|
||||||
else find'(xs, item, i+1).
|
|
||||||
find(lst, item) -> find'(lst, item, 0).
|
|
||||||
|
|
||||||
takeWhile(f, []) -> [].
|
|
||||||
takeWhile(f, x::xs) -> do
|
|
||||||
if f(x) == true then x :: takeWhile(f, xs)
|
|
||||||
else []
|
|
||||||
end.
|
|
||||||
|
|
||||||
dropWhile(f, []) -> [].
|
|
||||||
dropWhile(f, x::xs) -> do
|
|
||||||
if f(x) == true then dropWhile(f, xs)
|
|
||||||
else x :: xs
|
|
||||||
end.
|
|
||||||
|
|
||||||
drop(0, x) -> x.
|
|
||||||
drop(n, []) -> [].
|
|
||||||
drop(n, _::xs) -> drop(n-1, xs).
|
|
||||||
|
|
||||||
take(0, _) -> [].
|
|
||||||
take(n, []) -> [].
|
|
||||||
take(n, x::xs) -> x :: take(n-1, xs).
|
|
||||||
|
|
||||||
intercalate(s, []) -> "".
|
|
||||||
intercalate(s, x::[]) -> x.
|
|
||||||
intercalate(s, x::xs) -> x + s + intercalate(s, xs).
|
|
|
@ -1,9 +0,0 @@
|
||||||
-- Standard math library for the Lamb programming language
|
|
||||||
-- Copyright (c) 2013 darkf
|
|
||||||
-- Licensed under the terms of the zlib license, see LICENSE for details
|
|
||||||
|
|
||||||
pow(base, 0) -> 1.
|
|
||||||
pow(base, exp) -> do
|
|
||||||
if exp < 0 then 1 / pow(base, neg(exp))
|
|
||||||
else base * pow(base, exp-1)
|
|
||||||
end.
|
|
|
@ -1,33 +0,0 @@
|
||||||
-- Standard operators library for the Lamb programming language
|
|
||||||
-- Copyright (c) 2013 darkf
|
|
||||||
-- Licensed under the terms of the zlib license, see LICENSE for details
|
|
||||||
|
|
||||||
-- binary operators
|
|
||||||
add(x,y) -> x+y.
|
|
||||||
mul(x,y) -> x*y.
|
|
||||||
div(x,y) -> x/y.
|
|
||||||
|
|
||||||
cons(x,y) -> x::y.
|
|
||||||
|
|
||||||
eq(x,y) -> x==y.
|
|
||||||
neq(x,y) -> x != y.
|
|
||||||
|
|
||||||
lt(x,y) -> x<y.
|
|
||||||
gt(x,y) -> x>y.
|
|
||||||
|
|
||||||
not(true) -> false.
|
|
||||||
not(false) -> true.
|
|
||||||
|
|
||||||
and(true,true) -> true.
|
|
||||||
and(_,_) -> false.
|
|
||||||
|
|
||||||
or(true, _) -> true.
|
|
||||||
or(_, true) -> true.
|
|
||||||
or(_, _) -> false.
|
|
||||||
|
|
||||||
xor(true, false) -> true.
|
|
||||||
xor(false, true) -> true.
|
|
||||||
xor(_, _) -> false.
|
|
||||||
|
|
||||||
-- unary operators
|
|
||||||
neg(x) -> 0-x.
|
|
|
@ -1,26 +0,0 @@
|
||||||
import("std/op").
|
|
||||||
|
|
||||||
takeWhileS(f, "") -> "".
|
|
||||||
takeWhileS(f, x::xs) -> do
|
|
||||||
if f(x) == true then x :: takeWhileS(f, xs)
|
|
||||||
else ""
|
|
||||||
end.
|
|
||||||
|
|
||||||
takeUntilS(f, xs) -> takeWhileS(\x -> op\not(f(x)), xs).
|
|
||||||
|
|
||||||
dropWhileS(f, "") -> "".
|
|
||||||
dropWhileS(f, x::xs) -> do
|
|
||||||
if f(x) == true then dropWhileS(f, xs)
|
|
||||||
else x :: xs
|
|
||||||
end.
|
|
||||||
|
|
||||||
dropS(0, x) -> x.
|
|
||||||
dropS(n, "") -> "".
|
|
||||||
dropS(n, _::xs) -> dropS(n-1, xs).
|
|
||||||
|
|
||||||
takeS(0, _) -> "".
|
|
||||||
takeS(n, "") -> "".
|
|
||||||
takeS(n, x::xs) -> x :: takeS(n-1, xs).
|
|
||||||
|
|
||||||
concat([]) -> "".
|
|
||||||
concat(x :: xs) -> x + concat(xs).
|
|
Loading…
Reference in New Issue