gemini fixes

src/FWL/Check.hs

@@ -135,15 +135,35 @@ checkFlow env (FSeq a b _)   = checkFlow env a ++ checkFlow env b
 
 checkArm :: Env -> Arm -> [CheckError]
 checkArm env (Arm p mg e) =
+  let env' = addPat env p in
   checkPat env p ++
-  maybe [] (checkExpr env) mg ++
+  maybe [] (checkExpr env') mg ++
-  checkExpr env e
+  checkExpr env' e
+
+addPat :: Env -> Pat -> Env
+addPat env (PVar n)       = Map.insert n KLet env
+addPat env (PCtor _ ps)   = foldl' addPat env ps
+addPat env (PTuple ps)    = foldl' addPat env ps
+addPat env (PRecord _ fs) = foldl' addFP env fs
+addPat env (PFrame mp inner) =
+  let env' = case mp of
+        Just (PathPat ms md) ->
+          let env1 = case ms of Just (EPName n) -> Map.insert n KLet env; _ -> env
+          in case md of Just (EPName n) -> Map.insert n KLet env1; _ -> env1
+        Nothing -> env
+  in addPat env' inner
+addPat env _              = env
+
+addFP :: Env -> FieldPat -> Env
+addFP env (FPBind n) = Map.insert n KLet env
+addFP env (FPAs _ v) = Map.insert v KLet env
+addFP env _          = env
 
 checkExpr :: Env -> Expr -> [CheckError]
 checkExpr env (EVar n)         = checkName env "name" n
 checkExpr _   (EQual _)        = []   -- qualified names: deferred
 checkExpr _   (ELit _)         = []
-checkExpr env (ELam _ e)       = checkExpr env e
+checkExpr env (ELam n e)       = checkExpr (Map.insert n KLet env) e
 checkExpr env (EApp f x)       = checkExpr env f ++ checkExpr env x
 checkExpr env (ECase e ab)     = checkExpr env e ++ concatMap (checkArm env) ab
 checkExpr env (EIf c t f)      = concatMap (checkExpr env) [c,t,f]
@@ -157,7 +177,7 @@ checkExpr env (EInfix _ l r)   = checkExpr env l ++ checkExpr env r
 checkExpr env (ENot e)         = checkExpr env e
 
 checkStmt :: Env -> DoStmt -> [CheckError]
-checkStmt env (DSBind _ e) = checkExpr env e
+checkStmt env (DSBind n e) = checkExpr env e
 checkStmt env (DSExpr e)   = checkExpr env e
 
 -- ─── Policy termination ───────────────────────────────────────────────────────

src/FWL/Compile.hs

@@ -301,9 +301,8 @@ renderLit (LInt n)              = show n
 renderLit (LString s)           = s
 renderLit (LBool True)          = "true"
 renderLit (LBool False)         = "false"
-renderLit (LIPv4 (a, b, c, d))  =
+renderLit (LIP IPv4 n)          = renderIPv4 n
-  show a ++ "." ++ show b ++ "." ++ show c ++ "." ++ show d
+renderLit (LIP IPv6 n)          = renderIPv6 n
-renderLit (LIPv6 _)             = "::1"
 renderLit (LCIDR ip p)          = renderLit ip ++ "/" ++ show p
 renderLit (LPort p)             = show p
 renderLit (LDuration n Seconds) = show n ++ "s"

src/FWL/Parser.hs

@@ -3,7 +3,7 @@ module FWL.Parser
   , parseFile
   ) where
 
