├── data └── foo.inc ├── Setup.hs ├── .hlint.yaml ├── cabal.project ├── .gitmodules ├── stack.yaml ├── app ├── Main.hs ├── MainPrecedence.hs ├── MainExpr.hs └── MainRepetitive2.hs ├── ChangeLog.md ├── src └── Language │ └── Incremental │ ├── ParserTypes.hs │ ├── Visualise.hs │ ├── Types.hs │ └── LSP.hs ├── elisp └── lsp-inc.el ├── .gitignore ├── README.md ├── parsers ├── Simple.y ├── Repetitive.y ├── ExprPrecedence.y ├── ExprSimpleOrig.y ├── ExprSimple.y ├── Expr.y └── Repetitive2.y ├── Makefile ├── incremental-play.cabal ├── notes.txt ├── LICENSE ├── happy-templates └── GenericTemplate.hs └── generated-parsers └── Repetitive.hs /data/foo.inc: -------------------------------------------------------------------------------- 1 | abbab 2 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /.hlint.yaml: -------------------------------------------------------------------------------- 1 | - ignore: {name: Use newtype instead of data } 2 | - ignore: {name: Eta reduce } 3 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: . 2 | ./submodules/happy 3 | 4 | package happy 5 | flags: debug -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "submodules/happy"] 2 | path = submodules/happy 3 | url = https://github.com/alanz/happy.git 4 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-12.18 2 | packages: 3 | - . 4 | extra-deps: 5 | - haskell-lsp-0.8.0.1 6 | - haskell-lsp-types-0.8.0.1 7 | -------------------------------------------------------------------------------- /app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import qualified Language.Incremental.LSP 4 | 5 | main :: IO () 6 | main = Language.Incremental.LSP.main 7 | -------------------------------------------------------------------------------- /ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Revision history for incremental-play 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /src/Language/Incremental/ParserTypes.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFoldable #-} 2 | module Language.Incremental.ParserTypes 3 | ( 4 | BinaryT(..) 5 | , Root(..) 6 | , B(..) 7 | , Token(..) 8 | , Tok(..) 9 | , Val(..) 10 | ) where 11 | 12 | import Repetitive2 13 | 14 | -------------------------------------------------------------------------------- /elisp/lsp-inc.el: -------------------------------------------------------------------------------- 1 | ;;; lsp-inc.el --- Incremental play support for lsp-mode 2 | 3 | ;;; Commentary: 4 | 5 | ;;; Code: 6 | 7 | (require 'lsp-mode) 8 | 9 | (lsp-define-stdio-client lsp-inc 10 | "inc" 11 | #'(lambda () default-directory) 12 | '("incremental-play" )) 13 | 14 | (provide 'lsp-inc) 15 | ;;; lsp-inc.el ends here 16 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .ghc.environment.* 2 | .stack-work 3 | /.projectile 4 | /Expr.info 5 | /ExprPrecedence-no-precedence-set.info 6 | /ExprPrecedence.info 7 | /ExprSimple-ShiftNonTerms.info 8 | /ExprSimple.info 9 | /ExprSimpleOrig.info 10 | /LICENSE.save0 11 | /Repetitive.info 12 | /Repetitive2.info 13 | /Simple.info 14 | /Simple.info.txt 15 | /TAGS 16 | /app/ExprPrecedence.hs 17 | /app/ExprSimple.hs 18 | /app/ExprSimpleOrig.hs 19 | /app/MainRepetitive.hs 20 | /app/Repetitive.hs 21 | /app/Repetitive2.hs 22 | /app/Simple.1.hs 23 | /app/Simple.hs 24 | /cabal.project.local 25 | /dist 26 | /happy-templates/HappyTemplate-arrays-ghc-debug 27 | /happy-templates/HappyTemplate-incremental-ghc-debug 28 | /happy-templates/IncrementalTemplate-ghc-debug 29 | dist-newstyle 30 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # incremental-play 2 | 3 | Playing with incremental parsing and later compiler passes 4 | 5 | First pass will be to build a haskell version of the approach from "Efficient 6 | and Flexible Incremental Parsing", 7 | https://pdfs.semanticscholar.org/4d22/fab95c78b3c23fa9dff88fb82976edc213c2.pdf 8 | 9 | This is also implemented in https://github.com/tree-sitter/tree-sitter 10 | 11 | ## To experiment 12 | 13 | Install the custom version of `happy` from https://github.com/alanz/happy, using 14 | the `incremental` branch. 15 | 16 | I rename the installed executable to `happy-az`, so that it does not 17 | interfere with the system version. 18 | 19 | In this directory 20 | 21 | make 22 | 23 | Load `app/Main.hs` into ghci and run it 24 | 25 | ## Emacs integration 26 | 27 | First run `stack install` 28 | 29 | ```elisp 30 | (package-install 'lsp-mode) 31 | (package-install 'lsp-ui) 32 | 33 | (require 'lsp-ui) 34 | (require 'lsp-mode) 35 | 36 | (add-to-list 'load-path "/home/alanz/mysrc/github/alanz/incremental-play/elisp") 37 | (require 'lsp-inc) 38 | 39 | (add-hook 'inc-mode-hook #'lsp-inc-enable) 40 | (add-hook 'inc-mode-hook 'flycheck-mode) 41 | ``` 42 | -------------------------------------------------------------------------------- /parsers/Simple.y: -------------------------------------------------------------------------------- 1 | { 2 | -- This file is (initially) based on the example in happy manual 3 | -- https://www.haskell.org/happy/doc/html/sec-using.html 4 | module Simple where 5 | 6 | import Data.Char 7 | import Data.List 8 | import qualified Data.Bits as Bits 9 | } 10 | 11 | %name calc 12 | %tokentype { Token } 13 | %error { parseError } 14 | 15 | %token 16 | 'A' { TokenA } 17 | 'B' { TokenB } 18 | 'C' { TokenC } 19 | 20 | %% 21 | 22 | Ultraroot : bos tree eos { $2 } 23 | 24 | bos : { () } 25 | eos : { () } 26 | 27 | tree : Top { $1 } 28 | 29 | Top : 'A' 'B' { Top TASingle TB } 30 | | 'A' 'A' 'B' { Top TADouble TB } 31 | 32 | 33 | 34 | { 35 | parseError :: [t] -> a 36 | parseError _ = error "Parse error" 37 | 38 | -- ------------------------------------- 39 | 40 | data Top 41 | = Top TA TB 42 | deriving Show 43 | 44 | data TA = TASingle | TADouble 45 | deriving Show 46 | 47 | data TB = TB 48 | deriving Show 49 | 50 | 51 | -- ------------------------------------- 52 | 53 | data Token 54 | = TokenA 55 | | TokenB 56 | | TokenC 57 | deriving Show 58 | 59 | lexer :: String -> [HappyInput] 60 | lexer [] = [] 61 | lexer (c:cs) 62 | | isSpace c = lexer cs 63 | lexer ('A':cs) = InputToken TokenA : lexer cs 64 | lexer ('B':cs) = InputToken TokenB : lexer cs 65 | lexer ('C':cs) = InputToken TokenC : lexer cs 66 | 67 | 68 | -- Main entry point 69 | /* main = getContents >>= print . calc . lexer */ 70 | 71 | } 72 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: repetitive2 repetitive precedence simple 2 | 3 | # HAPPY= cabal new-run happy:happy -- 4 | # HAPPY=./dist-newstyle/build/x86_64-linux/ghc-8.4.3/happy-1.20.0/build/happy/happy 5 | HAPPY=happy-az 6 | 7 | repetitive2 : parsers/Repetitive2.y templates 8 | $(HAPPY) --ghc --incremental --debug --template=./happy-templates --info=Repetitive2.info \ 9 | --lr0 --action --goto --lookaheads \ 10 | -o generated-parsers/Repetitive2.hs \ 11 | parsers/Repetitive2.y 12 | 13 | 14 | repetitive : parsers/Repetitive.y templates 15 | $(HAPPY) --ghc --incremental --debug --template=./happy-templates --info=Repetitive.info \ 16 | --lr0 --action --goto --lookaheads \ 17 | -o generated-parsers/Repetitive.hs \ 18 | parsers/Repetitive.y 19 | 20 | precedence : parsers/ExprPrecedence.y templates 21 | $(HAPPY) --ghc --incremental --debug --template=./happy-templates --info=ExprPrecedence.info \ 22 | --lr0 --action --goto --lookaheads \ 23 | -o generated-parsers/ExprPrecedence.hs \ 24 | parsers/ExprPrecedence.y 25 | 26 | simple : parsers/ExprSimple.y templates 27 | $(HAPPY) --ghc --incremental --debug --template=./happy-templates --info=ExprSimple.info \ 28 | --lr0 --action --goto --lookaheads \ 29 | -o generated-parsers/ExprSimple.hs \ 30 | parsers/ExprSimple.y 31 | 32 | .PHONY : templates 33 | templates : happy-templates/IncrementalTemplate-ghc-debug 34 | 35 | # happy-templates/HappyTemplate-incremental-ghc-debug: happy-templates/GenericTemplate.hs 36 | happy-templates/IncrementalTemplate-ghc-debug: happy-templates/GenericTemplate.hs 37 | ghc -cpp -E -DHAPPY_ARRAY -DHAPPY_GHC -DHAPPY_DEBUG -DHAPPY_INCR happy-templates/GenericTemplate.hs -o $@ 38 | sed -i -E "s/^# ([0-9]+ \".*\").*/{-# LINE \1 #-}/" $@ 39 | 40 | # ("HappyTemplate-arrays-ghc-debug" , ["-DHAPPY_ARRAY","-DHAPPY_GHC","-DHAPPY_DEBUG"]), 41 | 42 | orig : parsers/ExprSimpleOrig.y 43 | $(HAPPY) --ghc --array --debug --info=ExprSimpleOrig.info parsers/ExprSimpleOrig.y 44 | -------------------------------------------------------------------------------- /parsers/Repetitive.y: -------------------------------------------------------------------------------- 1 | { 2 | {-# LANGUAGE OverloadedStrings #-} 3 | module Repetitive where 4 | 5 | import Data.Char 6 | import Data.Maybe 7 | import Data.List 8 | import Data.Tree 9 | import qualified Data.Bits as Bits 10 | import Data.Text.Prettyprint.Doc 11 | import Data.Text.Prettyprint.Doc.Render.Terminal 12 | } 13 | 14 | %name calc 15 | %tokentype { Token } 16 | %error { parseError } 17 | 18 | %token 19 | 'a' { TokenA } 20 | 'b' { TokenBL } 21 | 'B' { TokenBU } 22 | 'c' { TokenC } 23 | 24 | %% 25 | 26 | -- ------------------------------------- 27 | 28 | -- This next section should become automatic, in time 29 | 30 | Ultraroot : bos tree eos { $2 } 31 | 32 | bos : { () } 33 | eos : { () } 34 | 35 | tree : Root { $1 } 36 | 37 | -- ------------------------------------- 38 | 39 | Root : A Bs C { Root (reverse $2) } 40 | 41 | A : 'a' { () } 42 | | {- nothing -} { () } 43 | 44 | Bs : Bs B { $2:$1 } 45 | | {- nothing -} { [] } 46 | 47 | B : 'b' { BL } 48 | | 'B' { BU } 49 | 50 | C : 'c' { () } 51 | | {- nothing -} { () } 52 | { 53 | parseError :: [t] -> a 54 | parseError _ = error "Parse error" 55 | 56 | data Root = Root [B] 57 | deriving Show 58 | 59 | data B = BL | BU 60 | deriving Show 61 | 62 | data Token 63 | = TokenA 64 | | TokenBL 65 | | TokenBU 66 | | TokenC 67 | deriving Show 68 | 69 | 70 | 71 | lexer :: String -> [HappyInput] 72 | lexer str = [mkTokensNode (lexer' str)] 73 | 74 | lexer' [] = [] 75 | lexer' (c:cs) 76 | | isSpace c = lexer' cs 77 | lexer' ('a':cs) = mkTok TokenA : lexer' cs 78 | lexer' ('b':cs) = mkTok TokenBL : lexer' cs 79 | lexer' ('B':cs) = mkTok TokenBU : lexer' cs 80 | lexer' ('c':cs) = mkTok TokenC : lexer' cs 81 | lexer' (unk:cs) = error $ "lexer' failure on char " ++ show unk 82 | 83 | 84 | -- Main entry point. "calc" is the parser entry point generated above 85 | /* main = getContents >>= print . calc . lexer */ 86 | 87 | } 88 | -------------------------------------------------------------------------------- /parsers/ExprPrecedence.y: -------------------------------------------------------------------------------- 1 | { 2 | -- This file is (initially) based on the example in happy manual 3 | -- https://www.haskell.org/happy/doc/html/sec-using.html 4 | {-# LANGUAGE OverloadedStrings #-} 5 | module ExprPrecedence where 6 | 7 | import Data.Char 8 | import Data.Maybe 9 | import Data.List 10 | import Data.Tree 11 | import qualified Data.Bits as Bits 12 | import Data.Text.Prettyprint.Doc 13 | import Data.Text.Prettyprint.Doc.Render.Terminal 14 | } 15 | 16 | %name calc 17 | %tokentype { Token } 18 | %error { parseError } 19 | 20 | %token 21 | int { TokenInt $$ } 22 | '+' { TokenPlus } 23 | '-' { TokenMinus } 24 | '*' { TokenTimes } 25 | '/' { TokenDiv } 26 | 27 | %left '+' '-' 28 | %left '*' '/' 29 | 30 | %% 31 | 32 | -- ------------------------------------- 33 | 34 | -- This next section should become automatic, in time 35 | 36 | Ultraroot : bos tree eos { $2 } 37 | 38 | bos : { () } 39 | eos : { () } 40 | 41 | tree : Exp { $1 } 42 | 43 | -- ------------------------------------- 44 | 45 | Exp : Exp '+' Exp { Plus $1 $3 } 46 | | Exp '-' Exp { Minus $1 $3 } 47 | | Exp '*' Exp { Times $1 $3 } 48 | | Exp '/' Exp { Div $1 $3 } 49 | | int { Int $1 } 50 | 51 | 52 | { 53 | parseError :: [t] -> a 54 | parseError _ = error "Parse error" 55 | 56 | data Exp 57 | = Plus Exp Exp 58 | | Minus Exp Exp 59 | | Times Exp Exp 60 | | Div Exp Exp 61 | | Int Int 62 | deriving Show 63 | 64 | data Token 65 | = TokenInt Int 66 | | TokenPlus 67 | | TokenMinus 68 | | TokenTimes 69 | | TokenDiv 70 | deriving Show 71 | 72 | 73 | 74 | lexer :: String -> [HappyInput] 75 | lexer str = [mkTokensNode (lexer' str)] 76 | 77 | lexer' [] = [] 78 | lexer' (c:cs) 79 | | isSpace c = lexer' cs 80 | | isDigit c = lexNum (c:cs) 81 | lexer' ('+':cs) = mkTok TokenPlus : lexer' cs 82 | lexer' ('-':cs) = mkTok TokenMinus : lexer' cs 83 | lexer' ('*':cs) = mkTok TokenTimes : lexer' cs 84 | lexer' ('/':cs) = mkTok TokenDiv : lexer' cs 85 | lexer' (unk:cs) = error $ "lexer' failure on char " ++ show unk 86 | 87 | lexNum cs = mkTok (TokenInt (read num)) : lexer' rest 88 | where (num,rest) = span isDigit cs 89 | 90 | -- Main entry point. "calc" is the parser entry point generated above 91 | /* main = getContents >>= print . calc . lexer */ 92 | 93 | } 94 | -------------------------------------------------------------------------------- /app/MainPrecedence.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE TypeOperators #-} 3 | -- import Simple 4 | -- import ExprSimple 5 | import ExprPrecedence 6 | -- import ExprSimpleOrig 7 | 8 | import Control.Lens 9 | import Control.Zipper 10 | import Data.Tree 11 | import Data.Tree.Lens 12 | 13 | main :: IO () 14 | main = do 15 | -- main = getContents >>= print . calc . lexer 16 | -- main = (print . calc . lexer) "AB" 17 | -- (print . calc . lexer) "1 + 2" 18 | -- main = (print . pretty . calc . lexer) "1 + 2" 19 | -- let is = lexer' "1 + 2" 20 | -- putDoc $ pretty is 21 | putStr $ drawTree $ fmap show ptree 22 | 23 | putStrLn "--------------------------------" 24 | putStr $ drawTree $ fmap show newTree 25 | putStrLn "--------------------------------" 26 | 27 | let p' = calc [newTree] 28 | putStr $ drawTree $ fmap show p' 29 | return () 30 | 31 | ptree :: HappyInput 32 | ptree = (calc . lexer) "1 + 2 - 3" 33 | 34 | zipperTree :: Top :>> HappyInput 35 | zipperTree = zipper ptree 36 | 37 | foo :: IO () 38 | foo = 39 | -- show 40 | -- zipperTree & downward root & view focus 41 | showTree newTree 42 | 43 | {- 44 | 1 + 2 * 3 45 | (Plus 46 | (Int 1) 47 | (Times (Int 2) (Int 3))) 48 | -} 49 | newTree :: Tree NodeVal 50 | newTree = 51 | zipperTree 52 | & downward root & focus %~ setChangedChild & upward 53 | 54 | & downward branches 55 | & fromWithin traverse 56 | & tugs rightward 1 -- HappyAbsSyn7 57 | & downward root & focus %~ setChangedChild & upward 58 | 59 | & downward branches 60 | & fromWithin traverse 61 | & downward root & focus %~ setChangedChild & upward 62 | 63 | & downward branches 64 | & fromWithin traverse 65 | & tugs rightward 1 66 | & downward root & focus %~ setChangedChild & upward 67 | 68 | & downward root 69 | -- & view focus 70 | & focus %~ changeVal 71 | & rezip 72 | 73 | changeVal :: NodeVal -> NodeVal 74 | changeVal _ = Val True True (HappyErrorToken (-5)) Nothing [mkTok TokenTimes ] Nothing Nothing False False False 75 | 76 | setChangedChild :: NodeVal -> NodeVal 77 | setChangedChild v = v { changedChild = True} 78 | 79 | showTree :: Show a => Tree a -> IO () 80 | showTree tree = putStrLn $ drawTree $ fmap show tree 81 | 82 | bar :: IO String 83 | bar = fmap rezip $ zipper "stale" & within traverse <&> tugs rightward 2 <&> focus .~ 'y' 84 | -------------------------------------------------------------------------------- /parsers/ExprSimpleOrig.y: -------------------------------------------------------------------------------- 1 | { 2 | -- This file is (initially) based on the example in happy manual 3 | -- https://www.haskell.org/happy/doc/html/sec-using.html 4 | {-# LANGUAGE OverloadedStrings #-} 5 | module ExprSimpleOrig where 6 | 7 | import Data.Char 8 | import Data.List 9 | import qualified Data.Bits as Bits 10 | import Data.Text.Prettyprint.Doc 11 | import Data.Text.Prettyprint.Doc.Render.Terminal 12 | } 13 | 14 | %name calc 15 | %tokentype { Token } 16 | %error { parseError } 17 | 18 | %token 19 | int { TokenInt $$ } 20 | '+' { TokenPlus } 21 | '-' { TokenMinus } 22 | '*' { TokenTimes } 23 | '/' { TokenDiv } 24 | 25 | %% 26 | 27 | -- ------------------------------------- 28 | 29 | -- This next section should become automatic, in time 30 | 31 | Ultraroot : bos tree eos { $2 } 32 | 33 | bos : { () } 34 | eos : { () } 35 | 36 | tree : Exp { $1 } 37 | 38 | -- ------------------------------------- 39 | 40 | Exp : Exp '+' Term { Plus $1 $3 } 41 | | Exp '-' Term { Minus $1 $3 } 42 | | Term { Term $1 } 43 | 44 | Term : Term '*' Factor { Times $1 $3 } 45 | | Term '/' Factor { Div $1 $3 } 46 | | Factor { Factor $1 } 47 | 48 | Factor 49 | : int { Int $1 } 50 | 51 | 52 | { 53 | parseError :: [t] -> a 54 | parseError _ = error "Parse error" 55 | 56 | data Exp 57 | = Plus Exp Term 58 | | Minus Exp Term 59 | | Term Term 60 | deriving Show 61 | 62 | data Term 63 | = Times Term Factor 64 | | Div Term Factor 65 | | Factor Factor 66 | deriving Show 67 | 68 | data Factor 69 | = Int Int 70 | deriving Show 71 | 72 | data Token 73 | = TokenInt Int 74 | | TokenPlus 75 | | TokenMinus 76 | | TokenTimes 77 | | TokenDiv 78 | deriving Show 79 | 80 | 81 | 82 | 83 | lexer [] = [] 84 | lexer (c:cs) 85 | | isSpace c = lexer cs 86 | | isDigit c = lexNum (c:cs) 87 | lexer ('+':cs) = TokenPlus : lexer cs 88 | lexer ('-':cs) = TokenMinus : lexer cs 89 | lexer ('*':cs) = TokenTimes : lexer cs 90 | lexer ('/':cs) = TokenDiv : lexer cs 91 | lexer (unk:cs) = error $ "lexer failure on char " ++ show unk 92 | 93 | lexNum cs = (TokenInt (read num)) : lexer rest 94 | where (num,rest) = span isDigit cs 95 | 96 | -- Main entry point. "calc" is the parser entry point generated above 97 | /* main = getContents >>= print . calc . lexer */ 98 | 99 | } 100 | -------------------------------------------------------------------------------- /parsers/ExprSimple.y: -------------------------------------------------------------------------------- 1 | { 2 | -- This file is (initially) based on the example in happy manual 3 | -- https://www.haskell.org/happy/doc/html/sec-using.html 4 | {-# LANGUAGE OverloadedStrings #-} 5 | module ExprSimple where 6 | 7 | import Data.Char 8 | import Data.Maybe 9 | import Data.List 10 | import Data.Tree 11 | import qualified Data.Bits as Bits 12 | import Data.Text.Prettyprint.Doc 13 | import Data.Text.Prettyprint.Doc.Render.Terminal 14 | } 15 | 16 | %name calc 17 | %tokentype { Token } 18 | %error { parseError } 19 | 20 | %token 21 | int { TokenInt $$ } 22 | '+' { TokenPlus } 23 | '-' { TokenMinus } 24 | '*' { TokenTimes } 25 | '/' { TokenDiv } 26 | 27 | %% 28 | 29 | -- ------------------------------------- 30 | 31 | -- This next section should become automatic, in time 32 | 33 | Ultraroot : bos tree eos { $2 } 34 | 35 | bos : { () } 36 | eos : { () } 37 | 38 | tree : Exp { $1 } 39 | 40 | -- ------------------------------------- 41 | 42 | Exp : Exp '+' Term { Plus $1 $3 } 43 | | Exp '-' Term { Minus $1 $3 } 44 | | Term { Term $1 } 45 | 46 | Term : Term '*' Factor { Times $1 $3 } 47 | | Term '/' Factor { Div $1 $3 } 48 | | Factor { Factor $1 } 49 | 50 | Factor 51 | : int { Int $1 } 52 | 53 | 54 | { 55 | parseError :: [t] -> a 56 | parseError _ = error "Parse error" 57 | 58 | data Exp 59 | = Plus Exp Term 60 | | Minus Exp Term 61 | | Term Term 62 | deriving Show 63 | 64 | data Term 65 | = Times Term Factor 66 | | Div Term Factor 67 | | Factor Factor 68 | deriving Show 69 | 70 | data Factor 71 | = Int Int 72 | deriving Show 73 | 74 | data Token 75 | = TokenInt Int 76 | | TokenPlus 77 | | TokenMinus 78 | | TokenTimes 79 | | TokenDiv 80 | deriving Show 81 | 82 | 83 | 84 | lexer :: String -> [HappyInput] 85 | lexer str = [mkTokensNode (lexer' str)] 86 | 87 | lexer' [] = [] 88 | lexer' (c:cs) 89 | | isSpace c = lexer' cs 90 | | isDigit c = lexNum (c:cs) 91 | lexer' ('+':cs) = mkTok TokenPlus : lexer' cs 92 | lexer' ('-':cs) = mkTok TokenMinus : lexer' cs 93 | lexer' ('*':cs) = mkTok TokenTimes : lexer' cs 94 | lexer' ('/':cs) = mkTok TokenDiv : lexer' cs 95 | lexer' (unk:cs) = error $ "lexer' failure on char " ++ show unk 96 | 97 | lexNum cs = mkTok (TokenInt (read num)) : lexer' rest 98 | where (num,rest) = span isDigit cs 99 | 100 | -- Main entry point. "calc" is the parser entry point generated above 101 | /* main = getContents >>= print . calc . lexer */ 102 | 103 | } 104 | -------------------------------------------------------------------------------- /incremental-play.cabal: -------------------------------------------------------------------------------- 1 | name: incremental-play 2 | version: 0.1.0.0 3 | synopsis: Playing with incremental parsing 4 | -- description: 5 | homepage: https://github.com/alanz/incremental-play 6 | license: GPL-3 7 | license-file: LICENSE 8 | author: Alan Zimmerman 9 | maintainer: alan.zimm@gmail.com 10 | -- copyright: 11 | category: Development 12 | build-type: Simple 13 | extra-source-files: ChangeLog.md, README.md 14 | cabal-version: >=2.0 15 | 16 | library 17 | hs-source-dirs: src generated-parsers 18 | exposed-modules: Language.Incremental.LSP 19 | Language.Incremental.Visualise 20 | Language.Incremental.ParserTypes 21 | other-modules: Repetitive2 22 | build-depends: base >=4.9 && <4.13 23 | , ansi-wl-pprint 24 | , array 25 | , containers 26 | , data-default 27 | , haskell-lsp 28 | , hslogger 29 | , lens 30 | , megaparsec 31 | , mtl 32 | , optparse-applicative 33 | , prettyprinter 34 | , prettyprinter-ansi-terminal 35 | , protolude 36 | , stm 37 | , text 38 | , unix 39 | , zippers 40 | 41 | ghc-options: -Wall -fwarn-tabs -fwarn-unused-imports -fwarn-missing-signatures -fwarn-name-shadowing -fwarn-incomplete-patterns 42 | default-language: Haskell2010 43 | 44 | executable incremental-play 45 | main-is: Main.hs 46 | -- Other-Modules: Paths_HaRe 47 | ghc-options: -Wall 48 | hs-source-dirs: 49 | ./app 50 | build-depends: base >= 4.9 && < 4.13 51 | , array 52 | , containers 53 | , incremental-play 54 | , lens 55 | , prettyprinter 56 | , prettyprinter-ansi-terminal 57 | , zippers 58 | -- , happy == 1.20.* 59 | -- build-tools: happy == 1.20.* 60 | default-language: Haskell2010 61 | 62 | -- test-suite spec 63 | -- type: 64 | -- exitcode-stdio-1.0 65 | -- ghc-options: 66 | -- -Wall 67 | -- main-is: 68 | -- Main.hs 69 | -- hs-source-dirs: 70 | -- test 71 | -- other-modules: 72 | -- build-depends: 73 | -- base >= 4.9 && < 4.11 74 | 75 | source-repository head 76 | type: git 77 | location: https://github.com/alanz/incremental-play.git 78 | -------------------------------------------------------------------------------- /parsers/Expr.y: -------------------------------------------------------------------------------- 1 | { 2 | -- This file is (initially) based on the example in happy manual 3 | -- https://www.haskell.org/happy/doc/html/sec-using.html 4 | module Main where 5 | } 6 | 7 | %name calc 8 | %tokentype { Token } 9 | %error { parseError } 10 | 11 | %token 12 | let { TokenLet } 13 | in { TokenIn } 14 | int { TokenInt $$ } 15 | var { TokenVar $$ } 16 | '=' { TokenEq } 17 | '+' { TokenPlus } 18 | '-' { TokenMinus } 19 | '*' { TokenTimes } 20 | '/' { TokenDiv } 21 | '(' { TokenOB } 22 | ')' { TokenCB } 23 | 24 | %% 25 | 26 | Exp : let var '=' Exp in Exp { Let $2 $4 $6 } 27 | | Exp1 { Exp1 $1 } 28 | 29 | Exp1 : Exp1 '+' Term { Plus $1 $3 } 30 | | Exp1 '-' Term { Minus $1 $3 } 31 | | Term { Term $1 } 32 | 33 | Term : Term '*' Factor { Times $1 $3 } 34 | | Term '/' Factor { Div $1 $3 } 35 | | Factor { Factor $1 } 36 | 37 | Factor 38 | : int { Int $1 } 39 | | var { Var $1 } 40 | | '(' Exp ')' { Brack $2 } 41 | 42 | 43 | { 44 | parseError :: [Token] -> a 45 | parseError _ = error "Parse error" 46 | 47 | data Exp 48 | = Let String Exp Exp 49 | | Exp1 Exp1 50 | deriving Show 51 | 52 | data Exp1 53 | = Plus Exp1 Term 54 | | Minus Exp1 Term 55 | | Term Term 56 | deriving Show 57 | 58 | data Term 59 | = Times Term Factor 60 | | Div Term Factor 61 | | Factor Factor 62 | deriving Show 63 | 64 | data Factor 65 | = Int Int 66 | | Var String 67 | | Brack Exp 68 | deriving Show 69 | 70 | data Token 71 | = TokenLet 72 | | TokenIn 73 | | TokenInt Int 74 | | TokenVar String 75 | | TokenEq 76 | | TokenPlus 77 | | TokenMinus 78 | | TokenTimes 79 | | TokenDiv 80 | | TokenOB 81 | | TokenCB 82 | deriving Show 83 | 84 | lexer :: String -> [Token] 85 | lexer [] = [] 86 | lexer (c:cs) 87 | | isSpace c = lexer cs 88 | | isAlpha c = lexVar (c:cs) 89 | | isDigit c = lexNum (c:cs) 90 | lexer ('=':cs) = TokenEq : lexer cs 91 | lexer ('+':cs) = TokenPlus : lexer cs 92 | lexer ('-':cs) = TokenMinus : lexer cs 93 | lexer ('*':cs) = TokenTimes : lexer cs 94 | lexer ('/':cs) = TokenDiv : lexer cs 95 | lexer ('(':cs) = TokenOB : lexer cs 96 | lexer (')':cs) = TokenCB : lexer cs 97 | 98 | lexNum cs = TokenInt (read num) : lexer rest 99 | where (num,rest) = span isDigit cs 100 | 101 | lexVar cs = 102 | case span isAlpha cs of 103 | ("let",rest) -> TokenLet : lexer rest 104 | ("in",rest) -> TokenIn : lexer rest 105 | (var,rest) -> TokenVar var : lexer rest 106 | 107 | -- Main entry point 108 | main = getContents >>= print . calc . lexer 109 | 110 | } 111 | -------------------------------------------------------------------------------- /parsers/Repetitive2.y: -------------------------------------------------------------------------------- 1 | { 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE DeriveFoldable #-} 4 | module Repetitive2 where 5 | 6 | import Data.Char 7 | import Data.Foldable 8 | import Data.Maybe 9 | import Data.List 10 | import Data.Tree 11 | import qualified Data.Bits as Bits 12 | import Data.Text.Prettyprint.Doc 13 | import Data.Text.Prettyprint.Doc.Render.Terminal 14 | 15 | } 16 | 17 | %name calc 18 | %tokentype { Token } 19 | %error { parseError } 20 | 21 | %token 22 | 'a' { TokenA } 23 | 'b' { TokenBL } 24 | 'B' { TokenBU } 25 | 'd' { TokenBd } 26 | 'D' { TokenBD } 27 | 'c' { TokenC } 28 | 29 | %% 30 | 31 | -- ------------------------------------- 32 | 33 | -- This next section should become automatic, in time 34 | 35 | Ultraroot : bos tree eos { $2 } 36 | 37 | bos : { () } 38 | eos : { () } 39 | 40 | tree : Root { $1 } 41 | 42 | -- ------------------------------------- 43 | 44 | Root : A Bs C { Root $2 } 45 | 46 | A : 'a' { () } 47 | | {- nothing -} { () } 48 | 49 | Bs : listb(B) { toList $1 } 50 | 51 | B : 'b' { BL } 52 | | 'B' { BU } 53 | | 'd' { Bd } 54 | | 'D' { BD } 55 | 56 | C : 'c' { () } 57 | | {- nothing -} { () } 58 | 59 | -- Rules to introduce a branching tree instead of linearity 60 | -- See "Parameterized Productions" in 61 | -- https://www.haskell.org/happy/doc/html/sec-grammar.html 62 | 63 | list(p) : list1(p) { $1 } 64 | | { [] } 65 | 66 | list1(p) : rev_list1(p) { reverse $1 } 67 | 68 | rev_list1(p) : p { [$1] } 69 | | rev_list1(p) p { $2 : $1 } 70 | 71 | -- ----------------------------- 72 | 73 | listb(p) : lista(p) { $1 } 74 | 75 | lista(p) : listb(p) { $1 } 76 | | { BEmpty } 77 | 78 | listb(p) : p { BSingle $1 } 79 | | listb(p) listb(p) { BDouble $1 $2 } 80 | 81 | {- 82 | s : A 83 | 84 | A : B 85 | | {- nothing -} 86 | 87 | B : L 88 | | B B 89 | -} 90 | 91 | -- --------------------------------------------------------------------- 92 | 93 | { 94 | parseError :: [t] -> a 95 | parseError _ = error "Parse error" 96 | 97 | data BinaryT a 98 | = BEmpty 99 | | BSingle a 100 | | BDouble (BinaryT a) (BinaryT a) 101 | deriving (Show, Foldable) 102 | 103 | data Root = Root [B] 104 | deriving Show 105 | 106 | data B = BL | BU | Bd | BD 107 | deriving Show 108 | 109 | data Token 110 | = TokenA 111 | | TokenBL 112 | | TokenBU 113 | | TokenBd 114 | | TokenBD 115 | | TokenC 116 | deriving Show 117 | 118 | 119 | 120 | -- lexer :: String -> [HappyInput] 121 | lexer str = [mkTokensNode (lexer' str)] 122 | 123 | lexer' [] = [] 124 | lexer' (c:cs) 125 | | isSpace c = lexer' cs 126 | lexer' ('a':cs) = mkTok TokenA : lexer' cs 127 | lexer' ('b':cs) = mkTok TokenBL : lexer' cs 128 | lexer' ('B':cs) = mkTok TokenBU : lexer' cs 129 | lexer' ('d':cs) = mkTok TokenBd : lexer' cs 130 | lexer' ('D':cs) = mkTok TokenBD : lexer' cs 131 | lexer' ('c':cs) = mkTok TokenC : lexer' cs 132 | lexer' (unk:cs) = error $ "lexer' failure on char " ++ show unk 133 | 134 | 135 | -- Main entry point. "calc" is the parser entry point generated above 136 | /* main = getContents >>= print . calc . lexer */ 137 | 138 | } 139 | -------------------------------------------------------------------------------- /src/Language/Incremental/Visualise.hs: -------------------------------------------------------------------------------- 1 | module Language.Incremental.Visualise 2 | ( 3 | Bar(..) 4 | , Span(..) 5 | , convert 6 | , asHierarchy 7 | ) where 8 | 9 | import Data.Tree 10 | import qualified Language.Haskell.LSP.Types as LSP 11 | -- import qualified Language.Haskell.LSP.Types.Lens as LSP 12 | -- import qualified Language.Haskell.LSP.Utility as LSP 13 | import Language.Incremental.ParserTypes 14 | 15 | import qualified Data.Text as T 16 | import Repetitive2 17 | 18 | -- --------------------------------------------------------------------- 19 | 20 | data Bar = Bar { bLabel :: String 21 | , bToks :: [Tok] 22 | , bLength :: Int 23 | , bSpan :: Span 24 | } deriving Show 25 | 26 | data Span = Span Int Int 27 | deriving Show 28 | 29 | -- --------------------------------------------------------------------- 30 | 31 | asHierarchy :: [LSP.DocumentSymbol] 32 | asHierarchy = toHierarchy bla 33 | 34 | -- --------------------------------------------------------------------- 35 | 36 | toHierarchy :: Tree Bar -> [LSP.DocumentSymbol] 37 | toHierarchy (Node b []) = [mkDs (bLabel b) (bSpan b) Nothing] 38 | toHierarchy (Node b ts) = [mkDs (bLabel b) (bSpan b) (Just children)] 39 | where 40 | children = LSP.List $ concatMap toHierarchy ts 41 | 42 | mkDs :: String 43 | -> Span 44 | -> Maybe (LSP.List LSP.DocumentSymbol) 45 | -> LSP.DocumentSymbol 46 | mkDs label (Span s e) children = 47 | LSP.DocumentSymbol 48 | (T.pack label) 49 | Nothing 50 | LSP.SkVariable 51 | Nothing 52 | sp 53 | sp 54 | children 55 | where 56 | sp = LSP.Range (LSP.Position 0 s) (LSP.Position 0 e) 57 | 58 | -- --------------------------------------------------------------------- 59 | 60 | bla :: Tree Bar 61 | bla = pp $ fmap toBar ptree 62 | 63 | -- Test stuff 64 | ptree = (calc . lexer) "a BbDd c" 65 | 66 | -- --------------------------------------------------------------------- 67 | 68 | convert :: Show a => Tree (Val a Tok) -> Tree Bar 69 | convert tree = pp $ fmap toBar tree 70 | 71 | -- --------------------------------------------------------------------- 72 | 73 | toBar :: (Show a) => Val a t -> (String, [t]) 74 | toBar v = (showConstr (here v), terminals v) 75 | 76 | 77 | -- The Happy AST has each element we care about wrapped in a 78 | -- constructor, we discard that first, together with the opening paren 79 | showConstr :: (Show a) => a -> String 80 | showConstr = fixup . head . tail . words . show 81 | where 82 | fixup "()" = "()" 83 | fixup ('(':r) = r 84 | fixup r = r 85 | 86 | -- --------------------------------------------------------------------- 87 | 88 | pp :: Tree (String,[Tok]) -> Tree Bar 89 | pp t = head $ go (Span 0 0) [t] 90 | where 91 | go :: Span -> [Tree (String,[Tok])] -> [Tree Bar] 92 | go _ [] = [] 93 | go sp@(Span _s e) (Node i []:tts) = Node b []:go sp' tts 94 | where 95 | b = (ff sp i) { bSpan = sp' } 96 | sp' = Span e (e + bLength b) 97 | go sp (Node i ts:tts) = r:go sp' tts 98 | where 99 | b = (ff sp i) { bSpan = sp' } 100 | ts' = go sp ts 101 | r = Node b ts' 102 | Node bs _ = head ts' 103 | Node be _ = last ts' 104 | Span s _ = bSpan bs 105 | Span _ e = bSpan be 106 | sp' = Span s e 107 | 108 | ff (Span _start end) (s,ts) = Bar s ts len sp 109 | where 110 | len = length ts 111 | sp = Span end (end + len) 112 | 113 | 114 | -- --------------------------------------------------------------------- 115 | -------------------------------------------------------------------------------- /app/MainExpr.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE TypeOperators #-} 3 | -- import Simple 4 | import ExprSimple 5 | -- import ExprSimpleOrig 6 | 7 | import Control.Lens 8 | import Control.Zipper 9 | import Data.Tree 10 | import Data.Tree.Lens 11 | 12 | main :: IO () 13 | main = do 14 | -- main = getContents >>= print . calc . lexer 15 | -- main = (print . calc . lexer) "AB" 16 | -- (print . calc . lexer) "1 + 2" 17 | -- main = (print . pretty . calc . lexer) "1 + 2" 18 | -- let is = lexer' "1 + 2" 19 | -- putDoc $ pretty is 20 | putStr $ drawTree $ fmap show ptree 21 | 22 | putStrLn "--------------------------------" 23 | putStr $ drawTree $ fmap show newTree2 24 | putStrLn "--------------------------------" 25 | 26 | let p' = calc [newTree2] 27 | putStr $ drawTree $ fmap show p' 28 | return () 29 | 30 | -- ptree :: HappyInput 31 | ptree = (calc . lexer) "1 + 2" 32 | 33 | -- zipperTree :: Top :>> HappyInput 34 | zipperTree = zipper ptree 35 | 36 | foo :: IO () 37 | foo = putStrLn $ show $ 38 | -- show 39 | -- zipperTree & downward root & view focus 40 | newTree 41 | 42 | -- newTree :: Tree NodeVal 43 | newTree = 44 | zipperTree 45 | & downward root & focus %~ setChangedChild & upward 46 | 47 | & downward branches 48 | & fromWithin traverse 49 | & tugs rightward 1 -- HappyAbsSyn7 50 | & downward root & focus %~ setChangedChild & upward 51 | 52 | & downward branches 53 | & fromWithin traverse 54 | & downward root & focus %~ setChangedChild & upward 55 | 56 | & downward branches 57 | & fromWithin traverse 58 | & tugs rightward 1 59 | & downward root & focus %~ setChangedChild & upward 60 | 61 | & downward root 62 | -- -- & view focus 63 | & focus %~ changeVal 64 | & rezip 65 | 66 | -- newTree2 :: Tree NodeVal 67 | newTree2 = 68 | zipperTree 69 | & downward root & focus %~ setChangedChild & upward 70 | 71 | & downward branches 72 | & fromWithin traverse 73 | & tugs rightward 1 -- HappyAbsSyn7 74 | & downward root & focus %~ setChangedChild & upward 75 | 76 | & downward branches 77 | & fromWithin traverse 78 | & downward root & focus %~ setChangedChild & upward 79 | 80 | & downward branches 81 | & fromWithin traverse 82 | & tugs rightward 2 83 | & downward root & focus %~ setChangedChild & upward 84 | 85 | & downward branches 86 | & fromWithin traverse 87 | & downward root & focus %~ setChangedChild & upward 88 | 89 | & downward branches 90 | & fromWithin traverse 91 | & downward root & focus %~ setChangedChild & upward 92 | 93 | & downward root 94 | -- & view focus 95 | & focus %~ changeVal2 96 | & rezip 97 | 98 | -- changeVal :: NodeVal -> NodeVal 99 | changeVal _ = Val True True (HappyErrorToken (-5)) Nothing [mkTok TokenMinus ] Nothing Nothing False False False 100 | 101 | -- changeVal2 :: NodeVal -> NodeVal 102 | changeVal2 _ = Val True True (HappyTerminal (TokenInt 3)) Nothing [mkTok (TokenInt 3) ] (Just (mkTok (TokenInt 3))) (Just (mkTok (TokenInt 3))) False False False 103 | 104 | -- setChangedChild :: NodeVal -> NodeVal 105 | setChangedChild v = v { changedChild = True} 106 | 107 | showTree :: Show a => Tree a -> IO () 108 | showTree tree = putStrLn $ drawTree $ fmap show tree 109 | 110 | bar :: IO String 111 | bar = fmap rezip $ zipper "stale" & within traverse <&> tugs rightward 2 <&> focus .~ 'y' 112 | -------------------------------------------------------------------------------- /app/MainRepetitive2.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE TypeOperators #-} 3 | import Repetitive2 4 | 5 | import Control.Lens 6 | import Control.Zipper 7 | import Data.Tree 8 | import Data.Tree.Lens 9 | 10 | main :: IO () 11 | main = do 12 | -- main = getContents >>= print . calc . lexer 13 | -- main = (print . calc . lexer) "AB" 14 | -- (print . calc . lexer) "1 + 2" 15 | -- main = (print . pretty . calc . lexer) "1 + 2" 16 | -- let is = lexer' "1 + 2" 17 | -- putDoc $ pretty is 18 | putStr $ drawTree $ fmap show ptree 19 | 20 | putStrLn "--------------------------------" 21 | putStr $ drawTree $ fmap show newTree 22 | putStrLn "--------------------------------" 23 | 24 | let p' = calc [newTree] 25 | -- let p' = calc [ptree] 26 | putStr $ drawTree $ fmap show p' 27 | putStrLn "--------------------------------" 28 | -- putStr $ drawTree $ fmap show $ posify $ fmap toBar ptree 29 | putStr $ drawTree $ fmap show $ pp $ fmap toBar ptree 30 | putStrLn "--------------------------------" 31 | return () 32 | 33 | -- ptree :: HappyInput 34 | ptree = (calc . lexer) "a BbDd c" 35 | 36 | -- zipperTree :: Top :>> HappyInput 37 | zipperTree = zipper ptree 38 | 39 | foo :: IO () 40 | foo = 41 | -- show 42 | -- zipperTree & downward root & view focus 43 | showTree newTree 44 | 45 | {- 46 | 1 + 2 * 3 47 | (Plus 48 | (Int 1) 49 | (Times (Int 2) (Int 3))) 50 | -} 51 | -- newTree :: Tree NodeVal 52 | newTree = 53 | zipperTree 54 | & downward root & focus %~ setChangedChild & upward 55 | 56 | & downward branches 57 | & fromWithin traverse 58 | & tugs rightward 1 -- HappyAbsSyn7 59 | & downward root & focus %~ setChangedChild & upward 60 | 61 | & downward branches 62 | & fromWithin traverse 63 | & downward root & focus %~ setChangedChild & upward 64 | 65 | & downward branches 66 | & fromWithin traverse 67 | & tugs rightward 1 68 | & downward root & focus %~ setChangedChild & upward 69 | 70 | & downward branches 71 | & fromWithin traverse 72 | & tugs rightward 1 73 | & downward root & focus %~ setChangedChild & upward 74 | 75 | & downward branches 76 | & fromWithin traverse 77 | & tugs rightward 1 78 | & downward root & focus %~ setChangedChild & upward 79 | 80 | & downward branches 81 | & fromWithin traverse 82 | & tugs rightward 1 83 | & downward root & focus %~ setChangedChild & upward 84 | 85 | & downward branches 86 | & fromWithin traverse 87 | -- & tugs rightward 1 88 | & downward root & focus %~ setChangedChild & upward 89 | 90 | & downward branches 91 | & fromWithin traverse 92 | -- & tugs rightward 1 93 | & downward root & focus %~ setChangedChild & upward 94 | 95 | & downward branches 96 | & fromWithin traverse 97 | -- & tugs rightward 1 98 | & downward root & focus %~ setChangedChild & upward 99 | 100 | & downward root 101 | -- & view focus 102 | -- & focus %~ changeChild 103 | & focus %~ changeVal 104 | & rezip 105 | 106 | -- changeVal :: NodeVal -> NodeVal 107 | -- changeVal _ = Val True True (HappyErrorToken (-5)) Nothing [mkTok TokenBU ] Nothing Nothing False False False 108 | changeVal _ = Val True True (HappyTerminal TokenBU) Nothing [mkTok TokenBU] Nothing Nothing False False False 109 | 110 | changeChild (Node v cs) = Node (changeVal v) [] 111 | 112 | -- setChangedChild :: NodeVal -> NodeVal 113 | setChangedChild v = v { changedChild = True} 114 | 115 | showTree :: Show a => Tree a -> IO () 116 | showTree tree = putStrLn $ drawTree $ fmap show tree 117 | 118 | bar :: IO String 119 | bar = fmap rezip $ zipper "stale" & within traverse <&> tugs rightward 2 <&> focus .~ 'y' 120 | 121 | -- --------------------------------------------------------------------- 122 | 123 | toBar :: (Show a) => Val a t -> (String, [t]) 124 | toBar v = (show (here v), terminals v) 125 | 126 | -- --------------------------------------------------------------------- 127 | 128 | data Bar = Bar { bLabel :: String 129 | , bToks :: [Tok] 130 | , bLength :: Int 131 | , bSpan :: Span 132 | } deriving Show 133 | 134 | data Span = Span Int Int 135 | deriving Show 136 | 137 | -- --------------------------------------------------------------------- 138 | 139 | pp :: Tree (String,[Tok]) -> Tree Bar 140 | pp t = head $ go (Span 0 0) [t] 141 | where 142 | go :: Span -> [Tree (String,[Tok])] -> [Tree Bar] 143 | go _ [] = [] 144 | go sp@(Span s e) (Node i []:tts) = Node b []:go sp' tts 145 | where 146 | b = (ff sp i) { bSpan = sp' } 147 | sp' = Span e (e + bLength b) 148 | go sp (Node i ts:tts) = r:go sp' tts 149 | where 150 | b = (ff sp i) { bSpan = sp' } 151 | ts' = go sp ts 152 | r = Node b ts' 153 | Node bs _ = head ts' 154 | Node be _ = last ts' 155 | Span s _ = bSpan bs 156 | Span _ e = bSpan be 157 | sp' = Span s e 158 | 159 | ff (Span start end) (s,ts) = Bar s ts len sp 160 | where 161 | len = length ts 162 | sp = Span end (end + len) 163 | 164 | 165 | -- --------------------------------------------------------------------- 166 | -------------------------------------------------------------------------------- /src/Language/Incremental/Types.hs: -------------------------------------------------------------------------------- 1 | module Language.Incremental.Types 2 | ( 3 | -- * Versioned document interface 4 | Versioned(..) 5 | , Node(..) 6 | , NodeScope(..) 7 | , VersionId(..) 8 | , nodeHasChanges 9 | , nodeChild 10 | , setChild 11 | , exists 12 | , isNew 13 | ) where 14 | 15 | -- --------------------------------------------------------------------- 16 | -- Node interface, from figure 2 17 | 18 | {- 19 | Summary of node-level interface used by the incremental parser. Each node 20 | maintains its own version history, and is capable of reporting both local 21 | changes to its attributes and “nested” changes—modifications within the subtree 22 | rooted at the node. The version_id arguments refer to the document as a whole; 23 | they are efficiently translated into names for values in the local history of 24 | each versioned attribute. 25 | -} 26 | 27 | -- Will grow out to be the versioned document 28 | data Versioned = Versioned 29 | deriving (Eq,Show) 30 | 31 | data Node = Node -- TBD 32 | deriving (Eq,Show) 33 | 34 | data NodeScope = Local | Nested 35 | deriving (Eq,Show) 36 | 37 | data VersionId = VersionId Int -- for now 38 | deriving (Eq,Show) 39 | 40 | -- Is this different from the VersionId? 41 | data V = Reference | Previous | Current 42 | deriving (Eq,Show) 43 | 44 | nodeHasChanges :: Versioned -> Maybe VersionId -> NodeScope -> Bool 45 | nodeHasChanges doc mid scope = undefined 46 | 47 | nodeChild :: Versioned -> Int -> Maybe VersionId -> Node 48 | nodeChild n mid = undefined 49 | 50 | setChild :: Versioned -> VersionId -> Node -> Versioned 51 | setChild doc id node = undefined 52 | 53 | -- | Determines whether the node exists in the current or a specified version. 54 | exists :: Versioned -> Node -> VersionId -> Bool 55 | exists doc node id = undefined 56 | 57 | -- | Determines if a node was created in the current version. 58 | isNew :: Versioned -> Node -> Bool 59 | isNew doc node = undefined 60 | 61 | -- --------------------------------------------------------------------- 62 | {- 63 | // Remove any subtrees on top of parse stack with null yield, then 64 | // break down right edge of topmost subtree. 65 | right_breakdown () { 66 | NODE *node; 67 | do { // Replace node with its children. 68 | node = parse_stack pop(); 69 | // Does nothing when child is a terminal symbol. 70 | foreach child of node do shift(child); 71 | } while (is_nonterminal(node)); 72 | shift(node); Leave final terminal symbol on top of stack. 73 | } 74 | -} 75 | 76 | rightBreakdown = undefined 77 | 78 | 79 | {- 80 | // Shift a node onto the parse stack and update the current parse state. 81 | void shift (NODE *node) { 82 | parse_stack push(parse_state, node); 83 | parse_state = parse_table state_after_shift(parse_state, node 84 | } 85 | 86 | -} 87 | 88 | -- --------------------------------------------------------------------- 89 | {- 90 | void inc_parse () { 91 | // Initialize the parse stack to contain only bos. 92 | parse_stack clear(); parse_state = 0; parse_stack push(bos); 93 | NODE *la = pop_lookahead(bos); // Set lookahead to root of tree. 94 | while (true) 95 | if (is_terminal(la)) 96 | // Incremental lexing advances la as a side effect. 97 | if (la has_changes(reference_version)) relex(la); 98 | else 99 | switch (parse_table action(parse_state, la symbol)) { 100 | case ACCEPT: 101 | if (la == eos) { 102 | parse_stack push(eos); 103 | return; Stack is [bos start_symbol eos]. 104 | } else {recover(); break;} 105 | case REDUCE r: reduce(r); break; 106 | case SHIFT s: shift(s); la = pop_lookahead(la); break; 107 | case ERROR: 108 | recover(); break; 109 | } 110 | else // this is a nonterminal lookahead. 111 | if (la has_changes(reference_version) 112 | la = left_breakdown(la); Split tree at changed points. 113 | else { 114 | // Reductions can only be processed with a terminal lookahead. 115 | perform_all_reductions_possible(next_terminal()); 116 | if (shiftable(la)) 117 | // Place lookahead on parse stack with its right-hand edge removed. 118 | {shift(la); right_breakdown(); la = pop_lookahead(la);} 119 | else la = left_breakdown(la); 120 | } 121 | } 122 | -} 123 | 124 | incParse = do 125 | -- parse_stack clear(); 126 | -- parse_state = 0; 127 | -- parse_stack push(bos); 128 | 129 | NODE *la = pop_lookahead(bos); -- Set lookahead to root of tree. 130 | while (true) 131 | if (is_terminal(la)) 132 | -- Incremental lexing advances la as a side effect. 133 | if (la has_changes(reference_version)) 134 | relex(la); 135 | else 136 | switch (parse_table action(parse_state, la symbol)) { 137 | case ACCEPT: 138 | if (la == eos) { 139 | parse_stack push(eos); 140 | return; -- Stack is [bos start_symbol eos]. 141 | } else {recover(); break;} 142 | case REDUCE r: reduce(r); break; 143 | case SHIFT s: shift(s); la = pop_lookahead(la); break; 144 | case ERROR: 145 | recover(); break; 146 | } 147 | else // this is a nonterminal lookahead. 148 | if (la has_changes(reference_version) 149 | la = left_breakdown(la); Split tree at changed points. 150 | else { 151 | // Reductions can only be processed with a terminal lookahead. 152 | perform_all_reductions_possible(next_terminal()); 153 | if (shiftable(la)) 154 | // Place lookahead on parse stack with its right-hand edge removed. 155 | {shift(la); right_breakdown(); la = pop_lookahead(la);} 156 | else la = left_breakdown(la); 157 | } 158 | 159 | -- --------------------------------------------------------------------- 160 | 161 | {- 162 | 163 | ----------------------------------------------------------------------------- 164 | Info file generated by Happy Version 1.19.5 from app/Simple.y 165 | ----------------------------------------------------------------------------- 166 | 167 | 168 | terminal 'C' is unused 169 | 170 | ----------------------------------------------------------------------------- 171 | Grammar 172 | ----------------------------------------------------------------------------- 173 | %start_calc -> Top (0) 174 | Top -> 'A' 'B' (1) 175 | 176 | ----------------------------------------------------------------------------- 177 | Terminals 178 | ----------------------------------------------------------------------------- 179 | 'A' { TokenA } 180 | 'B' { TokenB } 181 | 'C' { TokenC } 182 | 183 | ----------------------------------------------------------------------------- 184 | Non-terminals 185 | ----------------------------------------------------------------------------- 186 | %start_calc rule 0 187 | Top rule 1 188 | 189 | ----------------------------------------------------------------------------- 190 | States 191 | ----------------------------------------------------------------------------- 192 | State 0 193 | 194 | 195 | 'A' shift, and enter state 2 196 | 197 | Top goto state 3 198 | 199 | State 1 200 | 201 | 202 | 'A' shift, and enter state 2 203 | 204 | 205 | State 2 206 | 207 | Top -> 'A' . 'B' (rule 1) 208 | 209 | 'B' shift, and enter state 4 210 | 211 | 212 | State 3 213 | 214 | %start_calc -> Top . (rule 0) 215 | 216 | %eof accept 217 | 218 | 219 | State 4 220 | 221 | Top -> 'A' 'B' . (rule 1) 222 | 223 | %eof reduce using rule 1 224 | 225 | -} 226 | 227 | data Top 228 | = Top TA TB 229 | deriving Show 230 | 231 | data TA = TA 232 | deriving Show 233 | 234 | data TB = TB 235 | deriving Show 236 | 237 | 238 | -- ------------------------------------- 239 | 240 | data Token 241 | = TokenA 242 | | TokenB 243 | | TokenC 244 | deriving Show 245 | 246 | lexer :: String -> [Token] 247 | lexer [] = [] 248 | lexer (c:cs) 249 | | isSpace c = lexer cs 250 | lexer ('A':cs) = TokenA : lexer cs 251 | lexer ('B':cs) = TokenB : lexer cs 252 | lexer ('C':cs) = TokenC : lexer cs 253 | 254 | -- --------------------------------------------------------------------- 255 | 256 | {- 257 | 258 | %token 259 | 'A' { TokenA } 260 | 'B' { TokenB } 261 | 'C' { TokenC } 262 | 263 | %% 264 | 265 | Top : 'A' 'B' { Top TA TB } 266 | ----------------------------- 267 | 268 | | Action 269 | | A B eof | Top 270 | S0 | S2 - - | 3 271 | S1 | S2 - - | - 272 | S2 | - S4 - | - 273 | S3 | - - Ac | = 274 | S4 | - - R1 | 3 275 | 276 | 277 | So parse trace is 278 | 279 | State Symbol Stack Action 280 | 0 'A' (0,e) Shift to state 2, accept 'A' 281 | 2 'B' (0,'A') (4,'B') Shift to state 4, accept 'B' 282 | 4 eof (3,Top) Accept 283 | 284 | 285 | -} 286 | -------------------------------------------------------------------------------- /src/Language/Incremental/LSP.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE OverloadedStrings, TypeOperators, InstanceSigs #-} 4 | -- NoImplicitPrelude 5 | module Language.Incremental.LSP 6 | ( main 7 | ) where 8 | 9 | -- import Data.Maybe 10 | -- import Data.Semigroup 11 | -- import Language.Haskell.LSP.Diagnostics 12 | -- import Protolude hiding (sourceLine, sourceColumn) 13 | -- import Text.Megaparsec (errorPos, parse, SourcePos(..), unPos, parseErrorTextPretty) 14 | -- import Text.PrettyPrint.ANSI.Leijen (renderPretty, displayS) 15 | -- import qualified Data.List.NonEmpty as NonEmpty 16 | -- import qualified Data.Text as T 17 | import Control.Concurrent 18 | import Control.Concurrent.STM.TChan 19 | import qualified Control.Exception as Exception 20 | import Control.Lens 21 | import Control.Monad 22 | import Control.Monad.IO.Class 23 | import Control.Monad.Reader 24 | import Control.Monad.STM 25 | import Data.Default 26 | import qualified Language.Haskell.LSP.Control as LSP.Control 27 | import qualified Language.Haskell.LSP.Core as LSP.Core 28 | import Language.Haskell.LSP.Messages 29 | import qualified Language.Haskell.LSP.Types as LSP 30 | import Language.Haskell.LSP.Types.Capabilities as C 31 | import qualified Language.Haskell.LSP.Types.Lens as LSP 32 | import qualified Language.Haskell.LSP.Utility as LSP 33 | import Language.Incremental.Visualise 34 | import Options.Applicative 35 | import Repetitive2 36 | import System.Exit 37 | import qualified System.Log.Logger as L 38 | import System.Posix.Process 39 | import System.Posix.Types 40 | 41 | data CommandLineOptions 42 | = CommandLineOptions 43 | { serverLogFile :: FilePath 44 | , sessionLogFile :: FilePath 45 | } 46 | 47 | commandLineOptionsParser :: Parser CommandLineOptions 48 | commandLineOptionsParser = CommandLineOptions 49 | <$> strOption 50 | ( long "server-log-file" 51 | <> metavar "FILENAME" 52 | <> help "Log file used for general server logging" 53 | <> value "/tmp/inc-lsp.log" 54 | ) 55 | <*> strOption 56 | ( long "session-log-file" 57 | <> metavar "FILENAME" 58 | <> help "Log file used for general server logging" 59 | <> value "/tmp/inc-lsp.log" 60 | ) 61 | 62 | commandLineOptions :: ProcessID -> ParserInfo CommandLineOptions 63 | commandLineOptions _ = info (commandLineOptionsParser <**> helper) 64 | ( fullDesc 65 | <> header "inc-lsp" 66 | <> progDesc "A Language Server Protocol Implementation for experimental incremental parsers" 67 | ) 68 | 69 | main :: IO () 70 | main = do 71 | opts <- execParser =<< commandLineOptions <$> getProcessID 72 | exitcode <- run opts (return ()) 73 | case exitcode of 74 | 0 -> exitSuccess 75 | c -> exitWith . ExitFailure $ c 76 | 77 | run :: CommandLineOptions -> IO () -> IO Int 78 | run opts dispatcherProc = flip Exception.catches handlers $ do 79 | rin <- atomically newTChan :: IO (TChan ReactorInput) 80 | let dp lf = do 81 | _rpid <- forkIO $ reactor lf rin 82 | dispatcherProc 83 | return Nothing 84 | flip Exception.finally L.removeAllHandlers $ do 85 | -- LSP.Core.setupLogger (Just (serverLogFile opts)) [] L.DEBUG 86 | LSP.Core.setupLogger Nothing [] L.DEBUG 87 | LSP.Control.run 88 | (return (Right ()), dp) 89 | (lspHandlers rin) 90 | lspOptions 91 | (Just (sessionLogFile opts)) 92 | where 93 | handlers = 94 | [ Exception.Handler ioExcept 95 | , Exception.Handler someExcept] 96 | ioExcept (e :: Exception.IOException) = print e >> return 1 97 | someExcept (e :: Exception.SomeException) = print e >> return 1 98 | 99 | -- The reactor is a process that serialises and buffers all requests from the 100 | -- LSP client, so they can be sent to the backend compiler one at a time, and a 101 | -- reply sent. 102 | newtype ReactorInput = 103 | HandlerRequest FromClientMessage -- ^ injected into the reactor 104 | -- input by each of the individual 105 | -- callback handlers 106 | 107 | -- | The monad used in the reactor 108 | type R c a = ReaderT (LSP.Core.LspFuncs c) IO a 109 | 110 | -- | The single point that all events flow through, allowing management of state 111 | -- to stitch replies and requests together from the two asynchronous sides: lsp 112 | -- server and backend compiler 113 | reactor :: LSP.Core.LspFuncs () -> TChan ReactorInput -> IO () 114 | reactor lf inp = 115 | flip runReaderT lf $ forever $ do 116 | inval <- liftIO $ atomically $ readTChan inp 117 | case inval of 118 | HandlerRequest (RspFromClient rm) -> 119 | liftIO $ LSP.logs $ "reactor:got RspFromClient:" ++ show rm 120 | 121 | HandlerRequest (NotDidOpenTextDocument _notification) -> do 122 | liftIO $ LSP.logs "****** reactor: processing NotDidOpenTextDocument" 123 | 124 | HandlerRequest (NotDidChangeTextDocument p) -> do 125 | liftIO $ LSP.logs $ "****** reactor: processing NotDidChangeTextDocument" ++ show p 126 | return () 127 | 128 | HandlerRequest (NotInitialized _) -> 129 | return () 130 | 131 | HandlerRequest (NotDidSaveTextDocument _notification) -> do 132 | liftIO $ LSP.Core.flushDiagnosticsBySourceFunc lf 200 (Just "inc") 133 | return () 134 | 135 | -- -------------------------- 136 | 137 | HandlerRequest (ReqDocumentSymbols req) -> do 138 | liftIO $ LSP.logs $ "reactor:got Document symbol request:" ++ show req 139 | -- C.ClientCapabilities _ tdc _ <- asksLspFuncs LSP.Core.clientCapabilities 140 | let 141 | syms = asHierarchy 142 | -- syms = [ds] 143 | ds = 144 | LSP.DocumentSymbol 145 | "sym" 146 | Nothing 147 | LSP.SkVariable 148 | Nothing 149 | (LSP.Range (LSP.Position 0 0) (LSP.Position 0 3)) 150 | (LSP.Range (LSP.Position 0 0) (LSP.Position 0 3)) 151 | Nothing 152 | {- 153 | DocumentSymbol 154 | { _name :: Text -- ^ The name of this symbol. 155 | -- | More detail for this symbol, e.g the signature of a function. If not 156 | -- provided the name is used. 157 | , _detail :: Maybe Text 158 | , _kind :: SymbolKind -- ^ The kind of this symbol. 159 | , _deprecated :: Maybe Bool -- ^ Indicates if this symbol is deprecated. 160 | -- | The range enclosing this symbol not including leading/trailing 161 | -- whitespace but everything else like comments. This information is 162 | -- typically used to determine if the the clients cursor is inside the symbol 163 | -- to reveal in the symbol in the UI. 164 | , _range :: Range 165 | -- | The range that should be selected and revealed when this symbol is being 166 | -- picked, e.g the name of a function. Must be contained by the the '_range'. 167 | , _selectionRange :: Range 168 | -- | Children of this symbol, e.g. properties of a class. 169 | , _children :: Maybe (List DocumentSymbol) 170 | 171 | -} 172 | reactorSend $ RspDocumentSymbols 173 | $ LSP.Core.makeResponseMessage req (LSP.DSDocumentSymbols (LSP.List syms)) 174 | 175 | -- -------------------------- 176 | 177 | HandlerRequest req -> 178 | liftIO $ LSP.logs $ "reactor: unhandled HandlerRequest:" ++ show req 179 | 180 | reqToURI :: (LSP.HasParams s a1, LSP.HasTextDocument a1 a2, 181 | LSP.HasUri a2 a3) 182 | => s -> a3 183 | reqToURI req = 184 | req ^. 185 | LSP.params . 186 | LSP.textDocument . 187 | LSP.uri 188 | 189 | reactorSend :: FromServerMessage -> R () () 190 | reactorSend msg = do 191 | lf <- ask 192 | liftIO $ LSP.Core.sendFunc lf msg 193 | 194 | lspOptions :: LSP.Core.Options 195 | lspOptions = def 196 | { LSP.Core.textDocumentSync = Just syncOptions } 197 | where 198 | syncOptions :: LSP.TextDocumentSyncOptions 199 | syncOptions = LSP.TextDocumentSyncOptions 200 | { LSP._openClose = Just False 201 | , LSP._change = Just LSP.TdSyncIncremental 202 | , LSP._willSave = Just False 203 | , LSP._willSaveWaitUntil = Just False 204 | , LSP._save = Just $ LSP.SaveOptions $ Just False 205 | } 206 | 207 | lspHandlers :: TChan ReactorInput -> LSP.Core.Handlers 208 | lspHandlers rin = def 209 | { LSP.Core.initializedHandler = Just $ passHandler NotInitialized 210 | , LSP.Core.didChangeTextDocumentNotificationHandler = Just $ passHandler NotDidChangeTextDocument 211 | , LSP.Core.didSaveTextDocumentNotificationHandler = Just $ passHandler NotDidSaveTextDocument 212 | , LSP.Core.documentFormattingHandler = Just $ passHandler ReqDocumentFormatting 213 | , LSP.Core.didOpenTextDocumentNotificationHandler = Just $ passHandler NotDidOpenTextDocument 214 | , LSP.Core.documentSymbolHandler = Just $ passHandler ReqDocumentSymbols 215 | 216 | 217 | } 218 | where 219 | passHandler :: (a -> FromClientMessage) -> LSP.Core.Handler a 220 | passHandler c notification = 221 | atomically $ writeTChan rin (HandlerRequest (c notification)) 222 | -------------------------------------------------------------------------------- /notes.txt: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Top-level binding with no type signature: bar2 :: IO () 5 | *Main> :main 6 | state: 0, token: 1, action: reduce (rule 2), goto state 2 7 | state: 2, token: 1, action: shift, enter state 8 8 | state: 8, token: 2, action: reduce (rule 11), goto state 7 9 | state: 7, token: 2, action: reduce (rule 10), goto state 6 10 | state: 6, token: 2, action: reduce (rule 7), goto state 5 11 | state: 5, token: 2, action: shift, enter state 11 12 | state: 11, token: 1, action: shift, enter state 8 13 | state: 8, token: 6, action: reduce (rule 11), goto state 7 14 | state: 7, token: 6, action: reduce (rule 10), goto state 15 15 | state: 15, token: 6, action: reduce (rule 5), goto state 5 16 | state: 5, token: 6, action: reduce (rule 4), goto state 4 17 | state: 4, token: 6, action: reduce (rule 3), goto state 13 18 | state: 13, token: 6, action: reduce (rule 1), goto state 3 19 | state: 3, token: 6, action: accept. 20 | Plus (Term (Factor (Int 1))) (Factor (Int 2)) 21 | 22 | ----------------------------------------------------------------------------- 23 | 24 | 25 | :main 26 | state: 0, token: 1, action: reduce A (rule 2), goto state 2 27 | state: 2, token: 1, action: not shift, enter state 8 28 | happyShift:(new_state,i,inp)=(8,1,Node {rootLabel = Val False False (HappyTerminal (TokenInt 1)) [] (Just (Tok 1# (TokenInt 1))) (Nothing), subForest = []}) 29 | state: 8, token: 2, action: reduce A (rule 11), goto state 7 30 | state: 7, token: 2, action: reduce A (rule 10), goto state 6 31 | state: 6, token: 2, action: reduce A (rule 7), goto state 5 32 | state: 5, token: 2, action: not shift, enter state 11 33 | happyShift:(new_state,i,inp)=(11,2,Node {rootLabel = Val False False (HappyTerminal TokenPlus) [] (Just (Tok 2# TokenPlus)) (Nothing), subForest = []}) 34 | state: 11, token: 1, action: not shift, enter state 8 35 | happyShift:(new_state,i,inp)=(8,1,Node {rootLabel = Val False False (HappyTerminal (TokenInt 2)) [] (Just (Tok 1# (TokenInt 2))) (Nothing), subForest = []}) 36 | state: 8, tree: HappyErrorToken (-5), action: shift or breakdown. 37 | state: 8, token: 6, action: reduce A (rule 11), goto state 7 38 | state: 7, token: 6, action: reduce A (rule 10), goto state 15 39 | state: 15, token: 6, action: reduce A (rule 5), goto state 5 40 | state: 5, token: 6, action: reduce A (rule 4), goto state 4 41 | state: 4, token: 6, action: reduce A (rule 3), goto state 13 42 | state: 13, token: 6, action: reduce A (rule 1), goto state 3 43 | state: 3, token: 6, action: accept. A 44 | Val False False (HappyAbsSyn4 (Plus (Term (Factor (Int 1))) (Factor (Int 2)))) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 1))) 45 | | 46 | +- Val False False (HappyAbsSyn5 ()) [] (Nothing) (Nothing) 47 | | 48 | +- Val False False (HappyAbsSyn7 (Plus (Term (Factor (Int 1))) (Factor (Int 2)))) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 1))) 49 | | | 50 | | `- Val False False (HappyAbsSyn8 (Plus (Term (Factor (Int 1))) (Factor (Int 2)))) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 2))) 51 | | | 52 | | +- Val False False (HappyAbsSyn8 (Term (Factor (Int 1)))) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 1))) 53 | | | | 54 | | | `- Val False False (HappyAbsSyn9 (Factor (Int 1))) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 1))) 55 | | | | 56 | | | `- Val False False (HappyAbsSyn10 (Int 1)) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 1))) 57 | | | | 58 | | | `- Val False False (HappyTerminal (TokenInt 1)) [] (Just (Tok 1# (TokenInt 1))) (Nothing) 59 | | | 60 | | +- Val False False (HappyTerminal TokenPlus) [] (Just (Tok 2# TokenPlus)) (Nothing) 61 | | | 62 | | `- Val False False (HappyAbsSyn9 (Factor (Int 2))) [] (Just (Tok 1# (TokenInt 2))) (Just (Tok 1# (TokenInt 2))) 63 | | | 64 | | `- Val False False (HappyAbsSyn10 (Int 2)) [] (Just (Tok 1# (TokenInt 2))) (Just (Tok 1# (TokenInt 2))) 65 | | | 66 | | `- Val False False (HappyTerminal (TokenInt 2)) [] (Just (Tok 1# (TokenInt 2))) (Nothing) 67 | | 68 | `- Val False False (HappyAbsSyn6 ()) [] (Nothing) (Nothing) 69 | -------------------------------- 70 | Val False True (HappyAbsSyn4 (Plus (Term (Factor (Int 1))) (Factor (Int 2)))) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 1))) 71 | | 72 | +- Val False False (HappyAbsSyn5 ()) [] (Nothing) (Nothing) 73 | | 74 | +- Val False True (HappyAbsSyn7 (Plus (Term (Factor (Int 1))) (Factor (Int 2)))) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 1))) 75 | | | 76 | | `- Val False True (HappyAbsSyn8 (Plus (Term (Factor (Int 1))) (Factor (Int 2)))) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 2))) 77 | | | 78 | | +- Val False False (HappyAbsSyn8 (Term (Factor (Int 1)))) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 1))) 79 | | | | 80 | | | `- Val False False (HappyAbsSyn9 (Factor (Int 1))) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 1))) 81 | | | | 82 | | | `- Val False False (HappyAbsSyn10 (Int 1)) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 1))) 83 | | | | 84 | | | `- Val False False (HappyTerminal (TokenInt 1)) [] (Just (Tok 1# (TokenInt 1))) (Nothing) 85 | | | 86 | | +- Val True True (HappyErrorToken (-5)) [Tok -10# TokenMinus] (Nothing) (Nothing) 87 | | | 88 | | `- Val False False (HappyAbsSyn9 (Factor (Int 2))) [] (Just (Tok 1# (TokenInt 2))) (Just (Tok 1# (TokenInt 2))) 89 | | | 90 | | `- Val False False (HappyAbsSyn10 (Int 2)) [] (Just (Tok 1# (TokenInt 2))) (Just (Tok 1# (TokenInt 2))) 91 | | | 92 | | `- Val False False (HappyTerminal (TokenInt 2)) [] (Just (Tok 1# (TokenInt 2))) (Nothing) 93 | | 94 | `- Val False False (HappyAbsSyn6 ()) [] (Nothing) (Nothing) 95 | -------------------------------- 96 | state: 0, tree: HappyAbsSyn4 (Plus (, action: left breakdown. 97 | state: 0, tree: HappyAbsSyn5 (), action: shift or breakdown. 98 | state: 0, tree: HappyAbsSyn7 (Plus (, action: left breakdown. 99 | state: 0, tree: HappyAbsSyn8 (Plus (, action: left breakdown. 100 | state: 0, tree: HappyAbsSyn8 (Term (, action: all reductions. 101 | reduceAll:state: 0, token: 1, action: reduce B (rule 2), goto state 2 102 | reduceAll:state: 2, token: 1, action: no shift. 103 | state: 2, token: 1, action: not shift, enter state 8 104 | happyShift:(new_state,i,inp)=(8,1,Node {rootLabel = Val False False (HappyTerminal (TokenInt 1)) [] (Just (Tok 1# (TokenInt 1))) (Nothing), subForest = []}) 105 | state: 8, token: 3, action: reduce A (rule 11), goto state 7 106 | state: 7, token: 3, action: reduce A (rule 10), goto state 6 107 | state: 6, token: 3, action: reduce A (rule 7), goto state 5 108 | state: 5, token: 3, action: not shift, enter state 12 109 | happyShift:(new_state,i,inp)=(12,3,Node {rootLabel = Val False False (HappyTerminal TokenMinus) [] (Just (Tok 3# TokenMinus)) (Nothing), subForest = []}) 110 | state: 12, tree: HappyErrorToken (-5), action: left breakdown. 111 | state: 12, tree: HappyAbsSyn9 (Factor, action: all reductions. 112 | reduceAll:state: 12, token: 1, action: no shift. 113 | state: 12, token: 1, action: not shift, enter state 8 114 | happyShift:(new_state,i,inp)=(8,1,Node {rootLabel = Val False False (HappyTerminal (TokenInt 2)) [] (Just (Tok 1# (TokenInt 2))) (Nothing), subForest = []}) 115 | state: 8, tree: HappyAbsSyn6 (), action: shift or breakdown. 116 | state: 8, token: 6, action: reduce A (rule 11), goto state 7 117 | state: 7, token: 6, action: reduce A (rule 10), goto state 14 118 | state: 14, token: 6, action: reduce A (rule 6), goto state 5 119 | state: 5, token: 6, action: reduce A (rule 4), goto state 4 120 | state: 4, token: 6, action: reduce A (rule 3), goto state 13 121 | state: 13, token: 6, action: reduce A (rule 1), goto state 3 122 | state: 3, token: 6, action: accept. A 123 | Val False False (HappyAbsSyn4 (Minus (Term (Factor (Int 1))) (Factor (Int 2)))) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 1))) 124 | | 125 | +- Val False False (HappyAbsSyn5 ()) [] (Nothing) (Nothing) 126 | | 127 | +- Val False False (HappyAbsSyn7 (Minus (Term (Factor (Int 1))) (Factor (Int 2)))) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 1))) 128 | | | 129 | | `- Val False False (HappyAbsSyn8 (Minus (Term (Factor (Int 1))) (Factor (Int 2)))) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 2))) 130 | | | 131 | | +- Val False False (HappyAbsSyn8 (Term (Factor (Int 1)))) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 1))) 132 | | | | 133 | | | `- Val False False (HappyAbsSyn9 (Factor (Int 1))) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 1))) 134 | | | | 135 | | | `- Val False False (HappyAbsSyn10 (Int 1)) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 1))) 136 | | | | 137 | | | `- Val False False (HappyTerminal (TokenInt 1)) [] (Just (Tok 1# (TokenInt 1))) (Nothing) 138 | | | 139 | | +- Val False False (HappyTerminal TokenMinus) [] (Just (Tok 3# TokenMinus)) (Nothing) 140 | | | 141 | | `- Val False False (HappyAbsSyn9 (Factor (Int 2))) [] (Just (Tok 1# (TokenInt 2))) (Just (Tok 1# (TokenInt 2))) 142 | | | 143 | | `- Val False False (HappyAbsSyn10 (Int 2)) [] (Just (Tok 1# (TokenInt 2))) (Just (Tok 1# (TokenInt 2))) 144 | | | 145 | | `- Val False False (HappyTerminal (TokenInt 2)) [] (Just (Tok 1# (TokenInt 2))) (Nothing) 146 | | 147 | `- Val False False (HappyAbsSyn6 ()) [] (Nothing) (Nothing) 148 | *Main> :r 149 | 150 | -------------------------------------------------------------------------- 151 | 152 | Input (modified) tree 153 | 154 | Val False True (HappyAbsSyn4 (Plus (Term (Factor (Int 1))) (Factor (Int 2)))) (Just 0) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 2))) 155 | | 156 | +- Val False False (HappyAbsSyn5 ()) (Just 1) [] (Nothing) (Nothing) 157 | | 158 | +- Val False True (HappyAbsSyn7 (Plus (Term (Factor (Int 1))) (Factor (Int 2)))) (Just 3) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 2))) 159 | | | 160 | | `- Val False True (HappyAbsSyn8 (Plus (Term (Factor (Int 1))) (Factor (Int 2)))) (Just 4) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 2))) 161 | | | 162 | | +- Val False False (HappyAbsSyn8 (Term (Factor (Int 1)))) (Just 4) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 1))) 163 | | | | 164 | | | `- Val False False (HappyAbsSyn9 (Factor (Int 1))) (Just 5) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 1))) 165 | | | | 166 | | | `- Val False False (HappyAbsSyn10 (Int 1)) (Just 6) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 1))) 167 | | | | 168 | | | `- Val False False (HappyTerminal (TokenInt 1)) (Nothing) [] (Just (Tok 1# (TokenInt 1))) (Just (Tok 1# (TokenInt 1))) 169 | | | 170 | | +- Val True True (HappyErrorToken (-5)) (Nothing) [Tok -10# TokenMinus] (Nothing) (Nothing) 171 | | | 172 | | `- Val False False (HappyAbsSyn9 (Factor (Int 2))) (Just 5) [] (Just (Tok 1# (TokenInt 2))) (Just (Tok 1# (TokenInt 2))) 173 | | | 174 | | `- Val False False (HappyAbsSyn10 (Int 2)) (Just 6) [] (Just (Tok 1# (TokenInt 2))) (Just (Tok 1# (TokenInt 2))) 175 | | | 176 | | `- Val False False (HappyTerminal (TokenInt 2)) (Nothing) [] (Just (Tok 1# (TokenInt 2))) (Just (Tok 1# (TokenInt 2))) 177 | | 178 | `- Val False False (HappyAbsSyn6 ()) (Just 2) [] (Nothing) (Nothing) 179 | 180 | -------------------------------------------------------------------------------- 181 | 182 | For each (state, non-terminal), give goto val 183 | Goto:array (0,17) 184 | [(0,array (4,10) [(4,Goto 3),(5,Goto 2),(6,NoGoto), (7,NoGoto),(8,NoGoto),(9,NoGoto), (10,NoGoto)]) 185 | ,(1,array (4,10) [(4,NoGoto),(5,Goto 2),(6,NoGoto), (7,NoGoto),(8,NoGoto),(9,NoGoto), (10,NoGoto)]) 186 | ,(2,array (4,10) [(4,NoGoto),(5,NoGoto),(6,NoGoto), (7,Goto 4),(8,Goto 5),(9,Goto 6), (10,Goto 7)]) 187 | ,(3,array (4,10) [(4,NoGoto),(5,NoGoto),(6,NoGoto), (7,NoGoto),(8,NoGoto),(9,NoGoto), (10,NoGoto)]) 188 | ,(4,array (4,10) [(4,NoGoto),(5,NoGoto),(6,Goto 13),(7,NoGoto),(8,NoGoto),(9,NoGoto), (10,NoGoto)]) 189 | ,(5,array (4,10) [(4,NoGoto),(5,NoGoto),(6,NoGoto), (7,NoGoto),(8,NoGoto),(9,NoGoto), (10,NoGoto)]) 190 | ,(6,array (4,10) [(4,NoGoto),(5,NoGoto),(6,NoGoto), (7,NoGoto),(8,NoGoto),(9,NoGoto), (10,NoGoto)]) 191 | ,(7,array (4,10) [(4,NoGoto),(5,NoGoto),(6,NoGoto), (7,NoGoto),(8,NoGoto),(9,NoGoto), (10,NoGoto)]) 192 | ,(8,array (4,10) [(4,NoGoto),(5,NoGoto),(6,NoGoto), (7,NoGoto),(8,NoGoto),(9,NoGoto), (10,NoGoto)]) 193 | ,(9,array (4,10) [(4,NoGoto),(5,NoGoto),(6,NoGoto), (7,NoGoto),(8,NoGoto),(9,NoGoto), (10,Goto 17)]) 194 | ,(10,array (4,10) [(4,NoGoto),(5,NoGoto),(6,NoGoto), (7,NoGoto),(8,NoGoto),(9,NoGoto), (10,Goto 16)]) 195 | ,(11,array (4,10) [(4,NoGoto),(5,NoGoto),(6,NoGoto), (7,NoGoto),(8,NoGoto),(9,Goto 15),(10,Goto 7)]) 196 | ,(12,array (4,10) [(4,NoGoto),(5,NoGoto),(6,NoGoto), (7,NoGoto),(8,NoGoto),(9,Goto 14),(10,Goto 7)]) 197 | ,(13,array (4,10) [(4,NoGoto),(5,NoGoto),(6,NoGoto), (7,NoGoto),(8,NoGoto),(9,NoGoto), (10,NoGoto)]) 198 | ,(14,array (4,10) [(4,NoGoto),(5,NoGoto),(6,NoGoto), (7,NoGoto),(8,NoGoto),(9,NoGoto), (10,NoGoto)]) 199 | ,(15,array (4,10) [(4,NoGoto),(5,NoGoto),(6,NoGoto), (7,NoGoto),(8,NoGoto),(9,NoGoto), (10,NoGoto)]) 200 | ,(16,array (4,10) [(4,NoGoto),(5,NoGoto),(6,NoGoto), (7,NoGoto),(8,NoGoto),(9,NoGoto), (10,NoGoto)]) 201 | ,(17,array (4,10) [(4,NoGoto),(5,NoGoto),(6,NoGoto), (7,NoGoto),(8,NoGoto),(9,NoGoto), (10,NoGoto)])] 202 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | 635 | Copyright (C) 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | Copyright (C) 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | -------------------------------------------------------------------------------- /happy-templates/GenericTemplate.hs: -------------------------------------------------------------------------------- 1 | -- $Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp $ 2 | 3 | #ifdef HAPPY_GHC 4 | #undef __GLASGOW_HASKELL__ 5 | #define HAPPY_IF_GHC_GT_500 #if __GLASGOW_HASKELL__ > 500 6 | #define HAPPY_IF_GHC_GE_503 #if __GLASGOW_HASKELL__ >= 503 7 | #define HAPPY_ELIF_GHC_500 #elif __GLASGOW_HASKELL__ == 500 8 | #define HAPPY_IF_GHC_GT_706 #if __GLASGOW_HASKELL__ > 706 9 | #define HAPPY_ELSE #else 10 | #define HAPPY_ENDIF #endif 11 | #define HAPPY_DEFINE #define 12 | #endif 13 | 14 | #ifdef HAPPY_GHC 15 | #define ILIT(n) n# 16 | #define IBOX(n) (Happy_GHC_Exts.I# (n)) 17 | #define FAST_INT Happy_GHC_Exts.Int# 18 | -- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. 19 | HAPPY_IF_GHC_GT_706 20 | HAPPY_DEFINE LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Bool) 21 | HAPPY_DEFINE GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Bool) 22 | HAPPY_DEFINE EQ(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.==# m)) :: Bool) 23 | HAPPY_ELSE 24 | HAPPY_DEFINE LT(n,m) (n Happy_GHC_Exts.<# m) 25 | HAPPY_DEFINE GTE(n,m) (n Happy_GHC_Exts.>=# m) 26 | HAPPY_DEFINE EQ(n,m) (n Happy_GHC_Exts.==# m) 27 | HAPPY_ENDIF 28 | #define PLUS(n,m) (n Happy_GHC_Exts.+# m) 29 | #define MINUS(n,m) (n Happy_GHC_Exts.-# m) 30 | #define TIMES(n,m) (n Happy_GHC_Exts.*# m) 31 | #define NEGATE(n) (Happy_GHC_Exts.negateInt# (n)) 32 | #define IF_GHC(x) (x) 33 | #else 34 | #define ILIT(n) (n) 35 | #define IBOX(n) (n) 36 | #define FAST_INT Int 37 | #define LT(n,m) (n < m) 38 | #define GTE(n,m) (n >= m) 39 | #define EQ(n,m) (n == m) 40 | #define PLUS(n,m) (n + m) 41 | #define MINUS(n,m) (n - m) 42 | #define TIMES(n,m) (n * m) 43 | #define NEGATE(n) (negate (n)) 44 | #define IF_GHC(x) 45 | #endif 46 | 47 | data Happy_IntList = HappyCons FAST_INT Happy_IntList 48 | 49 | #if defined(HAPPY_ARRAY) 50 | #define CONS(h,t) (HappyCons (h) (t)) 51 | #else 52 | #define CONS(h,t) ((h):(t)) 53 | #endif 54 | 55 | #if defined(HAPPY_INCR) 56 | # define ERROR_TOK ILIT(0) 57 | # define DO_ACTION(verifying,state,i,tk,sts,stk) happyDoAction verifying i tk state sts (stk) 58 | # define HAPPYSTATE(i) (i) 59 | # define GOTO(action) happyGoto 60 | # define IF_ARRAYS(x) (x) 61 | # define NODE(x) (Node (x)) 62 | #elif defined(HAPPY_ARRAY) 63 | # define ERROR_TOK ILIT(0) 64 | # define DO_ACTION(state,i,tk,sts,stk) happyDoAction i tk state sts (stk) 65 | # define HAPPYSTATE(i) (i) 66 | # define GOTO(action) happyGoto 67 | # define IF_ARRAYS(x) (x) 68 | # define NODE(x) (x) 69 | #else 70 | # define ERROR_TOK ILIT(1) 71 | # define DO_ACTION(state,i,tk,sts,stk) state i i tk HAPPYSTATE(state) sts (stk) 72 | # define HAPPYSTATE(i) (HappyState (i)) 73 | # define GOTO(action) action 74 | # define IF_ARRAYS(x) 75 | # define NODE(x) (x) 76 | #endif 77 | 78 | #if defined(HAPPY_COERCE) 79 | #define GET_ERROR_TOKEN(x) (case Happy_GHC_Exts.unsafeCoerce# x of { IBOX(i) -> i }) 80 | #define MK_ERROR_TOKEN(i) (Happy_GHC_Exts.unsafeCoerce# IBOX(i)) 81 | #define MK_TOKEN(x) (happyInTok (x)) 82 | #elif defined(HAPPY_INCR) 83 | #define GET_ERROR_TOKEN(x) (case x of { Node (Val{ here = HappyErrorToken IBOX(i)}) _ -> i} ) 84 | #define MK_ERROR_TOKEN(i) (mkNode (HappyErrorToken IBOX(i)) Nothing False [] ) 85 | #define MK_TOKEN(x) (mkNode (HappyTerminal (x)) []) 86 | #else 87 | #define GET_ERROR_TOKEN(x) (case x of { HappyErrorToken IBOX(i) -> i }) 88 | #define MK_ERROR_TOKEN(i) (HappyErrorToken IBOX(i)) 89 | #define MK_TOKEN(x) (HappyTerminal (x)) 90 | #endif 91 | 92 | #if defined(HAPPY_DEBUG) 93 | #define DEBUG_TRACE(s) (happyTrace (s)) $ 94 | happyTrace string expr = Happy_System_IO_Unsafe.unsafePerformIO $ do 95 | Happy_System_IO.hPutStr Happy_System_IO.stderr string 96 | return expr 97 | #else 98 | #define DEBUG_TRACE(s) {- nothing -} 99 | #endif 100 | 101 | #if defined(HAPPY_INCR) 102 | #define TOK_ERR_INT ILIT(-10) 103 | mkTok t = Tok TOK_ERR_INT t 104 | -- nullTok = Tok TOK_ERR_INT notHappyAtAll 105 | -- nullTok = Tok TOK_ERR_INT TokenPlus 106 | -- nullTok = Tok TOK_ERR_INT TokenA 107 | #define TERMINAL(i) (i) 108 | #define TOKEN(i) ((i)) 109 | #else 110 | #define TERMINAL(i) (i) 111 | #define TOKEN(i) (i) 112 | #endif 113 | 114 | infixr 9 `HappyStk` 115 | data HappyStk a = HappyStk a (HappyStk a) 116 | 117 | -- AZ: following to come out of happy ProduceCode 118 | -- type HappyAbsSynType = HappyAbsSyn Exp () () Exp Exp Term Factor 119 | -- type HappyAbsSynType = HappyAbsSyn () () () Exp Exp 120 | -- type HappyAbsSynType = HappyAbsSyn Root () () Root Root () [B] B () 121 | -- type HappyAbsSynType = HappyAbsSyn Root () () Root Root () [B] B () (BinaryT B) 122 | {- 123 | 7 = 4 124 | 5 = () 125 | 6 = () 126 | 8 = 7 = Root 127 | 10 = [B] 128 | 9 = () 129 | 13 = BTree B 130 | 10 = [B] 131 | 11 = B 132 | 12 = () 133 | 13 = BTree B 134 | -} 135 | 136 | 137 | -- type NodeVal = Val HappyAbsSynType Tok 138 | 139 | -- instance Pretty HappyAbsSynType 140 | 141 | data DoACtionMode = Normal | AllReductions 142 | deriving Eq 143 | 144 | data Verifying = Verifying | NotVerifying 145 | deriving (Eq, Show) 146 | 147 | ----------------------------------------------------------------------------- 148 | -- starting the parse 149 | 150 | #define HAPPYSTATESENTINEL (ILIT(-1000)) 151 | happyNodeSentinel = mkNode (HappyErrorToken (-1000)) Nothing False [] 152 | 153 | -- happyParse :: FAST_INT -> [HappyInput] -> HappyIdentity HappyInput 154 | happyParse start_state = happyNewToken NotVerifying start_state CONS(HAPPYSTATESENTINEL,notHappyAtAll) (happyNodeSentinel `HappyStk` notHappyAtAll) 155 | 156 | -- showStacks :: Happy_IntList -> HappyStk HappyInput -> String 157 | showStacks (CONS(HAPPYSTATESENTINEL,_)) _ = "[]" 158 | showStacks (CONS(st,sts)) ((Node v _) `HappyStk` stks) 159 | = show (IBOX(st),take 40 $ showHere v) ++ ":" ++ showStacks sts stks 160 | 161 | -- showInputQ :: [HappyInput] -> String 162 | showInputQ is = "[" ++ intercalate "," (map (showHere . rootLabel) is) ++ "]" 163 | 164 | -- showInput :: [HappyInput] -> String 165 | showInput ts = "[" ++ intercalate "," (map (showHere . rootLabel) ts) ++ "]" 166 | 167 | ----------------------------------------------------------------------------- 168 | -- Accepting the parse 169 | 170 | -- If the current token is ERROR_TOK, it means we've just accepted a partial 171 | -- parse (a %partial parser). We must ignore the saved token on the top of 172 | -- the stack in this case. 173 | happyAccept ERROR_TOK tk st sts (_ `HappyStk` ans `HappyStk` _) = 174 | happyReturn1 ans 175 | happyAccept j tk st sts (HappyStk ans _) = 176 | IF_GHC(happyTcHack j IF_ARRAYS(happyTcHack st)) (happyReturn1 ans) 177 | 178 | ----------------------------------------------------------------------------- 179 | -- Arrays in incremental mode: do the next action 180 | 181 | #if defined(HAPPY_INCR) 182 | 183 | -- | A Node stores the components of the parse tree as it is built. It is 184 | -- versioned, and provides the basis for the re-use of prior parse information 185 | -- when incremental changes occur. 186 | -- It is parameterised by the HappyAbsSynType 187 | type Node a b = Tree (Val a b) 188 | -- TODO:consider using a DualTree instead, with monoidal instances for the 189 | -- change flag and next/last terminal propagation 190 | 191 | -- instance (Show a, Show b) => Show (Node a b) where 192 | -- show (Node (Val cl cc h ts nt) cs) = intercalate " " ["Node",show cl, show cc,"(" ++ show h ++ ")",show cs,show ts, show nt] 193 | instance (Show a, Pretty a, Show b, Pretty b) => Pretty (Node a b) where 194 | pretty (Node (Val cl cc h hnt ts nt lt lf rf gf) cs) 195 | = "Node" <+> pretty cl <+> pretty cc <+> parens (pretty nt) <+> parens (pretty lt) 196 | <+> parens (pretty hnt) 197 | <+> pretty lf <+> pretty rf <+> pretty gf 198 | <> line <> (indent 3 (pretty h)) 199 | <> line <> (indent 4 (pretty cs)) 200 | <> line <> (indent 4 (pretty ts)) 201 | 202 | -- TODO: consider space-efficient storage of the Val structure. bitfields, what else? 203 | data Val a b = Val 204 | { changedLocal :: !Bool 205 | , changedChild :: !Bool -- ^set if any of the children have a change 206 | , here :: !a 207 | , here_nt :: !(Maybe Int) 208 | , terminals :: ![b] 209 | , next_terminal :: !(Maybe b) -- ^ the leftmost terminal of the yield of the tree 210 | , last_terminal :: !(Maybe b) -- ^ the rightmost terminal of the yield of the tree 211 | , leftFragile :: !Bool -- ^ Fragile on leftmost edge 212 | , rightFragile :: !Bool -- ^ Fragile on rightmost edge 213 | , grammarFragile :: !Bool -- ^ The grammar production used to produce 214 | -- this node is fragile (Has a conflict, or 215 | -- precedence) 216 | } 217 | instance (Show a, Show b) => Show (Val a b) where 218 | show v@(Val cl cc h hnt ts nt lt lf rf gf) 219 | = unwords ["Val",showChanged v 220 | , showFragile v 221 | , "(" ++ show h ++ ")" 222 | , "(" ++ show hnt ++ ")",show ts 223 | , "(" ++ show nt ++ ")", "(" ++ show lt ++ ")" 224 | ] 225 | instance (Show a, Pretty a, Show b, Pretty b) => Pretty (Val a b) where 226 | pretty ((Val cl cc h hnt ts nt lt lf rf gf) ) 227 | = "Val" <+> pretty cl <+> pretty cc <+> parens (pretty nt) <+> parens (pretty lt) <+> parens (pretty hnt) 228 | <+> pretty lf <+> pretty rf <+> pretty gf 229 | <> line <> (indent 3 (pretty h)) 230 | <> line <> (indent 4 (pretty ts)) 231 | 232 | showHere :: (Show a, Show b) => Val a b -> String 233 | showHere v@(Val { here = h, here_nt = Nothing, terminals = ts }) 234 | = showFragile v ++ "T " ++ show h -- ++ " " ++ show ts 235 | showHere v@(Val { here = h, here_nt = Just nt, terminals = ts }) 236 | = showFragile v ++ "NT" ++ show nt ++ " " ++ show h -- ++ " " ++ show ts 237 | 238 | showChanged :: (Show a, Show b) => Val a b -> String 239 | showChanged Val { changedLocal = l, changedChild = c } 240 | = concat ["[ch:",mt "L" l, mt "C" c, "]"] 241 | where 242 | mt str True = str 243 | mt _ False = "" 244 | 245 | showFragile :: (Show a, Show b) => Val a b -> String 246 | showFragile Val { grammarFragile = g, leftFragile = l, rightFragile = r} 247 | = concat ["[fr:",mt "G" g, mt "L" l, mt "R" r, "]"] 248 | where 249 | mt str True = str 250 | mt _ False = "" 251 | 252 | mkNode x mnt gf cs 253 | = Node (Val 254 | { here = x 255 | , here_nt = mnt 256 | , changedLocal = False, changedChild = False 257 | , terminals = [] 258 | , next_terminal = getNextTerminal cs 259 | , last_terminal = getLastTerminal cs 260 | , leftFragile = goL cs 261 | , rightFragile = goR cs 262 | , grammarFragile = gf 263 | }) cs 264 | where 265 | goL [] = False 266 | goL ((Node v _):cs') 267 | = if grammarFragile v || leftFragile v 268 | then True 269 | else case next_terminal v of 270 | Nothing -> goL cs' 271 | Just _ -> False 272 | goR [] = False 273 | goR ((Node v _):cs') 274 | = if grammarFragile v || rightFragile v 275 | then True 276 | else case last_terminal v of 277 | Nothing -> goR cs' 278 | Just _ -> False 279 | 280 | getNextTerminal :: [Node a b] -> Maybe b 281 | getNextTerminal [] = Nothing 282 | getNextTerminal cs 283 | = case catMaybes (map (next_terminal . rootLabel) cs) of 284 | [] -> Nothing 285 | (nt:_) -> Just nt 286 | 287 | getLastTerminal :: [Node a b] -> Maybe b 288 | getLastTerminal [] = Nothing 289 | getLastTerminal cs 290 | = case catMaybes (map (last_terminal . rootLabel) cs) of 291 | [] -> Nothing 292 | ls -> Just (last ls) 293 | 294 | mkNodeNt x mnt gf cs nt 295 | = let Node v cs' = (mkNode x mnt gf cs) 296 | in Node (v { next_terminal = Just nt, last_terminal = Just nt, terminals = [nt] }) cs' 297 | 298 | isFragile :: (Node a b) -> Bool 299 | isFragile (Node v _) = grammarFragile v || leftFragile v || rightFragile v 300 | 301 | -- AZ:NOTE: The second param below (Token) can/should be moved into the Input 302 | -- type, as it is meaningless for a nonterminal. But what about compatibility 303 | -- with other happy options? 304 | -- 305 | -- The problem comes from the mapping of a Token to a unique number in 306 | -- happyNewToken 307 | -- 308 | -- For now, keep it outside, but give an error value when processing a NonTerminal 309 | -- This leads to the unfortunate creation of a second input type. 310 | -- data ParserInput a 311 | -- = InputToken Token 312 | -- | InputTree a 313 | 314 | data Tok = Tok FAST_INT Token 315 | deriving Show 316 | instance Pretty Tok 317 | 318 | -- type HappyInput = Node HappyAbsSynType Tok 319 | 320 | mkTokensNode tks = setTerminals (mkNode (HappyErrorToken (-5)) Nothing False []) tks 321 | 322 | setTerminals :: Node a b -> [b] -> Node a b 323 | setTerminals (Node v cs) ts = Node (v { terminals = ts}) cs 324 | 325 | getTerminals :: Node a b -> [b] 326 | getTerminals (Node v cs) = terminals v 327 | 328 | -- happyDoAction :: Verifying 329 | -- -> FAST_INT -- ^ Current lookahead token number 330 | -- -> HappyInput -- ^ input being processed. "parse stack" from the paper Same as first item on input list? 331 | -- -> FAST_INT -- ^ Current state 332 | -- -> Happy_IntList -> HappyStk HappyInput -- ^ Current state and shifted item stack 333 | -- -> [HappyInput] -- ^ Input being processed 334 | -- -> HappyIdentity HappyInput 335 | happyDoAction verifying la inp@(Node v@(Val {terminals = toks, next_terminal = mnext, here_nt = mnt}) cs) st sts stk tks 336 | = DEBUG_TRACE("happyDoAction:tks=" ++ showInputQ tks ++ "\n") 337 | DEBUG_TRACE("happyDoAction:stacks=" ++ showStacks sts stk ++ "\n") 338 | DEBUG_TRACE("happyDoAction:inp=" ++ showHere v ++ "\n") 339 | case toks of -- Terminals 340 | (tok@(Tok i tk):ts) -> 341 | DEBUG_TRACE("t:state: " ++ show IBOX(st) ++ 342 | ",\tfragile: " ++ show fragile ++ 343 | ",\ttoken: " ++ show IBOX(i) ++ 344 | ",\taction: ") 345 | case action of 346 | ILIT(0) -> DEBUG_TRACE("fail.\n") 347 | if verifying == Verifying 348 | then rightBreakdown st sts stk tks 349 | else happyFail (happyExpListPerState (IBOX(st) :: Int)) i inp st sts stk tks 350 | ILIT(-1) -> DEBUG_TRACE("accept. A\n") 351 | happyAccept i tk st sts stk tks 352 | n | LT(n,(ILIT(0) :: FAST_INT)) 353 | -> DEBUG_TRACE("reduce (rule " ++ show rule ++ ")") 354 | (happyReduceArr Happy_Data_Array.! rule) NotVerifying fragile i inp st sts stk tks 355 | where rule = IBOX(NEGATE(PLUS(n,(ILIT(1) :: FAST_INT)))) 356 | n -> DEBUG_TRACE("shift, enter state " 357 | ++ show IBOX(new_state) 358 | ++ "\n") 359 | happyShift NotVerifying new_state i (mkNodeNt (HappyTerminal tk) Nothing fragile [] tok) st sts stk tks 360 | where new_state = MINUS(n,(ILIT(1) :: FAST_INT)) 361 | where action = lookupAction st i 362 | fragile = happyFragileState IBOX(st) 363 | _ -> -- Non-terminal input 364 | DEBUG_TRACE("nt:state: " ++ show IBOX(st) ++ 365 | ",\tfragile: " ++ show (happyFragileState IBOX(st)) ++ 366 | ",\ttree: " ++ (take 35 $ show (here $ rootLabel inp)) ++ 367 | ",\taction: ") 368 | if changed inp || isFragile inp 369 | then DEBUG_TRACE ("left breakdown.\n") 370 | leftBreakdown verifying la inp st sts stk tks 371 | else 372 | case mnt of 373 | Just (IBOX(i)) -> 374 | DEBUG_TRACE("nt:" ++ show (IBOX(i)) ++ ",actionv:" ++ show (IBOX(action)) ++ ":") 375 | ------------------------------- 376 | case action of 377 | ILIT(0) -> DEBUG_TRACE("fail.\n") 378 | if null cs 379 | then happyNewToken verifying st sts stk tks 380 | else leftBreakdown NotVerifying la inp st sts stk tks 381 | ILIT(-1) -> DEBUG_TRACE("nt:accept. A\n") 382 | -- This can never happen 383 | notHappyAtAll 384 | n | LT(n,(ILIT(0) :: FAST_INT)) -> DEBUG_TRACE("reduce (rule " ++ show rule 385 | ++ ")") 386 | (happyReduceArr Happy_Data_Array.! rule) NotVerifying fragile i inp st sts stk tks 387 | where rule = IBOX(NEGATE(PLUS(n,(ILIT(1) :: FAST_INT)))) 388 | n -> DEBUG_TRACE("shift, enter state " 389 | ++ show IBOX(new_state) 390 | ++ "\n") 391 | happyShift Verifying new_state i (Node v' cs) st sts stk tks 392 | where new_state = MINUS(n,(ILIT(1) :: FAST_INT)) 393 | v' = v { grammarFragile = fragile } 394 | where action = lookupAction st i 395 | fragile = happyFragileState IBOX(st) 396 | ------------------------------- 397 | Nothing -> DEBUG_TRACE ("mnext == Nothing.\n") 398 | happyNewToken NotVerifying st sts stk tks 399 | 400 | 401 | -- leftBreakdown :: Verifying 402 | -- -> FAST_INT -- ^ Current lookahead token number 403 | -- -> HappyInput -- ^ input being processed. "parse stack" from the paper Same as first item on input list? 404 | -- -> FAST_INT -- ^ Current state 405 | -- -> Happy_IntList -> HappyStk HappyInput -- ^ Current state and shifted item stack 406 | -- -> [HappyInput] -- ^ Input being processed 407 | -- -> HappyIdentity HappyInput 408 | leftBreakdown verifying la inp@(Node v cs) st sts stk ts 409 | = DEBUG_TRACE("leftBreakdown:ts=" ++ showInputQ ts ++ "\n") 410 | DEBUG_TRACE("leftBreakdown:inp=" ++ showHere v ++ "\n") 411 | case cs of 412 | [] -> DEBUG_TRACE("leftBreakdown:no children\n") 413 | -- happyNewToken verifying st sts stk ts 414 | -- happyNewToken verifying st sts stk (inp':ts) 415 | happyDoAction verifying la inp' st sts stk ts 416 | where inp' = Node (v { changedLocal = False, changedChild = False}) cs 417 | (c:cs') -> if isFragile c 418 | then DEBUG_TRACE("leftBreakdown:fragile:" ++ showHere (rootLabel c) ++ "\n") 419 | leftBreakdown verifying la c st sts stk (cs' ++ ts) 420 | else DEBUG_TRACE("leftBreakdown:not fragile\n") 421 | happyNewToken verifying st sts stk (cs ++ ts) 422 | 423 | -- rightBreakdown :: FAST_INT -- ^ Current state 424 | -- -> Happy_IntList -> HappyStk HappyInput -- ^ Current state and shifted item stack 425 | -- -> [HappyInput] -- ^ Input being processed 426 | -- -> HappyIdentity HappyInput 427 | rightBreakdown st sts@(CONS(sts1,stss)) stk@(stk1@(Node v cs) `HappyStk` stks) 428 | -- Break down the right hand edge of the top of the parse stack until it is 429 | -- the last_terminal value of the original. 430 | -- Nodes not having a last_terminal are discarded (no yield) 431 | = DEBUG_TRACE("rightBreakdown:stacks=" ++ (showStacks sts stk) ++ "\n") 432 | if hasYield stk1 433 | then case cs of 434 | [] -> DEBUG_TRACE("rightBreakdown:has yield, no children, ie token:(st,sts1,stk1)=" ++ 435 | (unwords [show IBOX(st),show IBOX(sts1), take 30 ( show (here v))]) ++ ".\n") 436 | case last_terminal v of 437 | Just (Tok i _) -> 438 | case (nextStateShift sts1 i) of 439 | Just (IBOX(st2)) -> DEBUG_TRACE("rightBreakdown:nextStateShift:" ++ show (IBOX(sts1),IBOX(i),IBOX(st2)) ++ "\n") 440 | happyNewToken NotVerifying st2 sts stk 441 | Nothing -> notHappyAtAll 442 | Nothing -> DEBUG_TRACE("rightBreakdown:no nt\n") 443 | happyNewToken NotVerifying sts1 sts stk 444 | _ -> -- shift each child onto the stack, then call rightBreakdown again 445 | DEBUG_TRACE("rightBreakdown:going through children (n=" ++ show (length cs) ++ ").\n") 446 | rightBreakdown st2 sts' stk' 447 | where 448 | (st',sts',stk') = foldl' go (IBOX(sts1),stss,stks) cs 449 | !(IBOX(st2)) = st' 450 | -- go :: (Int, Happy_IntList, HappyStk HappyInput) -> HappyInput -> (Int, Happy_IntList, HappyStk HappyInput) 451 | go (IBOX(st), sts, stk) c@(Node v@(Val {last_terminal = mtok,here_nt = mnt}) _) 452 | = DEBUG_TRACE("rightBreakdown:go:(st,v)=" ++ show (IBOX(st),take 30 $ showHere v) ++ "\n") 453 | case (mnt, mtok) of 454 | (Just (IBOX(nt)), Just (Tok i tk)) -> 455 | DEBUG_TRACE("go:nt " ++ (showStacks sts stk) ++ "\n") 456 | (IBOX(nextState st nt), CONS(st,sts), (c `HappyStk` stk)) 457 | (Nothing, Just (Tok i tk)) -> 458 | DEBUG_TRACE("go:terminal " ++ (showStacks sts stk) ++ "\n") 459 | (IBOX(nextState st i), CONS(st,sts), (c `HappyStk` stk)) 460 | _ -> DEBUG_TRACE("rightBreakdown:no non-terminal and/or no last_terminal.\n") notHappyAtAll 461 | 462 | else DEBUG_TRACE("rightBreakdown,no yield, popping stack") rightBreakdown sts1 stss stks 463 | 464 | lookupAction' :: Int -> Int -> Int 465 | lookupAction' st' i' = 466 | case (st',i') of 467 | (IBOX(st), IBOX(i)) -> (IBOX(lookupAction st i)) 468 | 469 | lookupAction :: FAST_INT -> FAST_INT -> FAST_INT 470 | lookupAction st i = action 471 | where off = indexShortOffAddr happyActOffsets st 472 | off_i = PLUS(off,i) 473 | check = if GTE(off_i,(ILIT(0) :: FAST_INT)) 474 | then EQ(indexShortOffAddr happyCheck off_i, i) 475 | else False 476 | action 477 | | check = indexShortOffAddr happyTable off_i 478 | | otherwise = indexShortOffAddr happyDefActions st 479 | 480 | 481 | nextState' :: Int -> Int -> Int 482 | nextState' st' nt' = 483 | case (st',nt') of 484 | (IBOX(st), IBOX(nt)) -> (IBOX(nextState st nt)) 485 | 486 | nextState :: FAST_INT -> FAST_INT -> FAST_INT 487 | nextState st nt = 488 | if happyGotoValid IBOX(st) IBOX(nt) 489 | then new_state 490 | else ILIT(0) 491 | where off = indexShortOffAddr happyGotoOffsets st 492 | off_i = PLUS(off,nt) 493 | new_state = indexShortOffAddr happyTable off_i 494 | 495 | nextStateShift' :: Int -> Int -> Maybe Int 496 | nextStateShift' st' i' = 497 | case (st',i') of 498 | ((IBOX(st)), (IBOX(i))) -> nextStateShift st i 499 | 500 | nextStateShift :: FAST_INT -> FAST_INT -> Maybe Int 501 | nextStateShift st i = 502 | if (GTE(action, (ILIT(1) :: FAST_INT))) 503 | then Just IBOX(MINUS(action,(ILIT(1) :: FAST_INT))) 504 | else Nothing 505 | -- else Just IBOX(action) 506 | where off = indexShortOffAddr happyActOffsets st 507 | off_i = PLUS(off,i) 508 | check = if GTE(off_i,(ILIT(0) :: FAST_INT)) 509 | then EQ(indexShortOffAddr happyCheck off_i, i) 510 | else False 511 | action :: FAST_INT 512 | action 513 | | check = indexShortOffAddr happyTable off_i 514 | | otherwise = indexShortOffAddr happyDefActions st 515 | 516 | -- changed :: HappyInput -> Bool 517 | changed (Node (Val { changedLocal = cl, changedChild = cc}) _) = cl || cc 518 | 519 | -- hasYield :: HappyInput -> Bool 520 | hasYield (Node (Val { last_terminal = mlt}) _) = isJust mlt 521 | #endif /* HAPPY_INCR */ 522 | 523 | 524 | ----------------------------------------------------------------------------- 525 | -- Arrays only: do the next action 526 | 527 | #if defined(HAPPY_ARRAY) && !defined(HAPPY_INCR) 528 | 529 | happyDoAction i tk st 530 | = DEBUG_TRACE("state: " ++ show IBOX(st) ++ 531 | ",\ttoken: " ++ show IBOX(i) ++ 532 | ",\taction: ") 533 | case action of 534 | ILIT(0) -> DEBUG_TRACE("fail.\n") 535 | happyFail (happyExpListPerState (IBOX(st) :: Int)) i tk st 536 | ILIT(-1) -> DEBUG_TRACE("accept. C\n") 537 | happyAccept i tk st 538 | n | LT(n,(ILIT(0) :: FAST_INT)) -> DEBUG_TRACE("reduce C (rule " ++ show rule 539 | ++ ")") 540 | (happyReduceArr Happy_Data_Array.! rule) i tk st 541 | where rule = IBOX(NEGATE(PLUS(n,(ILIT(1) :: FAST_INT)))) 542 | n -> DEBUG_TRACE("shift, enter state " 543 | ++ show IBOX(new_state) 544 | ++ "\n") 545 | happyShift new_state i tk st 546 | where new_state = MINUS(n,(ILIT(1) :: FAST_INT)) 547 | where off = indexShortOffAddr happyActOffsets st 548 | off_i = PLUS(off,i) 549 | check = if GTE(off_i,(ILIT(0) :: FAST_INT)) 550 | then EQ(indexShortOffAddr happyCheck off_i, i) 551 | else False 552 | action 553 | | check = indexShortOffAddr happyTable off_i 554 | | otherwise = indexShortOffAddr happyDefActions st 555 | 556 | #endif /* HAPPY_ARRAY */ 557 | 558 | #ifdef HAPPY_GHC 559 | indexShortOffAddr (HappyA# arr) off = 560 | Happy_GHC_Exts.narrow16Int# i 561 | where 562 | i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low) 563 | high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#))) 564 | low = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off')) 565 | off' = off Happy_GHC_Exts.*# 2# 566 | #else 567 | indexShortOffAddr arr off = arr Happy_Data_Array.! off 568 | #endif 569 | 570 | #ifdef HAPPY_GHC 571 | readArrayBit arr bit = 572 | Bits.testBit IBOX(indexShortOffAddr arr ((unbox_int bit) `Happy_GHC_Exts.iShiftRA#` 4#)) (bit `mod` 16) 573 | where unbox_int (Happy_GHC_Exts.I# x) = x 574 | #else 575 | readArrayBit arr bit = 576 | Bits.testBit IBOX(indexShortOffAddr arr (bit `div` 16)) (bit `mod` 16) 577 | #endif 578 | 579 | #ifdef HAPPY_GHC 580 | data HappyAddr = HappyA# Happy_GHC_Exts.Addr# 581 | #endif 582 | 583 | ----------------------------------------------------------------------------- 584 | -- HappyState data type (not arrays) 585 | 586 | #if !defined(HAPPY_ARRAY) 587 | 588 | newtype HappyState b c = HappyState 589 | (FAST_INT -> -- token number 590 | FAST_INT -> -- token number (yes, again) 591 | b -> -- token semantic value 592 | HappyState b c -> -- current state 593 | [HappyState b c] -> -- state stack 594 | c) 595 | 596 | #endif 597 | 598 | ----------------------------------------------------------------------------- 599 | -- Shifting a token 600 | 601 | -- happyShift :: Verifying 602 | -- -> FAST_INT -- new state 603 | -- -> FAST_INT -- Current lookahead token number 604 | -- -> HappyInput -- current input / "parse tree" 605 | -- -> FAST_INT -- current state 606 | -- -> Happy_IntList 607 | -- -> HappyStk HappyInput 608 | -- -> [HappyInput] 609 | -- -> HappyIdentity HappyInput 610 | happyShift verifying new_state (TERMINAL(ERROR_TOK)) inp st sts stk@(x `HappyStk` _) = 611 | let i = GET_ERROR_TOKEN(x) in 612 | -- trace "shifting the error token" $ 613 | DO_ACTION(verifying,new_state,i,inp,CONS(st,sts),stk) 614 | 615 | happyShift verifying new_state i inp st sts stk = 616 | -- DEBUG_TRACE("happyShift:(new_state,i,inp)=" ++ show (IBOX(new_state),IBOX(i),inp) ++ "\n") 617 | happyNewToken verifying new_state CONS(st,sts) (inp `HappyStk`stk) 618 | 619 | -- happyReduce is specialised for the common cases. 620 | 621 | -- happySpecReduce_0 :: Verifying 622 | -- -> FAST_INT -- Non terminal to end up on TOS 623 | -- -> HappyInput -- function from TOS items to new TOS 624 | -- -> FAST_INT -- input token value 625 | -- -> HappyInput 626 | -- -> FAST_INT 627 | -- -> Happy_IntList 628 | -- -> HappyStk HappyInput 629 | -- -> [HappyInput] 630 | -- -> HappyIdentity HappyInput 631 | happySpecReduce_0 am nt fn ERROR_TOK inp st sts stk 632 | = happyFail [] ERROR_TOK inp st sts stk 633 | happySpecReduce_0 am nt fn j inp st@(HAPPYSTATE(action)) sts stk 634 | = GOTO(action) am nt j inp st CONS(st,sts) (fn `HappyStk` stk) 635 | 636 | -- happySpecReduce_1 :: Verifying 637 | -- -> FAST_INT 638 | -- -> (HappyInput -> HappyInput) 639 | -- -> FAST_INT 640 | -- -> HappyInput 641 | -- -> FAST_INT 642 | -- -> Happy_IntList 643 | -- -> HappyStk HappyInput 644 | -- -> [HappyInput] 645 | -- -> HappyIdentity HappyInput 646 | happySpecReduce_1 am i fn ERROR_TOK tk st sts stk 647 | = happyFail [] ERROR_TOK tk st sts stk 648 | happySpecReduce_1 am nt fn j tk _ sts@(CONS(st@HAPPYSTATE(action),_)) (v1`HappyStk`stk') 649 | = let !r = fn v1 in -- TODO:AZ strictness? 650 | happySeq r (GOTO(action) am nt j tk st sts (r `HappyStk` stk')) 651 | 652 | -- happySpecReduce_2 :: Verifying 653 | -- -> FAST_INT 654 | -- -> (HappyInput -> HappyInput -> HappyInput) 655 | -- -> FAST_INT 656 | -- -> HappyInput 657 | -- -> FAST_INT 658 | -- -> Happy_IntList 659 | -- -> HappyStk HappyInput 660 | -- -> [HappyInput] 661 | -- -> HappyIdentity HappyInput 662 | happySpecReduce_2 am i fn ERROR_TOK tk st sts stk 663 | = happyFail [] ERROR_TOK tk st sts stk 664 | happySpecReduce_2 am nt fn j tk _ CONS(_,sts@(CONS(st@HAPPYSTATE(action),_))) (v1`HappyStk`v2`HappyStk`stk') 665 | = let !r = fn v1 v2 in -- TODO:AZ strictness? 666 | happySeq r (GOTO(action) am nt j tk st sts (r `HappyStk` stk')) 667 | 668 | -- happySpecReduce_3 :: Verifying 669 | -- -> FAST_INT 670 | -- -> (HappyInput -> HappyInput -> HappyInput -> HappyInput) 671 | -- -> FAST_INT 672 | -- -> HappyInput 673 | -- -> FAST_INT 674 | -- -> Happy_IntList 675 | -- -> HappyStk HappyInput 676 | -- -> [HappyInput] 677 | -- -> HappyIdentity HappyInput 678 | happySpecReduce_3 am i fn ERROR_TOK tk st sts stk 679 | = happyFail [] ERROR_TOK tk st sts stk 680 | happySpecReduce_3 am nt fn j tk _ CONS(_,CONS(_,sts@(CONS(st@HAPPYSTATE(action),_)))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') 681 | = let !r = fn v1 v2 v3 in -- TODO:AZ strictness? 682 | happySeq r (GOTO(action) am nt j tk st sts (r `HappyStk` stk')) 683 | 684 | happyReduce k am i fn ERROR_TOK tk st sts stk 685 | = happyFail [] ERROR_TOK tk st sts stk 686 | happyReduce k am nt fn j tk st sts stk 687 | = case happyDrop MINUS(k,(ILIT(1) :: FAST_INT)) sts of 688 | sts1@(CONS(st1@HAPPYSTATE(action),_)) -> 689 | let !r = fn stk in -- it doesn't hurt to always seq here... 690 | happyDoSeq r (GOTO(action) am nt j tk st1 sts1 r) 691 | 692 | -- happyMonadReduce :: FAST_INT -- number of items to remove from stack 693 | -- -> Verifying 694 | -- -> FAST_INT 695 | -- -> (Happy_IntList -> HappyStk HappyInput -> HappyIdentity HappyInput) 696 | -- -> FAST_INT -- input token 697 | -- -> HappyInput -- input value being processed / "parse stack" 698 | -- -> FAST_INT -- st : current state 699 | -- -> Happy_IntList -- sts : state stack 700 | -- -> HappyStk HappyInput -- stk : shift stack 701 | -- -> [HappyInput] -- remaining input 702 | -- -> HappyIdentity HappyInput 703 | happyMonadReduce k am nt fn ERROR_TOK inp st sts stk 704 | = happyFail [] ERROR_TOK inp st sts stk 705 | happyMonadReduce k am nt fn j inp st sts stk = 706 | case happyDrop k CONS(st,sts) of 707 | sts1@(CONS(st1@HAPPYSTATE(action),_)) -> 708 | let drop_stk = happyDropStk k stk in 709 | happyThen1 (fn sts stk) (\r -> GOTO(action) am nt j inp st1 sts1 (r `HappyStk` drop_stk)) 710 | 711 | happyMonad2Reduce v k am nt fn ERROR_TOK tk st sts stk 712 | = happyFail [] ERROR_TOK tk st sts stk 713 | happyMonad2Reduce v k am nt fn j tk st sts stk = 714 | case happyDrop k CONS(st,sts) of 715 | sts1@(CONS(st1@HAPPYSTATE(action),_)) -> 716 | let drop_stk = happyDropStk k stk 717 | #if defined(HAPPY_ARRAY) 718 | off = indexShortOffAddr happyGotoOffsets st1 719 | off_i = PLUS(off,nt) 720 | new_state = indexShortOffAddr happyTable off_i 721 | #else 722 | new_state = action 723 | #endif 724 | in 725 | happyThen1 (fn stk tk) (\r -> happyNewToken v new_state sts1 (r `HappyStk` drop_stk)) 726 | 727 | happyDrop ILIT(0) l = l 728 | happyDrop n CONS(_,t) = happyDrop MINUS(n,(ILIT(1) :: FAST_INT)) t 729 | 730 | happyDropStk ILIT(0) l = l 731 | happyDropStk n (x `HappyStk` xs) = happyDropStk MINUS(n,(ILIT(1)::FAST_INT)) xs 732 | 733 | ----------------------------------------------------------------------------- 734 | -- Moving to a new state after a reduction 735 | 736 | #if defined(HAPPY_INCR) 737 | -- happyGoto :: Verifying -- am 738 | -- -> FAST_INT -- non-terminal on TOS 739 | -- -> FAST_INT -- token int corresponding to the input 740 | -- -> HappyInput -- was tk, now inp 741 | -- -> FAST_INT -- st 742 | -- -> Happy_IntList -> HappyStk HappyInput 743 | -- -> [HappyInput] 744 | -- -> HappyIdentity HappyInput 745 | happyGoto am nt j inp st = 746 | DEBUG_TRACE(", goto state " ++ show IBOX(new_state) ++ "\n") 747 | happyDoAction am j inp new_state 748 | where off = indexShortOffAddr happyGotoOffsets st 749 | off_i = PLUS(off,nt) 750 | new_state = indexShortOffAddr happyTable off_i 751 | #elif defined(HAPPY_ARRAY) 752 | happyGoto nt j tk st = 753 | DEBUG_TRACE(", goto state " ++ show IBOX(new_state) ++ "\n") 754 | happyDoAction j tk new_state 755 | where off = indexShortOffAddr happyGotoOffsets st 756 | off_i = PLUS(off,nt) 757 | new_state = indexShortOffAddr happyTable off_i 758 | #else 759 | happyGoto action j tk st = action j j tk (HappyState action) 760 | #endif 761 | 762 | ----------------------------------------------------------------------------- 763 | -- Error recovery (ERROR_TOK is the error token) 764 | 765 | -- parse error if we are in recovery and we fail again 766 | -- happyFail :: [String] 767 | -- -> FAST_INT -- input token value 768 | -- -> HappyInput -- input 769 | -- -> FAST_INT -- current state 770 | -- -> Happy_IntList 771 | -- -> HappyStk HappyInput 772 | -- -> [HappyInput] 773 | -- -> HappyIdentity HappyInput 774 | happyFail explist ERROR_TOK inp old_st _ stk@(x `HappyStk` _) = 775 | let i = GET_ERROR_TOKEN(x) in 776 | -- trace "failing" $ 777 | happyError_ explist i inp 778 | 779 | {- We don't need state discarding for our restricted implementation of 780 | "error". In fact, it can cause some bogus parses, so I've disabled it 781 | for now --SDM 782 | 783 | -- discard a state 784 | happyFail ERROR_TOK tk old_st CONS(HAPPYSTATE(action),sts) 785 | (saved_tok `HappyStk` _ `HappyStk` stk) = 786 | -- trace ("discarding state, depth " ++ show (length stk)) $ 787 | DO_ACTION(NotVerifying,action,ERROR_TOK,tk,sts,(saved_tok`HappyStk`stk)) 788 | -} 789 | 790 | -- Enter error recovery: generate an error token, 791 | -- save the old token and carry on. 792 | happyFail explist i inp HAPPYSTATE(action) sts stk = 793 | -- trace "entering error recovery" $ 794 | -- TODO:AZ: restore the error processing 795 | DO_ACTION(NotVerifying,action ,(TERMINAL(ERROR_TOK)),inp, sts, MK_ERROR_TOKEN(i) `HappyStk` stk) 796 | -- DO_ACTION(verifying ,new_state,i ,inp,CONS(st,sts), stk) 797 | -- happyError_ explist i inp 798 | 799 | -- Internal happy errors: 800 | 801 | notHappyAtAll :: a 802 | notHappyAtAll = error "Internal Happy error\n" 803 | 804 | ----------------------------------------------------------------------------- 805 | -- Hack to get the typechecker to accept our action functions 806 | 807 | #if defined(HAPPY_GHC) 808 | happyTcHack :: FAST_INT -> a -> a 809 | happyTcHack x y = y 810 | {-# INLINE happyTcHack #-} 811 | #endif 812 | 813 | ----------------------------------------------------------------------------- 814 | -- Seq-ing. If the --strict flag is given, then Happy emits 815 | -- happySeq = happyDoSeq 816 | -- otherwise it emits 817 | -- happySeq = happyDontSeq 818 | 819 | happyDoSeq, happyDontSeq :: a -> b -> b 820 | happyDoSeq a b = a `seq` b 821 | happyDontSeq a b = b 822 | 823 | ----------------------------------------------------------------------------- 824 | -- Don't inline any functions from the template. GHC has a nasty habit 825 | -- of deciding to inline happyGoto everywhere, which increases the size of 826 | -- the generated parser quite a bit. 827 | 828 | #if defined(HAPPY_ARRAY) 829 | {-# NOINLINE happyDoAction #-} 830 | {-# NOINLINE happyTable #-} 831 | {-# NOINLINE happyCheck #-} 832 | {-# NOINLINE happyActOffsets #-} 833 | {-# NOINLINE happyGotoOffsets #-} 834 | {-# NOINLINE happyDefActions #-} 835 | #endif 836 | {-# NOINLINE happyShift #-} 837 | {-# NOINLINE happySpecReduce_0 #-} 838 | {-# NOINLINE happySpecReduce_1 #-} 839 | {-# NOINLINE happySpecReduce_2 #-} 840 | {-# NOINLINE happySpecReduce_3 #-} 841 | {-# NOINLINE happyReduce #-} 842 | {-# NOINLINE happyMonadReduce #-} 843 | {-# NOINLINE happyGoto #-} 844 | {-# NOINLINE happyFail #-} 845 | 846 | -- end of Happy Template. 847 | -------------------------------------------------------------------------------- /generated-parsers/Repetitive.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -w #-} 2 | {-# OPTIONS -XMagicHash -XBangPatterns -XTypeSynonymInstances -XFlexibleInstances -cpp #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | module Repetitive where 5 | 6 | import Data.Char 7 | import Data.Maybe 8 | import Data.List 9 | import Data.Tree 10 | import qualified Data.Bits as Bits 11 | import Data.Text.Prettyprint.Doc 12 | import Data.Text.Prettyprint.Doc.Render.Terminal 13 | import qualified Data.Array as Happy_Data_Array 14 | import qualified Data.Bits as Bits 15 | import qualified GHC.Exts as Happy_GHC_Exts 16 | import qualified System.IO as Happy_System_IO 17 | import qualified System.IO.Unsafe as Happy_System_IO_Unsafe 18 | import qualified Debug.Trace as Happy_Debug_Trace 19 | import Control.Applicative(Applicative(..)) 20 | import Control.Monad (ap) 21 | 22 | -- parser produced by Happy Version 1.20.0 23 | 24 | -- using template file ./happy-templates/IncrementalTemplate-ghc-debug 25 | 26 | data HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 27 | = HappyTerminal (Token) 28 | | HappyErrorToken Int 29 | | HappyAbsSyn4 t4 30 | | HappyAbsSyn5 t5 31 | | HappyAbsSyn6 t6 32 | | HappyAbsSyn7 t7 33 | | HappyAbsSyn8 t8 34 | | HappyAbsSyn9 t9 35 | | HappyAbsSyn10 t10 36 | | HappyAbsSyn11 t11 37 | | HappyAbsSyn12 t12 38 | 39 | deriving Show 40 | 41 | happyExpList :: HappyAddr 42 | happyExpList = HappyA# "\x18\x00\x20\x00\x00\x47\x00\x00\x00\x02\x00\x00\x00\x80\x00\x00\x00\x00\xec\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# 43 | 44 | {-# NOINLINE happyExpListPerState #-} 45 | happyExpListPerState st = 46 | token_strs_expected 47 | where token_strs = ["error","%dummy","%start_calc","Ultraroot","bos","eos","tree","Root","A","Bs","B","C","'a'","'b'","'B'","'c'","%eof"] 48 | bit_start = st * 17 49 | bit_end = (st + 1) * 17 50 | read_bit = readArrayBit happyExpList 51 | bits = map read_bit [bit_start..bit_end - 1] 52 | bits_indexed = zip bits [0..16] 53 | token_strs_expected = concatMap f bits_indexed 54 | f (False, _) = [] 55 | f (True, nr) = [token_strs !! nr] 56 | 57 | happyGotoValidArray :: HappyAddr 58 | happyGotoValidArray = HappyA# "\x30\x00\x04\x00\x0e\x00\x00\x04\x00\x00\x00\x01\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# 59 | 60 | {-# NOINLINE happyGotoValid #-} 61 | happyGotoValid st nt = valid 62 | where bit_nr = nt + st * 13 63 | valid = readArrayBit happyGotoValidArray bit_nr 64 | 65 | happyFragileStateArray :: HappyAddr 66 | happyFragileStateArray = HappyA# "\x00\x00\x00\x00"# 67 | 68 | {-# NOINLINE happyFragileState #-} 69 | happyFragileState st = fragile 70 | where bit_nr = st 71 | fragile = readArrayBit happyFragileStateArray bit_nr 72 | 73 | happyActOffsets :: HappyAddr 74 | happyActOffsets = HappyA# "\x13\x00\x17\x00\xfd\xff\x0a\x00\x14\x00\x00\x00\x0f\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# 75 | 76 | happyGotoOffsets :: HappyAddr 77 | happyGotoOffsets = HappyA# "\x12\x00\x03\x00\x0c\x00\x00\x00\x09\x00\x00\x00\x02\x00\x00\x00\xfe\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# 78 | 79 | happyDefActions :: HappyAddr 80 | happyDefActions = HappyA# "\xfd\xff\x00\x00\xf8\xff\x00\x00\xfc\xff\xfb\xff\xf6\xff\xf9\xff\xf2\xff\xfe\xff\xf7\xff\xfa\xff\xf5\xff\xf4\xff\xf3\xff"# 81 | 82 | happyCheck :: HappyAddr 83 | happyCheck = HappyA# "\xff\xff\x04\x00\x05\x00\x06\x00\x01\x00\x07\x00\x08\x00\x0a\x00\x06\x00\x08\x00\x09\x00\x02\x00\x0b\x00\x0c\x00\x0d\x00\x03\x00\x04\x00\x05\x00\x00\x00\x01\x00\x01\x00\x02\x00\x07\x00\x03\x00\x0e\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# 84 | 85 | happyTable :: HappyAddr 86 | happyTable = HappyA# "\x00\x00\x05\x00\x06\x00\x07\x00\x02\x00\x0a\x00\x0b\x00\x08\x00\x08\x00\x0b\x00\x0c\x00\x09\x00\x0d\x00\x0e\x00\x0f\x00\x04\x00\x05\x00\x06\x00\x03\x00\x02\x00\x04\x00\x03\x00\x09\x00\x0a\x00\xff\xff\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# 87 | 88 | 89 | -- [(ActionEntry,0,-3,1,2,[(1,4),(2,3)]),(ActionEntry,1,0,0,1,[(2,3)]),(ActionEntry,2,-8,6,4,[(4,5),(5,6),(6,7),(10,8)]),(ActionEntry,3,0,0,1,[(14,-1)]),(ActionEntry,4,-4,0,1,[(3,10)]),(ActionEntry,5,-5,0,0,[]),(ActionEntry,6,-10,0,1,[(7,9)]),(ActionEntry,7,-7,0,0,[]),(ActionEntry,8,-14,5,5,[(8,11),(9,12),(11,13),(12,14),(13,15)]),(ActionEntry,9,-2,0,0,[]),(ActionEntry,10,-9,0,0,[]),(ActionEntry,11,-6,0,0,[]),(ActionEntry,12,-11,0,0,[]),(ActionEntry,13,-12,0,0,[]),(ActionEntry,14,-13,0,0,[])] 90 | 91 | happyReduceArr = Happy_Data_Array.array (1, 13) [ 92 | (1 , happyReduce_1), 93 | (2 , happyReduce_2), 94 | (3 , happyReduce_3), 95 | (4 , happyReduce_4), 96 | (5 , happyReduce_5), 97 | (6 , happyReduce_6), 98 | (7 , happyReduce_7), 99 | (8 , happyReduce_8), 100 | (9 , happyReduce_9), 101 | (10 , happyReduce_10), 102 | (11 , happyReduce_11), 103 | (12 , happyReduce_12), 104 | (13 , happyReduce_13) 105 | ] 106 | 107 | happy_n_terms = 6 :: Int 108 | happy_n_nonterms = 9 :: Int 109 | 110 | happyReduce_1 am fragile = happySpecReduce_3 am 0# (happyReduction_1 fragile) 111 | happyReduction_1 fragile p3 112 | p2@(Node (Val {here = (HappyAbsSyn7 happy_var_2)}) _) 113 | p1 114 | = mkNode (HappyAbsSyn4 115 | (happy_var_2 116 | )) (Just 1) fragile [p1,p2,p3] 117 | happyReduction_1 fragile _ _ _ = notHappyAtAll 118 | 119 | happyReduce_2 am fragile = happySpecReduce_0 am 1# (happyReduction_2 fragile) 120 | happyReduction_2 fragile = mkNode (HappyAbsSyn5 121 | (() 122 | )) (Just 2) fragile [] 123 | 124 | happyReduce_3 am fragile = happySpecReduce_0 am 2# (happyReduction_3 fragile) 125 | happyReduction_3 fragile = mkNode (HappyAbsSyn6 126 | (() 127 | )) (Just 3) fragile [] 128 | 129 | happyReduce_4 am fragile = happySpecReduce_1 am 3# (happyReduction_4 fragile) 130 | happyReduction_4 fragile p1@(Node (Val {here = (HappyAbsSyn8 happy_var_1)}) _) 131 | = mkNode (HappyAbsSyn7 132 | (happy_var_1 133 | )) (Just 4) fragile [p1] 134 | happyReduction_4 fragile _ = notHappyAtAll 135 | 136 | happyReduce_5 am fragile = happySpecReduce_3 am 4# (happyReduction_5 fragile) 137 | happyReduction_5 fragile p3 138 | p2@(Node (Val {here = (HappyAbsSyn10 happy_var_2)}) _) 139 | p1 140 | = mkNode (HappyAbsSyn8 141 | (Root (reverse happy_var_2) 142 | )) (Just 5) fragile [p1,p2,p3] 143 | happyReduction_5 fragile _ _ _ = notHappyAtAll 144 | 145 | happyReduce_6 am fragile = happySpecReduce_1 am 5# (happyReduction_6 fragile) 146 | happyReduction_6 fragile p1 147 | = mkNode (HappyAbsSyn9 148 | (() 149 | )) (Just 6) fragile [p1] 150 | 151 | happyReduce_7 am fragile = happySpecReduce_0 am 5# (happyReduction_7 fragile) 152 | happyReduction_7 fragile = mkNode (HappyAbsSyn9 153 | (() 154 | )) (Just 6) fragile [] 155 | 156 | happyReduce_8 am fragile = happySpecReduce_2 am 6# (happyReduction_8 fragile) 157 | happyReduction_8 fragile p2@(Node (Val {here = (HappyAbsSyn11 happy_var_2)}) _) 158 | p1@(Node (Val {here = (HappyAbsSyn10 happy_var_1)}) _) 159 | = mkNode (HappyAbsSyn10 160 | (happy_var_2:happy_var_1 161 | )) (Just 7) fragile [p1,p2] 162 | happyReduction_8 fragile _ _ = notHappyAtAll 163 | 164 | happyReduce_9 am fragile = happySpecReduce_0 am 6# (happyReduction_9 fragile) 165 | happyReduction_9 fragile = mkNode (HappyAbsSyn10 166 | ([] 167 | )) (Just 7) fragile [] 168 | 169 | happyReduce_10 am fragile = happySpecReduce_1 am 7# (happyReduction_10 fragile) 170 | happyReduction_10 fragile p1 171 | = mkNode (HappyAbsSyn11 172 | (BL 173 | )) (Just 8) fragile [p1] 174 | 175 | happyReduce_11 am fragile = happySpecReduce_1 am 7# (happyReduction_11 fragile) 176 | happyReduction_11 fragile p1 177 | = mkNode (HappyAbsSyn11 178 | (BU 179 | )) (Just 8) fragile [p1] 180 | 181 | happyReduce_12 am fragile = happySpecReduce_1 am 8# (happyReduction_12 fragile) 182 | happyReduction_12 fragile p1 183 | = mkNode (HappyAbsSyn12 184 | (() 185 | )) (Just 9) fragile [p1] 186 | 187 | happyReduce_13 am fragile = happySpecReduce_0 am 8# (happyReduction_13 fragile) 188 | happyReduction_13 fragile = mkNode (HappyAbsSyn12 189 | (() 190 | )) (Just 9) fragile [] 191 | 192 | happyNewToken verifying action sts stk [] = 193 | happyDoAction NotVerifying 14# (mkTokensNode [Tok 14# notHappyAtAll]) action sts stk [] 194 | 195 | happyNewToken verifying action sts stk (t:ts) = 196 | let cont i inp ts' = happyDoAction verifying i inp action sts stk ts' in 197 | case getTerminals t of { 198 | [] -> cont 0# t ts; 199 | (Tok _ tk:tks) -> 200 | case tk of { 201 | TokenA -> cont 10# (setTerminals t (Tok 10# tk:tks)) ((setTerminals t tks):ts); 202 | TokenBL -> cont 11# (setTerminals t (Tok 11# tk:tks)) ((setTerminals t tks):ts); 203 | TokenBU -> cont 12# (setTerminals t (Tok 12# tk:tks)) ((setTerminals t tks):ts); 204 | TokenC -> cont 13# (setTerminals t (Tok 13# tk:tks)) ((setTerminals t tks):ts); 205 | _ -> happyError' ((t:ts), []) 206 | }; 207 | 208 | }; 209 | 210 | happyError_ explist 14# tk tks = happyError' (tks, explist) 211 | happyError_ explist _ tk tks = happyError' ((tk:tks), explist) 212 | 213 | newtype HappyIdentity a = HappyIdentity a 214 | happyIdentity = HappyIdentity 215 | happyRunIdentity (HappyIdentity a) = a 216 | 217 | instance Functor HappyIdentity where 218 | fmap f (HappyIdentity a) = HappyIdentity (f a) 219 | 220 | instance Applicative HappyIdentity where 221 | pure = HappyIdentity 222 | (<*>) = ap 223 | instance Monad HappyIdentity where 224 | return = pure 225 | (HappyIdentity p) >>= q = q p 226 | 227 | happyThen :: () => HappyIdentity a -> (a -> HappyIdentity b) -> HappyIdentity b 228 | happyThen = (>>=) 229 | happyReturn :: () => a -> HappyIdentity a 230 | happyReturn = (return) 231 | happyThen1 m k tks = (>>=) m (\a -> k a tks) 232 | happyReturn1 :: () => a -> b -> HappyIdentity a 233 | happyReturn1 = \a tks -> (return) a 234 | happyError' :: () => ([(t)], [String]) -> HappyIdentity a 235 | happyError' = HappyIdentity . (\(tokens, _) -> parseError tokens) 236 | calc tks = happyRunIdentity happySomeParser where 237 | happySomeParser = happyThen (happyParse 0# tks) (\x -> case x of {Node (Val { here = HappyAbsSyn4 z }) _ -> happyReturn x; _other -> notHappyAtAll }) 238 | 239 | happySeq = happyDontSeq 240 | 241 | 242 | parseError :: [t] -> a 243 | parseError _ = error "Parse error" 244 | 245 | data Root = Root [B] 246 | deriving Show 247 | 248 | data B = BL | BU 249 | deriving Show 250 | 251 | data Token 252 | = TokenA 253 | | TokenBL 254 | | TokenBU 255 | | TokenC 256 | deriving Show 257 | 258 | 259 | 260 | lexer :: String -> [HappyInput] 261 | lexer str = [mkTokensNode (lexer' str)] 262 | 263 | lexer' [] = [] 264 | lexer' (c:cs) 265 | | isSpace c = lexer' cs 266 | lexer' ('a':cs) = mkTok TokenA : lexer' cs 267 | lexer' ('b':cs) = mkTok TokenBL : lexer' cs 268 | lexer' ('B':cs) = mkTok TokenBU : lexer' cs 269 | lexer' ('c':cs) = mkTok TokenC : lexer' cs 270 | lexer' (unk:cs) = error $ "lexer' failure on char " ++ show unk 271 | 272 | 273 | -- Main entry point. "calc" is the parser entry point generated above 274 | /* main = getContents >>= print . calc . lexer */ 275 | {-# LINE 1 "happy-templates/GenericTemplate.hs" #-} 276 | {-# LINE 1 "happy-templates/GenericTemplate.hs" #-} 277 | {-# LINE 1 "" #-} 278 | {-# LINE 1 "" #-} 279 | {-# LINE 11 "" #-} 280 | {-# LINE 1 "/usr/include/stdc-predef.h" #-} 281 | 282 | {-# LINE 17 "/usr/include/stdc-predef.h" #-} 283 | 284 | 285 | 286 | 287 | 288 | 289 | 290 | 291 | 292 | 293 | 294 | 295 | 296 | 297 | 298 | 299 | 300 | 301 | 302 | 303 | 304 | 305 | 306 | 307 | 308 | 309 | 310 | 311 | 312 | 313 | 314 | 315 | 316 | 317 | 318 | 319 | 320 | 321 | 322 | 323 | 324 | 325 | 326 | 327 | 328 | 329 | {-# LINE 11 "" #-} 330 | {-# LINE 1 "/home/alanz/.stack/programs/x86_64-linux/ghc-8.4.3/lib/ghc-8.4.3/include/ghcversion.h" #-} 331 | 332 | 333 | 334 | 335 | 336 | 337 | 338 | 339 | 340 | 341 | 342 | 343 | 344 | 345 | 346 | {-# LINE 11 "" #-} 347 | {-# LINE 1 "/tmp/ghc1167_0/ghc_2.h" #-} 348 | 349 | 350 | 351 | 352 | 353 | 354 | 355 | 356 | 357 | 358 | 359 | 360 | 361 | 362 | 363 | 364 | 365 | 366 | 367 | 368 | 369 | 370 | 371 | 372 | 373 | 374 | 375 | 376 | 377 | 378 | 379 | 380 | 381 | 382 | 383 | 384 | 385 | 386 | 387 | 388 | 389 | 390 | 391 | 392 | 393 | 394 | 395 | 396 | 397 | 398 | 399 | 400 | 401 | 402 | 403 | 404 | 405 | 406 | 407 | 408 | {-# LINE 11 "" #-} 409 | {-# LINE 1 "happy-templates/GenericTemplate.hs" #-} 410 | -- $Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp $ 411 | 412 | {-# LINE 13 "happy-templates/GenericTemplate.hs" #-} 413 | 414 | 415 | 416 | 417 | 418 | -- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. 419 | #if __GLASGOW_HASKELL__ > 706 420 | #define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Bool) 421 | #define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Bool) 422 | #define EQ(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.==# m)) :: Bool) 423 | #else 424 | #define LT(n,m) (n Happy_GHC_Exts.<# m) 425 | #define GTE(n,m) (n Happy_GHC_Exts.>=# m) 426 | #define EQ(n,m) (n Happy_GHC_Exts.==# m) 427 | #endif 428 | {-# LINE 46 "happy-templates/GenericTemplate.hs" #-} 429 | 430 | data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList 431 | 432 | 433 | 434 | 435 | 436 | 437 | 438 | {-# LINE 77 "happy-templates/GenericTemplate.hs" #-} 439 | 440 | {-# LINE 91 "happy-templates/GenericTemplate.hs" #-} 441 | 442 | 443 | 444 | happyTrace string expr = Happy_System_IO_Unsafe.unsafePerformIO $ do 445 | Happy_System_IO.hPutStr Happy_System_IO.stderr string 446 | return expr 447 | 448 | 449 | 450 | 451 | 452 | 453 | mkTok t = Tok -10# t 454 | -- nullTok = Tok -10# notHappyAtAll 455 | -- nullTok = Tok -10# TokenPlus 456 | -- nullTok = Tok -10# TokenA 457 | 458 | 459 | 460 | 461 | 462 | 463 | 464 | infixr 9 `HappyStk` 465 | data HappyStk a = HappyStk a (HappyStk a) 466 | 467 | -- AZ: following to come out of happy ProduceCode 468 | -- type HappyAbsSynType = HappyAbsSyn Exp () () Exp Exp Term Factor 469 | -- type HappyAbsSynType = HappyAbsSyn () () () Exp Exp 470 | -- type HappyAbsSynType = HappyAbsSyn Root () () Root Root () [B] B () 471 | -- type HappyAbsSynType = HappyAbsSyn Root () () Root Root () [B] B () (BinaryT B) 472 | {- 473 | 7 = 4 474 | 5 = () 475 | 6 = () 476 | 8 = 7 = Root 477 | 10 = [B] 478 | 9 = () 479 | 13 = BTree B 480 | 10 = [B] 481 | 11 = B 482 | 12 = () 483 | 13 = BTree B 484 | -} 485 | 486 | 487 | -- type NodeVal = Val HappyAbsSynType Tok 488 | 489 | -- instance Pretty HappyAbsSynType 490 | 491 | data DoACtionMode = Normal | AllReductions 492 | deriving Eq 493 | 494 | data Verifying = Verifying | NotVerifying 495 | deriving (Eq, Show) 496 | 497 | ----------------------------------------------------------------------------- 498 | -- starting the parse 499 | 500 | 501 | happyNodeSentinel = mkNode (HappyErrorToken (-1000)) Nothing False [] 502 | 503 | -- happyParse :: Happy_GHC_Exts.Int# -> [HappyInput] -> HappyIdentity HappyInput 504 | happyParse start_state = happyNewToken NotVerifying start_state (HappyCons ((-1000#)) (notHappyAtAll)) (happyNodeSentinel `HappyStk` notHappyAtAll) 505 | 506 | -- showStacks :: Happy_IntList -> HappyStk HappyInput -> String 507 | showStacks ((HappyCons ((-1000#)) (_))) _ = "[]" 508 | showStacks ((HappyCons (st) (sts))) ((Node v _) `HappyStk` stks) 509 | = show ((Happy_GHC_Exts.I# (st)),take 40 $ showHere v) ++ ":" ++ showStacks sts stks 510 | 511 | -- showInputQ :: [HappyInput] -> String 512 | showInputQ is = "[" ++ intercalate "," (map (showHere . rootLabel) is) ++ "]" 513 | 514 | -- showInput :: [HappyInput] -> String 515 | showInput ts = "[" ++ intercalate "," (map (showHere . rootLabel) ts) ++ "]" 516 | 517 | ----------------------------------------------------------------------------- 518 | -- Accepting the parse 519 | 520 | -- If the current token is 0#, it means we've just accepted a partial 521 | -- parse (a %partial parser). We must ignore the saved token on the top of 522 | -- the stack in this case. 523 | happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) = 524 | happyReturn1 ans 525 | happyAccept j tk st sts (HappyStk ans _) = 526 | (happyTcHack j (happyTcHack st)) (happyReturn1 ans) 527 | 528 | ----------------------------------------------------------------------------- 529 | -- Arrays in incremental mode: do the next action 530 | 531 | 532 | 533 | -- | A Node stores the components of the parse tree as it is built. It is 534 | -- versioned, and provides the basis for the re-use of prior parse information 535 | -- when incremental changes occur. 536 | -- It is parameterised by the HappyAbsSynType 537 | type Node a b = Tree (Val a b) 538 | -- TODO:consider using a DualTree instead, with monoidal instances for the 539 | -- change flag and next/last terminal propagation 540 | 541 | -- instance (Show a, Show b) => Show (Node a b) where 542 | -- show (Node (Val cl cc h ts nt) cs) = intercalate " " ["Node",show cl, show cc,"(" ++ show h ++ ")",show cs,show ts, show nt] 543 | instance (Show a, Pretty a, Show b, Pretty b) => Pretty (Node a b) where 544 | pretty (Node (Val cl cc h hnt ts nt lt lf rf gf) cs) 545 | = "Node" <+> pretty cl <+> pretty cc <+> parens (pretty nt) <+> parens (pretty lt) 546 | <+> parens (pretty hnt) 547 | <+> pretty lf <+> pretty rf <+> pretty gf 548 | <> line <> (indent 3 (pretty h)) 549 | <> line <> (indent 4 (pretty cs)) 550 | <> line <> (indent 4 (pretty ts)) 551 | 552 | -- TODO: consider space-efficient storage of the Val structure. bitfields, what else? 553 | data Val a b = Val 554 | { changedLocal :: !Bool 555 | , changedChild :: !Bool -- ^set if any of the children have a change 556 | , here :: !a 557 | , here_nt :: !(Maybe Int) 558 | , terminals :: ![b] 559 | , next_terminal :: !(Maybe b) -- ^ the leftmost terminal of the yield of the tree 560 | , last_terminal :: !(Maybe b) -- ^ the rightmost terminal of the yield of the tree 561 | , leftFragile :: !Bool -- ^ Fragile on leftmost edge 562 | , rightFragile :: !Bool -- ^ Fragile on rightmost edge 563 | , grammarFragile :: !Bool -- ^ The grammar production used to produce 564 | -- this node is fragile (Has a conflict, or 565 | -- precedence) 566 | } 567 | instance (Show a, Show b) => Show (Val a b) where 568 | show v@(Val cl cc h hnt ts nt lt lf rf gf) 569 | = unwords ["Val",showChanged v 570 | , showFragile v 571 | , "(" ++ show h ++ ")" 572 | , "(" ++ show hnt ++ ")",show ts 573 | , "(" ++ show nt ++ ")", "(" ++ show lt ++ ")" 574 | ] 575 | instance (Show a, Pretty a, Show b, Pretty b) => Pretty (Val a b) where 576 | pretty ((Val cl cc h hnt ts nt lt lf rf gf) ) 577 | = "Val" <+> pretty cl <+> pretty cc <+> parens (pretty nt) <+> parens (pretty lt) <+> parens (pretty hnt) 578 | <+> pretty lf <+> pretty rf <+> pretty gf 579 | <> line <> (indent 3 (pretty h)) 580 | <> line <> (indent 4 (pretty ts)) 581 | 582 | showHere :: (Show a, Show b) => Val a b -> String 583 | showHere v@(Val { here = h, here_nt = Nothing, terminals = ts }) 584 | = showFragile v ++ "T " ++ show h -- ++ " " ++ show ts 585 | showHere v@(Val { here = h, here_nt = Just nt, terminals = ts }) 586 | = showFragile v ++ "NT" ++ show nt ++ " " ++ show h -- ++ " " ++ show ts 587 | 588 | showChanged :: (Show a, Show b) => Val a b -> String 589 | showChanged Val { changedLocal = l, changedChild = c } 590 | = concat ["[ch:",mt "L" l, mt "C" c, "]"] 591 | where 592 | mt str True = str 593 | mt _ False = "" 594 | 595 | showFragile :: (Show a, Show b) => Val a b -> String 596 | showFragile Val { grammarFragile = g, leftFragile = l, rightFragile = r} 597 | = concat ["[fr:",mt "G" g, mt "L" l, mt "R" r, "]"] 598 | where 599 | mt str True = str 600 | mt _ False = "" 601 | 602 | mkNode x mnt gf cs 603 | = Node (Val 604 | { here = x 605 | , here_nt = mnt 606 | , changedLocal = False, changedChild = False 607 | , terminals = [] 608 | , next_terminal = getNextTerminal cs 609 | , last_terminal = getLastTerminal cs 610 | , leftFragile = goL cs 611 | , rightFragile = goR cs 612 | , grammarFragile = gf 613 | }) cs 614 | where 615 | goL [] = False 616 | goL ((Node v _):cs') 617 | = if grammarFragile v || leftFragile v 618 | then True 619 | else case next_terminal v of 620 | Nothing -> goL cs' 621 | Just _ -> False 622 | goR [] = False 623 | goR ((Node v _):cs') 624 | = if grammarFragile v || rightFragile v 625 | then True 626 | else case last_terminal v of 627 | Nothing -> goR cs' 628 | Just _ -> False 629 | 630 | getNextTerminal :: [Node a b] -> Maybe b 631 | getNextTerminal [] = Nothing 632 | getNextTerminal cs 633 | = case catMaybes (map (next_terminal . rootLabel) cs) of 634 | [] -> Nothing 635 | (nt:_) -> Just nt 636 | 637 | getLastTerminal :: [Node a b] -> Maybe b 638 | getLastTerminal [] = Nothing 639 | getLastTerminal cs 640 | = case catMaybes (map (last_terminal . rootLabel) cs) of 641 | [] -> Nothing 642 | ls -> Just (last ls) 643 | 644 | mkNodeNt x mnt gf cs nt 645 | = let Node v cs' = (mkNode x mnt gf cs) 646 | in Node (v { next_terminal = Just nt, last_terminal = Just nt, terminals = [nt] }) cs' 647 | 648 | isFragile :: (Node a b) -> Bool 649 | isFragile (Node v _) = grammarFragile v || leftFragile v || rightFragile v 650 | 651 | -- AZ:NOTE: The second param below (Token) can/should be moved into the Input 652 | -- type, as it is meaningless for a nonterminal. But what about compatibility 653 | -- with other happy options? 654 | -- 655 | -- The problem comes from the mapping of a Token to a unique number in 656 | -- happyNewToken 657 | -- 658 | -- For now, keep it outside, but give an error value when processing a NonTerminal 659 | -- This leads to the unfortunate creation of a second input type. 660 | -- data ParserInput a 661 | -- = InputToken Token 662 | -- | InputTree a 663 | 664 | data Tok = Tok Happy_GHC_Exts.Int# Token 665 | deriving Show 666 | instance Pretty Tok 667 | 668 | -- type HappyInput = Node HappyAbsSynType Tok 669 | 670 | mkTokensNode tks = setTerminals (mkNode (HappyErrorToken (-5)) Nothing False []) tks 671 | 672 | setTerminals :: Node a b -> [b] -> Node a b 673 | setTerminals (Node v cs) ts = Node (v { terminals = ts}) cs 674 | 675 | getTerminals :: Node a b -> [b] 676 | getTerminals (Node v cs) = terminals v 677 | 678 | -- happyDoAction :: Verifying 679 | -- -> Happy_GHC_Exts.Int# -- ^ Current lookahead token number 680 | -- -> HappyInput -- ^ input being processed. "parse stack" from the paper Same as first item on input list? 681 | -- -> Happy_GHC_Exts.Int# -- ^ Current state 682 | -- -> Happy_IntList -> HappyStk HappyInput -- ^ Current state and shifted item stack 683 | -- -> [HappyInput] -- ^ Input being processed 684 | -- -> HappyIdentity HappyInput 685 | happyDoAction verifying la inp@(Node v@(Val {terminals = toks, next_terminal = mnext, here_nt = mnt}) cs) st sts stk tks 686 | = (happyTrace ("happyDoAction:tks=" ++ showInputQ tks ++ "\n")) $ 687 | (happyTrace ("happyDoAction:stacks=" ++ showStacks sts stk ++ "\n")) $ 688 | (happyTrace ("happyDoAction:inp=" ++ showHere v ++ "\n")) $ 689 | case toks of -- Terminals 690 | (tok@(Tok i tk):ts) -> 691 | (happyTrace ("t:state: " ++ show (Happy_GHC_Exts.I# (st)) ++ ",\tfragile: " ++ show fragile ++ ",\ttoken: " ++ show (Happy_GHC_Exts.I# (i)) ++ ",\taction: ")) $ 692 | 693 | 694 | 695 | case action of 696 | 0# -> (happyTrace ("fail.\n")) $ 697 | if verifying == Verifying 698 | then rightBreakdown st sts stk tks 699 | else happyFail (happyExpListPerState ((Happy_GHC_Exts.I# (st)) :: Int)) i inp st sts stk tks 700 | -1# -> (happyTrace ("accept. A\n")) $ 701 | happyAccept i tk st sts stk tks 702 | n | LT(n,(0# :: Happy_GHC_Exts.Int#)) 703 | -> (happyTrace ("reduce (rule " ++ show rule ++ ")")) $ 704 | (happyReduceArr Happy_Data_Array.! rule) NotVerifying fragile i inp st sts stk tks 705 | where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#)))))) 706 | n -> (happyTrace ("shift, enter state " ++ show (Happy_GHC_Exts.I# (new_state)) ++ "\n")) $ 707 | 708 | 709 | happyShift NotVerifying new_state i (mkNodeNt (HappyTerminal tk) Nothing fragile [] tok) st sts stk tks 710 | where new_state = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) 711 | where action = lookupAction st i 712 | fragile = happyFragileState (Happy_GHC_Exts.I# (st)) 713 | _ -> -- Non-terminal input 714 | (happyTrace ("nt:state: " ++ show (Happy_GHC_Exts.I# (st)) ++ ",\tfragile: " ++ show (happyFragileState (Happy_GHC_Exts.I# (st))) ++ ",\ttree: " ++ (take 35 $ show (here $ rootLabel inp)) ++ ",\taction: ")) $ 715 | 716 | 717 | 718 | if changed inp || isFragile inp 719 | then (happyTrace ("left breakdown.\n")) $ 720 | leftBreakdown verifying la inp st sts stk tks 721 | else 722 | case mnt of 723 | Just ((Happy_GHC_Exts.I# (i))) -> 724 | (happyTrace ("nt:" ++ show ((Happy_GHC_Exts.I# (i))) ++ ",actionv:" ++ show ((Happy_GHC_Exts.I# (action))) ++ ":")) $ 725 | ------------------------------- 726 | case action of 727 | 0# -> (happyTrace ("fail.\n")) $ 728 | if null cs 729 | then happyNewToken verifying st sts stk tks 730 | else leftBreakdown NotVerifying la inp st sts stk tks 731 | -1# -> (happyTrace ("nt:accept. A\n")) $ 732 | -- This can never happen 733 | notHappyAtAll 734 | n | LT(n,(0# :: Happy_GHC_Exts.Int#)) -> (happyTrace ("reduce (rule " ++ show rule ++ ")")) $ 735 | 736 | (happyReduceArr Happy_Data_Array.! rule) NotVerifying fragile i inp st sts stk tks 737 | where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#)))))) 738 | n -> (happyTrace ("shift, enter state " ++ show (Happy_GHC_Exts.I# (new_state)) ++ "\n")) $ 739 | 740 | 741 | happyShift Verifying new_state i (Node v' cs) st sts stk tks 742 | where new_state = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) 743 | v' = v { grammarFragile = fragile } 744 | where action = lookupAction st i 745 | fragile = happyFragileState (Happy_GHC_Exts.I# (st)) 746 | ------------------------------- 747 | Nothing -> (happyTrace ("mnext == Nothing.\n")) $ 748 | happyNewToken NotVerifying st sts stk tks 749 | 750 | 751 | -- leftBreakdown :: Verifying 752 | -- -> Happy_GHC_Exts.Int# -- ^ Current lookahead token number 753 | -- -> HappyInput -- ^ input being processed. "parse stack" from the paper Same as first item on input list? 754 | -- -> Happy_GHC_Exts.Int# -- ^ Current state 755 | -- -> Happy_IntList -> HappyStk HappyInput -- ^ Current state and shifted item stack 756 | -- -> [HappyInput] -- ^ Input being processed 757 | -- -> HappyIdentity HappyInput 758 | leftBreakdown verifying la inp@(Node v cs) st sts stk ts 759 | = (happyTrace ("leftBreakdown:ts=" ++ showInputQ ts ++ "\n")) $ 760 | (happyTrace ("leftBreakdown:inp=" ++ showHere v ++ "\n")) $ 761 | case cs of 762 | [] -> (happyTrace ("leftBreakdown:no children\n")) $ 763 | -- happyNewToken verifying st sts stk ts 764 | -- happyNewToken verifying st sts stk (inp':ts) 765 | happyDoAction verifying la inp' st sts stk ts 766 | where inp' = Node (v { changedLocal = False, changedChild = False}) cs 767 | (c:cs') -> if isFragile c 768 | then (happyTrace ("leftBreakdown:fragile:" ++ showHere (rootLabel c) ++ "\n")) $ 769 | leftBreakdown verifying la c st sts stk (cs' ++ ts) 770 | else (happyTrace ("leftBreakdown:not fragile\n")) $ 771 | happyNewToken verifying st sts stk (cs ++ ts) 772 | 773 | -- rightBreakdown :: Happy_GHC_Exts.Int# -- ^ Current state 774 | -- -> Happy_IntList -> HappyStk HappyInput -- ^ Current state and shifted item stack 775 | -- -> [HappyInput] -- ^ Input being processed 776 | -- -> HappyIdentity HappyInput 777 | rightBreakdown st sts@((HappyCons (sts1) (stss))) stk@(stk1@(Node v cs) `HappyStk` stks) 778 | -- Break down the right hand edge of the top of the parse stack until it is 779 | -- the last_terminal value of the original. 780 | -- Nodes not having a last_terminal are discarded (no yield) 781 | = (happyTrace ("rightBreakdown:stacks=" ++ (showStacks sts stk) ++ "\n")) $ 782 | if hasYield stk1 783 | then case cs of 784 | [] -> (happyTrace ("rightBreakdown:has yield, no children, ie token:(st,sts1,stk1)=" ++ (unwords [show (Happy_GHC_Exts.I# (st)),show (Happy_GHC_Exts.I# (sts1)), take 30 ( show (here v))]) ++ ".\n")) $ 785 | 786 | case last_terminal v of 787 | Just (Tok i _) -> 788 | case (nextStateShift sts1 i) of 789 | Just ((Happy_GHC_Exts.I# (st2))) -> (happyTrace ("rightBreakdown:nextStateShift:" ++ show ((Happy_GHC_Exts.I# (sts1)),(Happy_GHC_Exts.I# (i)),(Happy_GHC_Exts.I# (st2))) ++ "\n")) $ 790 | happyNewToken NotVerifying st2 sts stk 791 | Nothing -> notHappyAtAll 792 | Nothing -> (happyTrace ("rightBreakdown:no nt\n")) $ 793 | happyNewToken NotVerifying sts1 sts stk 794 | _ -> -- shift each child onto the stack, then call rightBreakdown again 795 | (happyTrace ("rightBreakdown:going through children (n=" ++ show (length cs) ++ ").\n")) $ 796 | rightBreakdown st2 sts' stk' 797 | where 798 | (st',sts',stk') = foldl' go ((Happy_GHC_Exts.I# (sts1)),stss,stks) cs 799 | !((Happy_GHC_Exts.I# (st2))) = st' 800 | -- go :: (Int, Happy_IntList, HappyStk HappyInput) -> HappyInput -> (Int, Happy_IntList, HappyStk HappyInput) 801 | go ((Happy_GHC_Exts.I# (st)), sts, stk) c@(Node v@(Val {last_terminal = mtok,here_nt = mnt}) _) 802 | = (happyTrace ("rightBreakdown:go:(st,v)=" ++ show ((Happy_GHC_Exts.I# (st)),take 30 $ showHere v) ++ "\n")) $ 803 | case (mnt, mtok) of 804 | (Just ((Happy_GHC_Exts.I# (nt))), Just (Tok i tk)) -> 805 | (happyTrace ("go:nt " ++ (showStacks sts stk) ++ "\n")) $ 806 | ((Happy_GHC_Exts.I# (nextState st nt)), (HappyCons (st) (sts)), (c `HappyStk` stk)) 807 | (Nothing, Just (Tok i tk)) -> 808 | (happyTrace ("go:terminal " ++ (showStacks sts stk) ++ "\n")) $ 809 | ((Happy_GHC_Exts.I# (nextState st i)), (HappyCons (st) (sts)), (c `HappyStk` stk)) 810 | _ -> (happyTrace ("rightBreakdown:no non-terminal and/or no last_terminal.\n")) $ notHappyAtAll 811 | 812 | else (happyTrace ("rightBreakdown,no yield, popping stack")) $ rightBreakdown sts1 stss stks 813 | 814 | lookupAction' :: Int -> Int -> Int 815 | lookupAction' st' i' = 816 | case (st',i') of 817 | ((Happy_GHC_Exts.I# (st)), (Happy_GHC_Exts.I# (i))) -> ((Happy_GHC_Exts.I# (lookupAction st i))) 818 | 819 | lookupAction :: Happy_GHC_Exts.Int# -> Happy_GHC_Exts.Int# -> Happy_GHC_Exts.Int# 820 | lookupAction st i = action 821 | where off = indexShortOffAddr happyActOffsets st 822 | off_i = (off Happy_GHC_Exts.+# i) 823 | check = if GTE(off_i,(0# :: Happy_GHC_Exts.Int#)) 824 | then EQ(indexShortOffAddr happyCheck off_i, i) 825 | else False 826 | action 827 | | check = indexShortOffAddr happyTable off_i 828 | | otherwise = indexShortOffAddr happyDefActions st 829 | 830 | 831 | nextState' :: Int -> Int -> Int 832 | nextState' st' nt' = 833 | case (st',nt') of 834 | ((Happy_GHC_Exts.I# (st)), (Happy_GHC_Exts.I# (nt))) -> ((Happy_GHC_Exts.I# (nextState st nt))) 835 | 836 | nextState :: Happy_GHC_Exts.Int# -> Happy_GHC_Exts.Int# -> Happy_GHC_Exts.Int# 837 | nextState st nt = 838 | if happyGotoValid (Happy_GHC_Exts.I# (st)) (Happy_GHC_Exts.I# (nt)) 839 | then new_state 840 | else 0# 841 | where off = indexShortOffAddr happyGotoOffsets st 842 | off_i = (off Happy_GHC_Exts.+# nt) 843 | new_state = indexShortOffAddr happyTable off_i 844 | 845 | nextStateShift' :: Int -> Int -> Maybe Int 846 | nextStateShift' st' i' = 847 | case (st',i') of 848 | (((Happy_GHC_Exts.I# (st))), ((Happy_GHC_Exts.I# (i)))) -> nextStateShift st i 849 | 850 | nextStateShift :: Happy_GHC_Exts.Int# -> Happy_GHC_Exts.Int# -> Maybe Int 851 | nextStateShift st i = 852 | if (GTE(action, (1# :: Happy_GHC_Exts.Int#))) 853 | then Just (Happy_GHC_Exts.I# ((action Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)))) 854 | else Nothing 855 | -- else Just (Happy_GHC_Exts.I# (action)) 856 | where off = indexShortOffAddr happyActOffsets st 857 | off_i = (off Happy_GHC_Exts.+# i) 858 | check = if GTE(off_i,(0# :: Happy_GHC_Exts.Int#)) 859 | then EQ(indexShortOffAddr happyCheck off_i, i) 860 | else False 861 | action :: Happy_GHC_Exts.Int# 862 | action 863 | | check = indexShortOffAddr happyTable off_i 864 | | otherwise = indexShortOffAddr happyDefActions st 865 | 866 | -- changed :: HappyInput -> Bool 867 | changed (Node (Val { changedLocal = cl, changedChild = cc}) _) = cl || cc 868 | 869 | -- hasYield :: HappyInput -> Bool 870 | hasYield (Node (Val { last_terminal = mlt}) _) = isJust mlt 871 | 872 | 873 | 874 | ----------------------------------------------------------------------------- 875 | -- Arrays only: do the next action 876 | 877 | {-# LINE 557 "happy-templates/GenericTemplate.hs" #-} 878 | 879 | 880 | indexShortOffAddr (HappyA# arr) off = 881 | Happy_GHC_Exts.narrow16Int# i 882 | where 883 | i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low) 884 | high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#))) 885 | low = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off')) 886 | off' = off Happy_GHC_Exts.*# 2# 887 | 888 | 889 | 890 | 891 | 892 | readArrayBit arr bit = 893 | Bits.testBit (Happy_GHC_Exts.I# (indexShortOffAddr arr ((unbox_int bit) `Happy_GHC_Exts.iShiftRA#` 4#))) (bit `mod` 16) 894 | where unbox_int (Happy_GHC_Exts.I# x) = x 895 | 896 | 897 | 898 | 899 | 900 | 901 | data HappyAddr = HappyA# Happy_GHC_Exts.Addr# 902 | 903 | 904 | ----------------------------------------------------------------------------- 905 | -- HappyState data type (not arrays) 906 | 907 | {-# LINE 597 "happy-templates/GenericTemplate.hs" #-} 908 | 909 | ----------------------------------------------------------------------------- 910 | -- Shifting a token 911 | 912 | -- happyShift :: Verifying 913 | -- -> Happy_GHC_Exts.Int# -- new state 914 | -- -> Happy_GHC_Exts.Int# -- Current lookahead token number 915 | -- -> HappyInput -- current input / "parse tree" 916 | -- -> Happy_GHC_Exts.Int# -- current state 917 | -- -> Happy_IntList 918 | -- -> HappyStk HappyInput 919 | -- -> [HappyInput] 920 | -- -> HappyIdentity HappyInput 921 | happyShift verifying new_state ((0#)) inp st sts stk@(x `HappyStk` _) = 922 | let i = (case x of { Node (Val{ here = HappyErrorToken (Happy_GHC_Exts.I# (i))}) _ -> i} ) in 923 | -- trace "shifting the error token" $ 924 | happyDoAction verifying i inp new_state (HappyCons (st) (sts)) (stk) 925 | 926 | happyShift verifying new_state i inp st sts stk = 927 | -- (happyTrace ("happyShift:(new_state,i,inp)=" ++ show ((Happy_GHC_Exts.I# (new_state)),(Happy_GHC_Exts.I# (i)),inp) ++ "\n")) $ 928 | happyNewToken verifying new_state (HappyCons (st) (sts)) (inp `HappyStk`stk) 929 | 930 | -- happyReduce is specialised for the common cases. 931 | 932 | -- happySpecReduce_0 :: Verifying 933 | -- -> Happy_GHC_Exts.Int# -- Non terminal to end up on TOS 934 | -- -> HappyInput -- function from TOS items to new TOS 935 | -- -> Happy_GHC_Exts.Int# -- input token value 936 | -- -> HappyInput 937 | -- -> Happy_GHC_Exts.Int# 938 | -- -> Happy_IntList 939 | -- -> HappyStk HappyInput 940 | -- -> [HappyInput] 941 | -- -> HappyIdentity HappyInput 942 | happySpecReduce_0 am nt fn 0# inp st sts stk 943 | = happyFail [] 0# inp st sts stk 944 | happySpecReduce_0 am nt fn j inp st@((action)) sts stk 945 | = happyGoto am nt j inp st (HappyCons (st) (sts)) (fn `HappyStk` stk) 946 | 947 | -- happySpecReduce_1 :: Verifying 948 | -- -> Happy_GHC_Exts.Int# 949 | -- -> (HappyInput -> HappyInput) 950 | -- -> Happy_GHC_Exts.Int# 951 | -- -> HappyInput 952 | -- -> Happy_GHC_Exts.Int# 953 | -- -> Happy_IntList 954 | -- -> HappyStk HappyInput 955 | -- -> [HappyInput] 956 | -- -> HappyIdentity HappyInput 957 | happySpecReduce_1 am i fn 0# tk st sts stk 958 | = happyFail [] 0# tk st sts stk 959 | happySpecReduce_1 am nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') 960 | = let !r = fn v1 in -- TODO:AZ strictness? 961 | happySeq r (happyGoto am nt j tk st sts (r `HappyStk` stk')) 962 | 963 | -- happySpecReduce_2 :: Verifying 964 | -- -> Happy_GHC_Exts.Int# 965 | -- -> (HappyInput -> HappyInput -> HappyInput) 966 | -- -> Happy_GHC_Exts.Int# 967 | -- -> HappyInput 968 | -- -> Happy_GHC_Exts.Int# 969 | -- -> Happy_IntList 970 | -- -> HappyStk HappyInput 971 | -- -> [HappyInput] 972 | -- -> HappyIdentity HappyInput 973 | happySpecReduce_2 am i fn 0# tk st sts stk 974 | = happyFail [] 0# tk st sts stk 975 | happySpecReduce_2 am nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') 976 | = let !r = fn v1 v2 in -- TODO:AZ strictness? 977 | happySeq r (happyGoto am nt j tk st sts (r `HappyStk` stk')) 978 | 979 | -- happySpecReduce_3 :: Verifying 980 | -- -> Happy_GHC_Exts.Int# 981 | -- -> (HappyInput -> HappyInput -> HappyInput -> HappyInput) 982 | -- -> Happy_GHC_Exts.Int# 983 | -- -> HappyInput 984 | -- -> Happy_GHC_Exts.Int# 985 | -- -> Happy_IntList 986 | -- -> HappyStk HappyInput 987 | -- -> [HappyInput] 988 | -- -> HappyIdentity HappyInput 989 | happySpecReduce_3 am i fn 0# tk st sts stk 990 | = happyFail [] 0# tk st sts stk 991 | happySpecReduce_3 am nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') 992 | = let !r = fn v1 v2 v3 in -- TODO:AZ strictness? 993 | happySeq r (happyGoto am nt j tk st sts (r `HappyStk` stk')) 994 | 995 | happyReduce k am i fn 0# tk st sts stk 996 | = happyFail [] 0# tk st sts stk 997 | happyReduce k am nt fn j tk st sts stk 998 | = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of 999 | sts1@((HappyCons (st1@(action)) (_))) -> 1000 | let !r = fn stk in -- it doesn't hurt to always seq here... 1001 | happyDoSeq r (happyGoto am nt j tk st1 sts1 r) 1002 | 1003 | -- happyMonadReduce :: Happy_GHC_Exts.Int# -- number of items to remove from stack 1004 | -- -> Verifying 1005 | -- -> Happy_GHC_Exts.Int# 1006 | -- -> (Happy_IntList -> HappyStk HappyInput -> HappyIdentity HappyInput) 1007 | -- -> Happy_GHC_Exts.Int# -- input token 1008 | -- -> HappyInput -- input value being processed / "parse stack" 1009 | -- -> Happy_GHC_Exts.Int# -- st : current state 1010 | -- -> Happy_IntList -- sts : state stack 1011 | -- -> HappyStk HappyInput -- stk : shift stack 1012 | -- -> [HappyInput] -- remaining input 1013 | -- -> HappyIdentity HappyInput 1014 | happyMonadReduce k am nt fn 0# inp st sts stk 1015 | = happyFail [] 0# inp st sts stk 1016 | happyMonadReduce k am nt fn j inp st sts stk = 1017 | case happyDrop k (HappyCons (st) (sts)) of 1018 | sts1@((HappyCons (st1@(action)) (_))) -> 1019 | let drop_stk = happyDropStk k stk in 1020 | happyThen1 (fn sts stk) (\r -> happyGoto am nt j inp st1 sts1 (r `HappyStk` drop_stk)) 1021 | 1022 | happyMonad2Reduce v k am nt fn 0# tk st sts stk 1023 | = happyFail [] 0# tk st sts stk 1024 | happyMonad2Reduce v k am nt fn j tk st sts stk = 1025 | case happyDrop k (HappyCons (st) (sts)) of 1026 | sts1@((HappyCons (st1@(action)) (_))) -> 1027 | let drop_stk = happyDropStk k stk 1028 | 1029 | off = indexShortOffAddr happyGotoOffsets st1 1030 | off_i = (off Happy_GHC_Exts.+# nt) 1031 | new_state = indexShortOffAddr happyTable off_i 1032 | 1033 | 1034 | 1035 | in 1036 | happyThen1 (fn stk tk) (\r -> happyNewToken v new_state sts1 (r `HappyStk` drop_stk)) 1037 | 1038 | happyDrop 0# l = l 1039 | happyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t 1040 | 1041 | happyDropStk 0# l = l 1042 | happyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.Int#)) xs 1043 | 1044 | ----------------------------------------------------------------------------- 1045 | -- Moving to a new state after a reduction 1046 | 1047 | 1048 | -- happyGoto :: Verifying -- am 1049 | -- -> Happy_GHC_Exts.Int# -- non-terminal on TOS 1050 | -- -> Happy_GHC_Exts.Int# -- token int corresponding to the input 1051 | -- -> HappyInput -- was tk, now inp 1052 | -- -> Happy_GHC_Exts.Int# -- st 1053 | -- -> Happy_IntList -> HappyStk HappyInput 1054 | -- -> [HappyInput] 1055 | -- -> HappyIdentity HappyInput 1056 | happyGoto am nt j inp st = 1057 | (happyTrace (", goto state " ++ show (Happy_GHC_Exts.I# (new_state)) ++ "\n")) $ 1058 | happyDoAction am j inp new_state 1059 | where off = indexShortOffAddr happyGotoOffsets st 1060 | off_i = (off Happy_GHC_Exts.+# nt) 1061 | new_state = indexShortOffAddr happyTable off_i 1062 | {-# LINE 761 "happy-templates/GenericTemplate.hs" #-} 1063 | 1064 | ----------------------------------------------------------------------------- 1065 | -- Error recovery (0# is the error token) 1066 | 1067 | -- parse error if we are in recovery and we fail again 1068 | -- happyFail :: [String] 1069 | -- -> Happy_GHC_Exts.Int# -- input token value 1070 | -- -> HappyInput -- input 1071 | -- -> Happy_GHC_Exts.Int# -- current state 1072 | -- -> Happy_IntList 1073 | -- -> HappyStk HappyInput 1074 | -- -> [HappyInput] 1075 | -- -> HappyIdentity HappyInput 1076 | happyFail explist 0# inp old_st _ stk@(x `HappyStk` _) = 1077 | let i = (case x of { Node (Val{ here = HappyErrorToken (Happy_GHC_Exts.I# (i))}) _ -> i} ) in 1078 | -- trace "failing" $ 1079 | happyError_ explist i inp 1080 | 1081 | {- We don't need state discarding for our restricted implementation of 1082 | "error". In fact, it can cause some bogus parses, so I've disabled it 1083 | for now --SDM 1084 | 1085 | -- discard a state 1086 | happyFail 0# tk old_st (HappyCons ((action)) (sts)) 1087 | (saved_tok `HappyStk` _ `HappyStk` stk) = 1088 | -- trace ("discarding state, depth " ++ show (length stk)) $ 1089 | happyDoAction NotVerifying 0# tk action sts ((saved_tok`HappyStk`stk)) 1090 | -} 1091 | 1092 | -- Enter error recovery: generate an error token, 1093 | -- save the old token and carry on. 1094 | happyFail explist i inp (action) sts stk = 1095 | -- trace "entering error recovery" $ 1096 | -- TODO:AZ: restore the error processing 1097 | happyDoAction NotVerifying ((0#)) inp action sts ( (mkNode (HappyErrorToken (Happy_GHC_Exts.I# (i))) Nothing False [] ) `HappyStk` stk) 1098 | -- happyDoAction verifying i inp new_state (HappyCons (st) (sts)) ( stk) 1099 | -- happyError_ explist i inp 1100 | 1101 | -- Internal happy errors: 1102 | 1103 | notHappyAtAll :: a 1104 | notHappyAtAll = error "Internal Happy error\n" 1105 | 1106 | ----------------------------------------------------------------------------- 1107 | -- Hack to get the typechecker to accept our action functions 1108 | 1109 | 1110 | happyTcHack :: Happy_GHC_Exts.Int# -> a -> a 1111 | happyTcHack x y = y 1112 | {-# INLINE happyTcHack #-} 1113 | 1114 | 1115 | ----------------------------------------------------------------------------- 1116 | -- Seq-ing. If the --strict flag is given, then Happy emits 1117 | -- happySeq = happyDoSeq 1118 | -- otherwise it emits 1119 | -- happySeq = happyDontSeq 1120 | 1121 | happyDoSeq, happyDontSeq :: a -> b -> b 1122 | happyDoSeq a b = a `seq` b 1123 | happyDontSeq a b = b 1124 | 1125 | ----------------------------------------------------------------------------- 1126 | -- Don't inline any functions from the template. GHC has a nasty habit 1127 | -- of deciding to inline happyGoto everywhere, which increases the size of 1128 | -- the generated parser quite a bit. 1129 | 1130 | 1131 | {-# NOINLINE happyDoAction #-} 1132 | {-# NOINLINE happyTable #-} 1133 | {-# NOINLINE happyCheck #-} 1134 | {-# NOINLINE happyActOffsets #-} 1135 | {-# NOINLINE happyGotoOffsets #-} 1136 | {-# NOINLINE happyDefActions #-} 1137 | 1138 | {-# NOINLINE happyShift #-} 1139 | {-# NOINLINE happySpecReduce_0 #-} 1140 | {-# NOINLINE happySpecReduce_1 #-} 1141 | {-# NOINLINE happySpecReduce_2 #-} 1142 | {-# NOINLINE happySpecReduce_3 #-} 1143 | {-# NOINLINE happyReduce #-} 1144 | {-# NOINLINE happyMonadReduce #-} 1145 | {-# NOINLINE happyGoto #-} 1146 | {-# NOINLINE happyFail #-} 1147 | 1148 | -- end of Happy Template. 1149 | --------------------------------------------------------------------------------