From 5c2a024607b12f9b692a907378d0b5537561bfcc Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 23 Jan 2017 12:33:13 -0500 Subject: [PATCH] Match against the category and children in one go. --- src/Language/Go.hs | 80 +++++++++++++++++++++++----------------------- 1 file changed, 40 insertions(+), 40 deletions(-) diff --git a/src/Language/Go.hs b/src/Language/Go.hs index 497c8277d..114a2629b 100644 --- a/src/Language/Go.hs +++ b/src/Language/Go.hs @@ -15,20 +15,20 @@ termAssignment -> Record '[Range, Category, SourceSpan] -- ^ The proposed annotation for the term. -> [ SyntaxTerm Text '[Range, Category, SourceSpan] ] -- ^ The child nodes of the term. -> Maybe (SyntaxTerm Text '[Range, Category, SourceSpan]) -- ^ The resulting term, in IO. -termAssignment source (range :. category :. sourceSpan :. Nil) children = Just $ case category of - Return -> withDefaultInfo $ S.Return children - Module -> case Prologue.break (\node -> Info.category (extract node) == Other "package_clause") children of +termAssignment source (range :. category :. sourceSpan :. Nil) children = Just $ case (category, children) of + (Return, _) -> withDefaultInfo $ S.Return children + (Module, _) -> case Prologue.break (\node -> Info.category (extract node) == Other "package_clause") children of (comments, packageName : rest) -> case unwrap packageName of S.Indexed [id] -> let module' = withCategory Module (S.Module id rest) in withCategory Program (S.Indexed (comments <> [module'])) _ -> withRanges range Error children (S.Error children) _ -> withRanges range Error children (S.Error children) - Other "import_declaration" -> toImports children - Function -> withDefaultInfo $ case children of + (Other "import_declaration", _) -> toImports children + (Function, _) -> withDefaultInfo $ case children of [id, params, block] -> S.Function id (toList $ unwrap params) (toList $ unwrap block) rest -> S.Error rest - For -> + (For, _) -> withDefaultInfo $ case children of [body] | Info.category (extract body) == Other "block" -> S.For [] (toList $ unwrap body) @@ -37,10 +37,10 @@ termAssignment source (range :. category :. sourceSpan :. Nil) children = Just $ [rangeClause, body] | Info.category (extract rangeClause) == Other "range_clause" -> S.For (toList $ unwrap rangeClause) (toList $ unwrap body) other -> S.Error other - TypeDecl -> toTypeDecl children - StructTy -> toStructTy children - FieldDecl -> toFieldDecl children - Switch -> + (TypeDecl, _) -> toTypeDecl children + (StructTy, _) -> toStructTy children + (FieldDecl, _) -> toFieldDecl children + (Switch, _) -> case Prologue.break isCaseClause children of (clauses, cases) -> withDefaultInfo $ case clauses of [id] -> S.Switch (Just id) cases -- type_switch_statement @@ -54,63 +54,63 @@ termAssignment source (range :. category :. sourceSpan :. Nil) children = Just $ [] -> withCategory DefaultCase $ S.DefaultCase rest rest -> withCategory Error $ S.Error rest [] -> withCategory Error $ S.Error [clause] - ParameterDecl -> withDefaultInfo $ case children of + (ParameterDecl, _) -> withDefaultInfo $ case children of [param, ty] -> S.ParameterDecl (Just ty) param [param] -> S.ParameterDecl Nothing param _ -> S.Error children - Assignment -> toVarAssignment children - Select -> withDefaultInfo $ S.Select (toCommunicationCase =<< children) + (Assignment, _) -> toVarAssignment children + (Select, _) -> withDefaultInfo $ S.Select (toCommunicationCase =<< children) where toCommunicationCase = toList . unwrap - Go -> withDefaultInfo $ toExpression S.Go children - Defer -> withDefaultInfo $ toExpression S.Defer children - SubscriptAccess -> withDefaultInfo $ toSubscriptAccess children - IndexExpression -> withDefaultInfo $ toSubscriptAccess children - Slice -> sliceToSubscriptAccess children - Other "composite_literal" -> toLiteral children - TypeAssertion -> withDefaultInfo $ case children of + (Go, _) -> withDefaultInfo $ toExpression S.Go children + (Defer, _) -> withDefaultInfo $ toExpression S.Defer children + (SubscriptAccess, _) -> withDefaultInfo $ toSubscriptAccess children + (IndexExpression, _) -> withDefaultInfo $ toSubscriptAccess children + (Slice, _) -> sliceToSubscriptAccess children + (Other "composite_literal", _) -> toLiteral children + (TypeAssertion, _) -> withDefaultInfo $ case children of [a, b] -> S.TypeAssertion a b rest -> S.Error rest - TypeConversion -> withDefaultInfo $ case children of + (TypeConversion, _) -> withDefaultInfo $ case children of [a, b] -> S.TypeConversion a b rest -> S.Error rest -- TODO: Handle multiple var specs - Other "var_declaration" -> toVarDecls children - VarAssignment -> toVarAssignment children - VarDecl -> toVarAssignment children - If -> toIfStatement children - FunctionCall -> withDefaultInfo $ case children of + (Other "var_declaration", _) -> toVarDecls children + (VarAssignment, _) -> toVarAssignment children + (VarDecl, _) -> toVarAssignment children + (If, _) -> toIfStatement children + (FunctionCall, _) -> withDefaultInfo $ case children of [id] -> S.FunctionCall id [] id : rest -> S.FunctionCall id rest rest -> S.Error rest - Other "const_declaration" -> toConsts children - AnonymousFunction -> withDefaultInfo $ case children of + (Other "const_declaration", _) -> toConsts children + (AnonymousFunction, _) -> withDefaultInfo $ case children of [params, _, body] -> case toList (unwrap params) of [params'] -> S.AnonymousFunction (toList $ unwrap params') (toList $ unwrap body) rest -> S.Error rest rest -> S.Error rest - PointerTy -> withDefaultInfo $ case children of + (PointerTy, _) -> withDefaultInfo $ case children of [ty] -> S.Ty ty rest -> S.Error rest - ChannelTy -> withDefaultInfo $ case children of + (ChannelTy, _) -> withDefaultInfo $ case children of [ty] -> S.Ty ty rest -> S.Error rest - Send -> withDefaultInfo $ case children of + (Send, _) -> withDefaultInfo $ case children of [channel, expr] -> S.Send channel expr rest -> S.Error rest - Operator -> withDefaultInfo $ S.Operator children - FunctionTy -> + (Operator, _) -> withDefaultInfo $ S.Operator children + (FunctionTy, _) -> let params = withRanges range Params children $ S.Indexed children in withDefaultInfo $ S.Ty params - IncrementStatement -> + (IncrementStatement, _) -> withDefaultInfo $ S.Leaf $ toText source - DecrementStatement -> + (DecrementStatement, _) -> withDefaultInfo $ S.Leaf $ toText source - QualifiedIdentifier -> + (QualifiedIdentifier, _) -> withDefaultInfo $ S.Leaf $ toText source - Break -> toBreak children - Continue -> toContinue children - Pair -> toPair children - Method -> toMethod children + (Break, _) -> toBreak children + (Continue, _) -> toContinue children + (Pair, _) -> toPair children + (Method, _) -> toMethod children _ -> withDefaultInfo $ case children of [] -> S.Leaf $ toText source _ -> S.Indexed children