-import Control.Monad (void)
+import Control.Monad (void, when)
 import Data.Bits ((.&.), (.|.), shiftL)
 import Data.List (foldl')
 import Data.Word (Word8)
@@ -15,6 +15,7 @@ import qualified Text.Parsec.Expr as Ex
 
 import FWL.AST
 import FWL.Lexer
+import Data.Char (isUpper)
 
 -- ─── Entry points ────────────────────────────────────────────────────────────
 
@@ -37,7 +38,7 @@ program = do
 configBlock :: Parser Config
 configBlock = do
   reserved "config"
-  props <- braces (semiSep configProp)
+  props <- braces (endBy configProp semi)
   optional semi
   return $ foldr applyProp defaultConfig props
   where
@@ -330,13 +331,12 @@ fieldLiteral = try portLit <|> literal
       n <- fromIntegral <$> natural
       return (LPort n)
 
--- Named pattern reference OR constructor: starts with uppercase-ish ident
 namedOrCtorPat :: Parser Pat
 namedOrCtorPat = do
   n  <- identifier
   args <- optionMaybe (try (parens (commaSep pat)))
   case args of
-    Nothing -> return (PNamed n)   -- bare name = named pattern ref
+    Nothing -> return $ if null n then PWild else if isUpper (head n) then PNamed n else PVar n
     Just ps -> return (PCtor  n ps)
 
 -- ─── Flow expressions ────────────────────────────────────────────────────────
@@ -346,13 +346,17 @@ flowExpr = do
   first <- FAtom <$> identifier
   rest  <- many (reservedOp "." >> identifier)
   mw    <- optionMaybe (reserved "within" >> durationLit)
-  return $ buildSeq (first : map FAtom rest) mw
+  let chain = buildSeq (first : map FAtom rest)
+  return $ case mw of
+    Nothing -> chain
+    Just w  -> attach w chain
   where
-    buildSeq [x]    mw = case mw of
+    buildSeq [x]    = x
-                           Nothing -> x
+    buildSeq (x:xs) = FSeq x (buildSeq xs) Nothing
-                           Just w  -> FSeq x x (Just w)  -- degenerate
+    buildSeq []     = error "impossible"
-    buildSeq (x:xs) mw = FSeq x (buildSeq xs mw) mw
+
-    buildSeq []     _  = error "impossible"
+    attach w (FSeq a b _) = FSeq a b (Just w)
+    attach w x            = FSeq x x (Just w)
 
 durationLit :: Parser Duration
 durationLit = do
@@ -588,17 +592,18 @@ ipv4Lit_ = do
 -- Stores as LIP IPv6 (128-bit Integer).
 ipv6Lit :: Parser Literal
 ipv6Lit = do
-  (left, right) <- ipv6Groups
+  (left, hasDbl, right) <- ipv6Groups
   let missing   = 8 - length left - length right
   when (missing < 0) $ fail "too many groups in IPv6 address"
+  when (not hasDbl && missing /= 0) $ fail "invalid IPv6 address (must have 8 groups or use ::)"
   let groups    = left ++ replicate missing 0 ++ right
   when (length groups /= 8) $ fail "invalid IPv6 address"
   let val = foldl' (\acc g -> (acc `shiftL` 16) .|. fromIntegral g) (0::Integer) groups
   return (LIP IPv6 val)
 
--- Returns (left-of-::, right-of-::).
+-- Returns (left-of-::, has_dbl_colon, right-of-::).
 -- If no :: present, left has all 8 groups and right is empty.
-ipv6Groups :: Parser ([Int], [Int])
+ipv6Groups :: Parser ([Int], Bool, [Int])
 ipv6Groups = do
   -- must start with a hex digit or ':' (for ::)
   ahead <- lookAhead (hexDigit <|> char ':')
@@ -606,15 +611,15 @@ ipv6Groups = do
     ':' -> do
       void (string "::")
       right <- ipv6RightGroups
-      return ([], right)
+      return ([], True, right)
     _   -> do
       left <- ipv6LeftGroups
       mDbl <- optionMaybe (try (string "::"))
       case mDbl of
-        Nothing -> return (left, [])
+        Nothing -> return (left, False, [])
         Just _  -> do
           right <- ipv6RightGroups
-          return (left, right)
+          return (left, True, right)
 
 -- Parse a run of hex16:hex16:... stopping before :: or end
 ipv6LeftGroups :: Parser [Int]

src/FWL/Pretty.hs

@@ -49,8 +49,6 @@ prettyIfaceProp (IPCidr4 cs) = "cidr4 = { " ++ intercalate ", " (map prettyCidr
 prettyIfaceProp (IPCidr6 cs) = "cidr6 = { " ++ intercalate ", " (map prettyCidr cs) ++ " }"
 
 prettyCidr :: CIDR -> String
-prettyCidr (LIPv4 (a,b,c,d), p) =
-  show a ++ "." ++ show b ++ "." ++ show c ++ "." ++ show d ++ "/" ++ show p
 prettyCidr (ip, p) = prettyLit ip ++ "/" ++ show p
 
 prettyHook :: Hook -> String
@@ -178,9 +176,8 @@ prettyLit (LInt n)           = show n
 prettyLit (LString s)        = "\"" ++ s ++ "\""
 prettyLit (LBool True)       = "true"
 prettyLit (LBool False)      = "false"
-prettyLit (LIPv4 (a,b,c,d))  =
+prettyLit (LIP IPv4 n)       = renderIPv4 n
-  show a ++ "." ++ show b ++ "." ++ show c ++ "." ++ show d
+prettyLit (LIP IPv6 n)       = renderIPv6 n
-prettyLit (LIPv6 _)          = "<ipv6>"
 prettyLit (LCIDR ip p)       = prettyLit ip ++ "/" ++ show p
 prettyLit (LPort p)          = ":" ++ show p
 prettyLit (LDuration n u)    = show n ++ prettyUnit u

test/ParserTests.hs

@@ -37,7 +37,7 @@ interfaceTests = testGroup "interface"
       p <- parseOk "interface lan : LAN { cidr4 = { 10.0.0.0/8 }; };"
       d <- singleDecl p
       case d of
-        DInterface "lan" ILan [IPCidr4 [(LIPv4 (10,0,0,0), 8)]] -> return ()
+        DInterface "lan" ILan [IPCidr4 [(ip, 8)]] | ip == ipv4Lit 10 0 0 0 -> return ()
         _ -> assertFailure (show d)
 
   , testCase "LAN with cidr4 and cidr6" $ do
@@ -165,7 +165,7 @@ patternTests = testGroup "pattern"
             \  Frame(_, IPv4(ip, WGInitiation));"
       d <- singleDecl p
       case d of
-        DPattern "Complex" _ (PFrame Nothing (PCtor "IPv4" [PVar "ip", PNamed "WGInitiation"])) ->
+        DPattern "Complex" _ (PFrame (Just _) (PCtor "IPv4" [PVar "ip", PNamed "WGInitiation"])) ->
           return ()
         _ -> assertFailure (show d)
 
@@ -407,7 +407,7 @@ policyTests = testGroup "policy"
             \  };"
       d <- singleDecl p
       case d of
-        DPolicy _ _ _ (Arm (PFrame Nothing (PCtor "IPv4" _)) _ _ : _) -> return ()
+        DPolicy _ _ _ (Arm (PFrame (Just _) (PCtor "IPv4" _)) _ _ : _) -> return ()
         _ -> assertFailure (show d)
 
   , testCase "policy arm calls rule" $ do