diff --git a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs b/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs index 326d85b0..0c1e8d22 100644 --- a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs +++ b/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs @@ -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 ]