re-fix eval
This commit is contained in:
parent
cecff93c3c
commit
e053443bbe
3 changed files with 19 additions and 15 deletions
|
@ -31,18 +31,21 @@ infer ctx (List (expr:exprs)) = do
|
||||||
Right _ -> return $ LList t
|
Right _ -> return $ LList t
|
||||||
infer ctx (Atom a) = case Map.lookup a ctx of
|
infer ctx (Atom a) = case Map.lookup a ctx of
|
||||||
Just t -> return t
|
Just t -> return t
|
||||||
Nothing -> return LAtom
|
Nothing -> Left . TypeError $ "Undefined atom: " <> toS a
|
||||||
infer ctx (Fn params body _ types) = do
|
infer ctx (Fn parameters fnbody _ (ptypes,retType)) = do
|
||||||
let newCtx = Map.union ctx (Map.frommList (zip params (fst types)))
|
let newCtx = Map.union ctx (Map.fromList (zip parameters ptypes))
|
||||||
check newCtx body (snd type) >>= return $ LFn (fst types) (snd types)
|
checkType newCtx fnbody retType
|
||||||
infer ctx (Lambda (Fn params _ _ (ptypes,retType)):exprs) =
|
return $ LFn ptypes retType
|
||||||
if length params /= length exprs
|
infer ctx (Lambda ((Fn fnparams _ _ (ptypes,retType)):exprs)) =
|
||||||
|
if length fnparams /= length exprs
|
||||||
then Left (TypeError "Fn applied to the wrong number of parameters")
|
then Left (TypeError "Fn applied to the wrong number of parameters")
|
||||||
else do
|
else do
|
||||||
types <- map (infer ctx) params
|
inferedTypes <- mapM (infer ctx) exprs
|
||||||
if types /= ptypes
|
if inferedTypes /= ptypes
|
||||||
then Left (TypeError ("Expected " <> show ptypes <> " bug got " <> types))
|
then Left . TypeError $ "Expected " <> show ptypes
|
||||||
|
<> " bug got " <> show inferedTypes
|
||||||
else return retType
|
else return retType
|
||||||
|
infer _ (Lambda _) = Left . TypeError $ "First element of a lambda must be a Fn or a Command"
|
||||||
infer _ sexp = Left . TypeError $ "can't infer the type of " <> show sexp
|
infer _ sexp = Left . TypeError $ "can't infer the type of " <> show sexp
|
||||||
|
|
||||||
-- | Check the type of some expression regarding a type context
|
-- | Check the type of some expression regarding a type context
|
||||||
|
@ -83,7 +86,7 @@ reduceLambda (Lambda (expr:exprs)) = do
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
reducedArgs <- mapM reduceLambda exprs
|
reducedArgs <- mapM reduceLambda exprs
|
||||||
executeShell (Lambda ((Atom f):reducedArgs))
|
executeShell (Lambda ((Atom f):reducedArgs))
|
||||||
f@(Fn _ _ _) -> applyFn f exprs
|
f@(Fn _ _ _ _) -> applyFn f exprs
|
||||||
s -> do
|
s -> do
|
||||||
reducedArgs <- mapM reduceLambda exprs
|
reducedArgs <- mapM reduceLambda exprs
|
||||||
executeShell (Lambda (s:reducedArgs))
|
executeShell (Lambda (s:reducedArgs))
|
||||||
|
@ -95,7 +98,7 @@ reduceLambda (Atom x) = do
|
||||||
reduceLambda x = return x
|
reduceLambda x = return x
|
||||||
|
|
||||||
applyFn :: SExp -> ReduceUnawareCommand
|
applyFn :: SExp -> ReduceUnawareCommand
|
||||||
applyFn (Fn par bod clos) args =
|
applyFn (Fn par bod clos _) args =
|
||||||
if length par /= length args
|
if length par /= length args
|
||||||
then shellErr "wrong number of arguments"
|
then shellErr "wrong number of arguments"
|
||||||
else do
|
else do
|
||||||
|
@ -112,8 +115,8 @@ tryEnvCommand :: Text -> [SExp] -> StateT Env IO (Maybe SExp)
|
||||||
tryEnvCommand f args = do
|
tryEnvCommand f args = do
|
||||||
envcmd <- get
|
envcmd <- get
|
||||||
case Map.lookup f envcmd of
|
case Map.lookup f envcmd of
|
||||||
Just fn@(Fn _ _ _) -> Just <$> (applyFn fn args)
|
Just fn@(Fn _ _ _ _) -> Just <$> (applyFn fn args)
|
||||||
_ -> return Nothing
|
_ -> return Nothing
|
||||||
|
|
||||||
|
|
||||||
tryInternalCommand :: Text -> [SExp] -> StateT Env IO (Maybe SExp)
|
tryInternalCommand :: Text -> [SExp] -> StateT Env IO (Maybe SExp)
|
||||||
|
|
|
@ -134,6 +134,7 @@ fn reducer (p:bodies) = do
|
||||||
then return (Fn { params = catMaybes parameters
|
then return (Fn { params = catMaybes parameters
|
||||||
, body = Lambda $ (Atom "do"):bodies
|
, body = Lambda $ (Atom "do"):bodies
|
||||||
, closure = mempty
|
, closure = mempty
|
||||||
|
, types = ([],LCommand)
|
||||||
})
|
})
|
||||||
else return Void
|
else return Void
|
||||||
_ -> return Void
|
_ -> return Void
|
||||||
|
|
|
@ -38,7 +38,7 @@ data SExp = Atom Text
|
||||||
| WaitingStream CmdStream
|
| WaitingStream CmdStream
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show)
|
||||||
|
|
||||||
data LishType = LAtom
|
data LishType = LCommand
|
||||||
| LNum
|
| LNum
|
||||||
| LBool
|
| LBool
|
||||||
| LStr
|
| LStr
|
||||||
|
@ -57,7 +57,7 @@ repr (Str s) = "\"" <> toS s <> "\""
|
||||||
repr (List sexprs) = "[" <> (Text.intercalate " " (map repr sexprs)) <> "]"
|
repr (List sexprs) = "[" <> (Text.intercalate " " (map repr sexprs)) <> "]"
|
||||||
repr (Lambda sexprs) = "(" <> (Text.intercalate " " (map repr sexprs)) <> ")"
|
repr (Lambda sexprs) = "(" <> (Text.intercalate " " (map repr sexprs)) <> ")"
|
||||||
repr Void = "ε"
|
repr Void = "ε"
|
||||||
repr (Fn p _ _) = "(λ" <> (Text.intercalate "." p) <> ". ... )"
|
repr (Fn p _ _ _) = "(λ" <> (Text.intercalate "." p) <> ". ... )"
|
||||||
repr (Stream _) = "<stream>"
|
repr (Stream _) = "<stream>"
|
||||||
repr (WaitingStream _) = "<w-stream>"
|
repr (WaitingStream _) = "<w-stream>"
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue