8171ead · elk · git.iko.soy

36-- MODULES

37

38

39−validate :: Module.Source -> Result wrn Module.Valid

39+validate :: Module.Source -> Result w Module.Valid

40validate (Module.Module name info) =

41 let

42 (ModuleName.Canonical pkgName _) =

79 -> Module.SourceSettings

80 -> [A.Commented Effects.PortRaw]

81 -> [A.Commented Src.ValidDef]

82− -> Result wrn Effects.Raw

82+ -> Result w Effects.Raw

83validateEffects tag settings@(A.A _ pairs) ports validDefs =

84 case tag of

85 Module.Normal ->

105 return (Effects.Manager () (Effects.Info tagRegion r0 r1 r2 managerType))

106

107

108−noSettings :: Error.Error -> Module.SourceSettings -> Result wrn ()

108+noSettings :: Error.Error -> Module.SourceSettings -> Result w ()

109noSettings errorMsg (A.A region settings) =

110 case settings of

111 [] ->

115 Result.throw region errorMsg

116

117

118−noPorts :: [A.Commented Effects.PortRaw] -> Result wrn ()

118+noPorts :: [A.Commented Effects.PortRaw] -> Result w ()

119noPorts ports =

120 case ports of

121 [] ->

132toManagerType

133 :: R.Region

134 -> Map.Map Text [(R.Region, A.Located Text)]

135− -> Result wrn Effects.RawManagerType

135+ -> Result w Effects.RawManagerType

136toManagerType tagRegion settingsDict =

137 let

138 toErrors name entries =

169extractOne

170 :: Text

171 -> Map.Map Text [(R.Region, A.Located Text)]

172− -> Result wrn (Maybe (A.Located Text))

172+ -> Result w (Maybe (A.Located Text))

173extractOne name settingsDict =

174 case Map.lookup name settingsDict of

175 Nothing ->

193 :: R.Region

194 -> Effects.RawManagerType

195 -> [A.Commented Src.ValidDef]

196− -> Result wrn (R.Region, R.Region, R.Region)

196+ -> Result w (R.Region, R.Region, R.Region)

197checkManager tagRegion managerType validDefs =

198 let

199 regionDict =

220 :: R.Region

221 -> Map.Map Text R.Region

222 -> Effects.RawManagerType

223− -> Result wrn ()

223+ -> Result w ()

224requireMaps tagRegion regionDict managerType =

225 let

226 check name =

238 check "cmdMap" <* check "subMap"

239

240

241−requireRegion :: R.Region -> Map.Map Text R.Region -> Text -> Result wrn R.Region

241+requireRegion :: R.Region -> Map.Map Text R.Region -> Text -> Result w R.Region

242requireRegion tagRegion regionDict name =

243 case Map.lookup name regionDict of

244 Just region ->

252-- COLLAPSE COMMENTS

253

254

255−collapseComments :: [D.CommentOr (A.Located a)] -> Result wrn [A.Commented a]

255+collapseComments :: [D.CommentOr (A.Located a)] -> Result w [A.Commented a]

256collapseComments listWithComments =

257 case listWithComments of

258 [] ->

282-- VALIDATE STRUCTURED SOURCE

283

284

285−validateDecls :: [D.Source] -> Result wrn ValidStuff

285+validateDecls :: [D.Source] -> Result w ValidStuff

286validateDecls sourceDecls =

287 do rawDecls <- collapseComments sourceDecls

288

307 }

308

309

310−validateRawDecls :: [A.Commented D.Raw] -> Result wrn ValidStuff

310+validateRawDecls :: [A.Commented D.Raw] -> Result w ValidStuff

311validateRawDecls commentedDecls =

312 vrdHelp commentedDecls [] (D.Decls [] [] [] [])

313

316 :: [A.Commented D.Raw]

317 -> [A.Commented Effects.PortRaw]

318 -> D.Valid

319− -> Result wrn ValidStuff

319+ -> Result w ValidStuff

320vrdHelp commentedDecls ports structure =

321 case commentedDecls of

322 [] ->

346 -> A.Commented Src.RawDef'

347 -> [A.Commented Effects.PortRaw]

348 -> D.Valid

349− -> Result wrn ValidStuff

349+ -> Result w ValidStuff

350vrdDefHelp remainingDecls (A.A ann def) ports structure =

351 let

352 addDef validDef (ValidStuff finalPorts struct) =

375-- VALIDATE DEFINITIONS

376

377

378−definitions :: [Src.RawDef] -> Result wrn [Src.ValidDef]

378+definitions :: [Src.RawDef] -> Result w [Src.ValidDef]

379definitions sourceDefs =

380 do validDefs <- definitionsHelp sourceDefs

381

387 return validDefs

388

389

390−definitionsHelp :: [Src.RawDef] -> Result wrn [Src.ValidDef]

390+definitionsHelp :: [Src.RawDef] -> Result w [Src.ValidDef]

