mirror of https://github.com/voidlizard/hbs2
bf6 [fn a b . expr] form
This commit is contained in:
parent
8ddc02560f
commit
f66a587a2f
|
@ -302,15 +302,26 @@ lambdaArgList :: Syntax c -> Maybe [Id]
|
|||
lambdaArgList (ListVal a) = sequence argz
|
||||
where
|
||||
argz = flip fmap a \case
|
||||
(SymbolVal x) -> Just x
|
||||
_ -> Nothing
|
||||
(SymbolVal x) | x `notElem` [".","_"] -> Just x
|
||||
_ -> Nothing
|
||||
|
||||
lambdaArgList _ = Nothing
|
||||
|
||||
pattern ArgList :: [Id] -> [Syntax c]
|
||||
pattern ArgList a <- (argList -> Just a)
|
||||
|
||||
argList :: [Syntax c] -> Maybe [Id]
|
||||
argList syn = sequence argz
|
||||
where
|
||||
argz = flip fmap syn \case
|
||||
(SymbolVal x) | x `notElem` [".","_"] -> Just x
|
||||
_ -> Nothing
|
||||
|
||||
|
||||
pattern PairList :: [Syntax c] -> [Syntax c]
|
||||
pattern PairList es <- (pairList -> es)
|
||||
|
||||
|
||||
pairList :: [Syntax c ] -> [Syntax c]
|
||||
pairList syn = [ isPair s | s <- syn ] & takeWhile isJust & catMaybes
|
||||
|
||||
|
@ -763,6 +774,21 @@ eval' dict0 syn' = handle (handleForm syn') $ do
|
|||
atomically $ modifyTVar t (HM.insert name b)
|
||||
pure nil
|
||||
|
||||
w@(ListVal (SymbolVal "fn" : a@(SymbolVal{}) : rest)) -> do
|
||||
let dot = mkSym "."
|
||||
let (aa, body') = List.break (== dot) rest
|
||||
& over _2 (List.dropWhile (==dot))
|
||||
|
||||
args <- argList (a:aa) & \case
|
||||
Nothing -> throwIO (BadFormException @c w)
|
||||
Just xs -> pure xs
|
||||
|
||||
body <- case body' of
|
||||
[e] -> pure e
|
||||
_ -> throwIO (BadFormException @c w)
|
||||
|
||||
pure $ mkForm @c "lambda" [ mkList (fmap mkSym args), body ]
|
||||
|
||||
ListVal [SymbolVal "fn", LitIntVal n, body] -> do
|
||||
pure $ mkForm @c "lambda" [ mkList [ mkSym ("_" <> show i) | i <- [1..n] ], body ]
|
||||
|
||||
|
|
Loading…
Reference in New Issue