picnoir
/
hnix
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge pull request #10 from jwiegley/formals 

Formal parameters
This commit is contained in:
John Wiegley 2014-08-05 13:15:02 -04:00
parent 149ae51d60 9f07afd101
commit a3f1a41ef8
4 changed files with 76 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Nix/Eval.hs
View File

@ -41,7 +41,7 @@ evalExpr = cata phi
-- Fix . NVConstant . NStr . T.concat
-- <$> mapM (fmap valueText . ($ env)) l
phi (NArgSet s) = \env -> Fix . NVArgSet <$> mapM (T.sequence . fmap ($ env)) s
phi (NArgs s) = \env -> Fix . NVArgSet <$> mapM (T.sequence . fmap ($ env)) (formalsAsMap s)
-- TODO: recursive sets
phi (NSet _b binds) = \env ->

59
Nix/Parser.hs
View File

@ -101,21 +101,11 @@ nixIf = fmap Fix $ NIf
-- or a lambda until we've looked ahead a bit. And then it may be neither,
-- in which case we fall back to expected a plain string or identifier.
setLambdaStringOrSym :: Bool -> Parser NExpr
setLambdaStringOrSym allowLambdas = do
isSetOrArgs <- try (lookAhead (reserved "rec") *> pure True)
<|> try (lookAhead (singleton <$> char '{') *> pure True)
<|> pure False
if isSetOrArgs
then setOrArgs
else do
y <- try (lookAhead (True <$ (identifier *> whiteSpace
*> symbolic ':')))
<|> return False
if y
then if allowLambdas
then setOrArgs
else error "Unexpected lambda"
else keyName <?> "string"
setLambdaStringOrSym True = try nixLambda <|> setLambdaStringOrSym False
setLambdaStringOrSym False = try nixSet <|> keyName
nixLambda :: Parser NExpr
nixLambda = Fix <$> (NAbs <$> (argExpr <?> "arguments") <*> nixApp)
stringish :: Parser NExpr
stringish = (char '"' *> (merge <$> manyTill stringChar (char '"')))
@ -128,13 +118,18 @@ stringish = (char '"' *> (merge <$> manyTill stringChar (char '"')))
<|> (mkStr . pack <$> many (noneOf "\"\\"))
argExpr :: Parser NExpr
argExpr = (Fix . NArgSet . Map.fromList <$> argList)
<|> ((mkSym <$> identifier) <?> "argname")
argExpr = (try (Fix . NArgs . FormalSet <$> paramSet)
<|> try (Fix . NArgs . FormalName <$> identifier <* whiteSpace)
<|> try (Fix . NArgs <$> (FormalLeftAt <$> identifier <* whiteSpace <*> paramSet))
<|> try (Fix . NArgs <$> (FormalRightAt <$> paramSet <*> identifier <* whiteSpace))) <* symbolic ':'
where
argList = braces ((argName <* whiteSpace) `sepBy` symbolic ',')
paramSet :: Parser (FormalParamSet NExpr)
paramSet = (FormalParamSet . Map.fromList <$> argList)
argList :: Parser [(Text, Maybe NExpr)]
argList = braces ((argName <* whiteSpace) `sepBy` symbolic ',') <* symbolic ':'
<?> "arglist"
argName = (,) <$> (identifier <* whiteSpace)
argName :: Parser (Text, Maybe NExpr)
argName = (,) <$> (identifier <* whiteSpace)
<*> optional (symbolic '?' *> nixExpr False)
nixBinders :: Parser [Binding NExpr]
@ -147,27 +142,9 @@ nixBinders = (scopedInherit <|> inherit <|> namedVar) `endBy` symbolic ';' where
keyName :: Parser NExpr
keyName = (stringish <|> (mkSym <$> identifier)) <* whiteSpace
setOrArgs :: Parser NExpr
setOrArgs = do
sawRec <- try (reserved "rec" *> pure True) <|> pure False
haveSet <-
if sawRec
then return True
else try (lookAhead lookaheadForSet)
if haveSet
then braces (Fix . NSet (if sawRec then Rec else NonRec) <$> nixBinders) <?> "set"
else do
args <- argExpr <?> "arguments"
symbolic ':' *> fmap Fix (NAbs <$> pure args <*> nixApp)
<|> pure args
lookaheadForSet :: Parser Bool
lookaheadForSet = do
x <- (symbolic '{' *> return True) <|> return False
if not x then return x else do
y <- (keyName *> return True) <|> return False
if not y then return y else
(symbolic '=' *> return True) <|> return False
nixSet :: Parser NExpr
nixSet = Fix <$> (NSet <$> isRec <*> (braces nixBinders <?> "set")) where
isRec = try (reserved "rec" *> pure Rec) <|> pure NonRec
parseNixFile :: MonadIO m => FilePath -> m (Result NExpr)
parseNixFile = parseFromFileEx nixApp

11
Nix/Pretty.hs
View File