391definitionsHelp sourceDefs =

392 case sourceDefs of

393 [] ->

415 -> Pattern.Raw

416 -> Src.RawExpr

417 -> Maybe Type.Raw

418− -> Result wrn Src.ValidDef

418+ -> Result w Src.ValidDef

419validateDef region pat expr maybeType =

420 do validExpr <- expression expr

421 validateDefPattern pat validExpr

423 return $ Src.Def region pat validExpr maybeType

424

425

426−validateDefPattern :: Pattern.Raw -> Src.ValidExpr -> Result wrn ()

426+validateDefPattern :: Pattern.Raw -> Src.ValidExpr -> Result w ()

427validateDefPattern pattern body =

428 case fst (Src.collectLambdas body) of

429 [] ->

442 Result.throw (R.merge start end) (Error.BadFunctionName (length args))

443

444

445−checkArguments :: Text -> [Pattern.Raw] -> Result wrn ()

445+checkArguments :: Text -> [Pattern.Raw] -> Result w ()

446checkArguments funcName args =

447 let

448 vars =

462-- VALIDATE EXPRESSIONS

463

464

465−expression :: Src.RawExpr -> Result wrn Src.ValidExpr

465+expression :: Src.RawExpr -> Result w Src.ValidExpr

466expression (A.A ann sourceExpression) =

467 A.A ann <$>

468 case sourceExpression of

532 return (Src.GLShader uid src gltipe)

533

534

535−second :: (a, Src.RawExpr) -> Result wrn (a, Src.ValidExpr)

535+second :: (a, Src.RawExpr) -> Result w (a, Src.ValidExpr)

536second (value, expr) =

537 (,) value <$> expression expr

538

539

540−both :: (Src.RawExpr, Src.RawExpr) -> Result wrn (Src.ValidExpr, Src.ValidExpr)

540+both :: (Src.RawExpr, Src.RawExpr) -> Result w (Src.ValidExpr, Src.ValidExpr)

541both (expr1, expr2) =

542 (,) <$> expression expr1 <*> expression expr2

543

544

545−checkDuplicateFields :: R.Region -> [(A.Located Text, a)] -> Result wrn ()

545+checkDuplicateFields :: R.Region -> [(A.Located Text, a)] -> Result w ()

546checkDuplicateFields recordRegion fields =

547 let

548 checkDups seenFields ( A.A region field, _ ) =

558-- VALIDATE PATTERNS

559

560

561−validatePattern :: Pattern.Raw -> Result wrn Pattern.Raw

561+validatePattern :: Pattern.Raw -> Result w Pattern.Raw

562validatePattern pattern =

563 do detectDuplicates Error.BadPattern (Pattern.boundVars pattern)

564 return pattern

568-- DETECT DUPLICATES

569

570

571−checkDuplicates :: ValidStuff -> Result wrn ()

571+checkDuplicates :: ValidStuff -> Result w ()

572checkDuplicates (ValidStuff ports (D.Decls defs unions aliases _)) =

573 let

574 -- SIMPLE NAMES

608 ]

609

610

611−detectDuplicates :: (Text -> Error.Error) -> [A.Located Text] -> Result wrn ()

611+detectDuplicates :: (Text -> Error.Error) -> [A.Located Text] -> Result w ()

612detectDuplicates tag names =

613 let

614 add (A.A region name) dict =

632-- UNBOUND TYPE VARIABLES

633

634

635−checkTypeVarsInUnion :: A.Commented (D.Union Type.Raw) -> Result wrn ()

635+checkTypeVarsInUnion :: A.Commented (D.Union Type.Raw) -> Result w ()

636checkTypeVarsInUnion (A.A (region,_) (D.Type name boundVars ctors)) =

637 do allFreeVars <- concat <$> traverse freeVars (concatMap snd ctors)

638 case diff boundVars allFreeVars of

644 (Error.UnboundTypeVarsInUnion name boundVars unbound)

645

646

647−checkTypeVarsInAlias :: A.Commented (D.Alias Type.Raw) -> Result wrn ()

647+checkTypeVarsInAlias :: A.Commented (D.Alias Type.Raw) -> Result w ()

648checkTypeVarsInAlias (A.A (region,_) (D.Type name boundVars tipe)) =

649 do allFreeVars <- freeVars tipe

650 case diff boundVars allFreeVars of

678 )

679

680

681−freeVars :: Type.Raw -> Result wrn [A.Located Text]

681+freeVars :: Type.Raw -> Result w [A.Located Text]

682freeVars (A.A region tipe) =

683 case tipe of

684 Type.RLambda t1 t2 ->

696 concat <$> traverse freeVars types

697

698

699−checkDuplicateFieldsInType :: Type.Raw -> Result wrn ()

699+checkDuplicateFieldsInType :: Type.Raw -> Result w ()

700checkDuplicateFieldsInType (A.A region tipe) =

701 case tipe of

702 Type.RLambda t1 t2 ->