@ -10,6 +10,15 @@ prettyBind (NamedVar n v) = prettyNix n <+> equals <+> prettyNix v <> semi
prettyBind (Inherit ns) = text "inherit" <+> fillSep (map prettyNix ns) <> semi
prettyBind (ScopedInherit s ns) = text "inherit" <+> parens (prettyNix s) <+> fillSep (map prettyNix ns) <> semi
prettyFormals :: Formals -> Doc
prettyFormals (FormalName n) = text $ unpack n
prettyFormals (FormalSet s) =prettyParamSet s
prettyFormals (FormalLeftAt s n) = prettyParamSet s <> text "@" <> text (unpack n)
prettyFormals (FormalRightAt n s) text (unpack n) <> text "@" <> prettyParamSet s
prettyParamSet :: FormalParamSet -> Doc
prettyParamSet s = lbrace <+> hcat (map prettySetArg $ toList args) <+> rbrace
prettySetArg :: (Text, Maybe NExpr) -> Doc
prettySetArg (n, Nothing) = text (unpack n)
prettySetArg (n, Just v) = text (unpack n) <+> text "?" <+> prettyNix v
@ -50,7 +59,7 @@ prettyNix (Fix expr) = go expr where
go (NOper oper) = prettyOper oper
go (NList xs) = lbracket <+> fillSep (map prettyNix xs) <+> rbracket
go (NArgSet args) = lbrace <+> vcat (map prettySetArg $ toList args) <+> rbrace
go (NArgs fs) = prettyFormals fs
go (NSet rec xs) =
(case rec of Rec -> "rec"; NonRec -> empty)

59
Nix/Types.hs
View File

@ -1,3 +1,10 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE OverloadedStrings #-}
module Nix.Types where
import Control.Monad hiding (forM_, mapM, sequence)
@ -106,7 +113,43 @@ data Binding r = NamedVar r r | Inherit [r] | ScopedInherit r [r]
instance Show r => Show (Binding r) where
show (NamedVar name val) = show name ++ " = " ++ show val ++ ";"
show (Inherit names) = "inherit " ++ concatMap show names ++ ";"
show (ScopedInherit context names) = "inherit (" ++ show context ++ ") " ++ concatMap show names ++ "; "
show (ScopedInherit context names) = "inherit (" ++ show context ++ ") " ++ concatMap show names ++ ";"
data FormalParamSet r = FormalParamSet (Map Text (Maybe r))
deriving (Eq, Ord, Generic, Typeable, Data, Functor)
instance Show r => Show (FormalParamSet r) where
show (FormalParamSet h) = "{ " ++ go (Map.toList h) ++ " }"
where
go [] = ""
go [x] = showArg x
go (x:xs) = showArg x ++ ", " ++ go xs
showArg (k, Nothing) = unpack k
showArg (k, Just v) = unpack k ++ " ? " ++ show v
-- | @Formals@ represents all the ways the formal parameters to a
-- function can be represented.
data Formals r =
FormalName Text |
FormalSet (FormalParamSet r) |
FormalLeftAt Text (FormalParamSet r) |
FormalRightAt (FormalParamSet r) Text
deriving (Ord, Eq, Generic, Typeable, Data, Functor)
instance Show r => Show (Formals r) where
show (FormalName n) = show n
show (FormalSet s) = show s
show (FormalLeftAt n s) = show n ++ "@" ++ show s
show (FormalRightAt s n) = show s ++ "@" ++ show n
-- | @formalsAsMap@ combines the outer and inner name bindings of
-- 'Formals'
formalsAsMap :: Formals r -> Map Text (Maybe r)
formalsAsMap (FormalName n) = Map.singleton n Nothing
formalsAsMap (FormalSet (FormalParamSet s)) = s
formalsAsMap (FormalLeftAt n (FormalParamSet s)) = Map.insert n Nothing s
formalsAsMap (FormalRightAt (FormalParamSet s) n) = Map.insert n Nothing s
data NExprF r
= NConstant NAtom
@ -115,7 +158,7 @@ data NExprF r
| NList [r]
-- ^ A "concat" is a list of things which must combine to form a string.
| NArgSet (Map Text (Maybe r))
| NArgs (Formals r)
| NSet NSetBind [Binding r]
| NLet [Binding r] r
@ -145,15 +188,7 @@ instance Show f => Show (NExprF f) where
go [x] = show x
go (x:xs) = show x ++ ", " ++ go xs
show (NArgSet h) = "{ " ++ go (Map.toList h) ++ " }"
where
go [] = ""
go [x] = showArg x
go (x:xs) = showArg x ++ ", " ++ go xs
showArg (k, Nothing) = unpack k
showArg (k, Just v) = unpack k ++ " ? " ++ show v
show (NArgs fs) = show fs
show (NSet b xs) = show b ++ " { " ++ concatMap show xs ++ " }"
show (NLet v e) = "let " ++ show v ++ "; " ++ show e
@ -170,7 +205,7 @@ dumpExpr = cata phi where
phi (NConstant x) = "NConstant " ++ show x
phi (NOper x) = "NOper " ++ show x
phi (NList l) = "NList [" ++ show l ++ "]"
phi (NArgSet xs) = "NArgSet " ++ show xs
phi (NArgs xs) = "NArgs " ++ show xs
phi (NSet b xs) = "NSet " ++ show b ++ " " ++ show xs
phi (NLet v e) = "NLet " ++ show v ++ " " ++ e
phi (NIf i t e) = "NIf " ++ i ++ " " ++ t ++ " " ++ e