diff options
| author | aarne <aarne@cs.chalmers.se> | 2008-06-25 16:54:35 +0000 |
|---|---|---|
| committer | aarne <aarne@cs.chalmers.se> | 2008-06-25 16:54:35 +0000 |
| commit | e9e80fc389365e24d4300d7d5390c7d833a96c50 (patch) | |
| tree | f0b58473adaa670bd8fc52ada419d8cad470ee03 /examples/gfcc/compiler | |
| parent | b96b36f43de3e2f8b58d5f539daa6f6d47f25870 (diff) | |
changed names of resource-1.3; added a note on homepage on release
Diffstat (limited to 'examples/gfcc/compiler')
| -rw-r--r-- | examples/gfcc/compiler/CleanJVM.hs | 57 | ||||
| -rw-r--r-- | examples/gfcc/compiler/ErrM.hs | 15 | ||||
| -rw-r--r-- | examples/gfcc/compiler/FILES | 51 | ||||
| -rw-r--r-- | examples/gfcc/compiler/LexImperC.hs | 288 | ||||
| -rw-r--r-- | examples/gfcc/compiler/ParImperC.hs | 919 | ||||
| -rw-r--r-- | examples/gfcc/compiler/Profile.hs | 90 | ||||
| -rw-r--r-- | examples/gfcc/compiler/README | 21 | ||||
| -rw-r--r-- | examples/gfcc/compiler/TestImperC.hs | 46 | ||||
| -rw-r--r-- | examples/gfcc/compiler/Trees.hs | 78 | ||||
| -rw-r--r-- | examples/gfcc/compiler/abs.c | 20 | ||||
| -rw-r--r-- | examples/gfcc/compiler/demo.c | 9 | ||||
| -rw-r--r-- | examples/gfcc/compiler/demo.gif | bin | 135673 -> 0 bytes | |||
| -rw-r--r-- | examples/gfcc/compiler/factorial.c | 38 | ||||
| -rw-r--r-- | examples/gfcc/compiler/fibonacci.c | 18 | ||||
| -rw-r--r-- | examples/gfcc/compiler/gfcc | 4 | ||||
| -rw-r--r-- | examples/gfcc/compiler/makefile | 22 | ||||
| -rw-r--r-- | examples/gfcc/compiler/runtime.j | 55 | ||||
| -rw-r--r-- | examples/gfcc/compiler/typecheck.gfs | 6 |
18 files changed, 0 insertions, 1737 deletions
diff --git a/examples/gfcc/compiler/CleanJVM.hs b/examples/gfcc/compiler/CleanJVM.hs deleted file mode 100644 index ab879ff0e..000000000 --- a/examples/gfcc/compiler/CleanJVM.hs +++ /dev/null @@ -1,57 +0,0 @@ -module Main where - -import Char -import System - ---- translation from Symbolic JVM to real Jasmin code - -main :: IO () -main = do - jvm:src:_ <- getArgs - s <- readFile jvm - let cls = takeWhile (/='.') src - let obj = cls ++ ".j" - writeFile obj $ boilerplate cls - appendFile obj $ mkJVM cls s - putStrLn $ "wrote file " ++ obj - system $ "jasmin " ++ obj - return () - -mkJVM :: String -> String -> String -mkJVM cls = unlines . reverse . fst . foldl trans ([],([],0)) . lines where - trans (code,(env,v)) s = case words s of - ".method":p:s:f:ns - | f == "main" -> - (".method public static main([Ljava/lang/String;)V":code,([],1)) - | otherwise -> - (unwords [".method",p,s, f ++ glue ns] : code,([],0)) - "alloc":t:x:_ -> (("; " ++ s):code, ((x,v):env, v + size t)) - ".limit":"locals":ns -> chCode (".limit locals " ++ show (length ns)) - "runtime":f:ns -> chCode $ "invokestatic " ++ "runtime/" ++ f ++ glue ns - "static":f:ns -> chCode $ "invokestatic " ++ cls ++ "/" ++ f ++ glue ns - "alloc":ns -> chCode $ "; " ++ s - ins:x:_ | symb ins -> chCode $ ins ++ " " ++ look x - "goto":ns -> chCode $ "goto " ++ glue ns - "ifeq":ns -> chCode $ "ifeq " ++ glue ns - "label":ns -> chCode $ glue ns ++ ":" - ";":[] -> chCode "" - _ -> chCode s - where - chCode c = (c:code,(env,v)) - look x = maybe (error $ x ++ show env) show $ lookup x env - glue = init . concat - symb = flip elem ["load","store"] . tail - size t = case t of - "d" -> 2 - _ -> 1 - -boilerplate :: String -> String -boilerplate cls = unlines [ - ".class public " ++ cls, - ".super java/lang/Object", - ".method public <init>()V", - "aload_0", - "invokenonvirtual java/lang/Object/<init>()V", - "return", - ".end method" - ] diff --git a/examples/gfcc/compiler/ErrM.hs b/examples/gfcc/compiler/ErrM.hs deleted file mode 100644 index 85c311a88..000000000 --- a/examples/gfcc/compiler/ErrM.hs +++ /dev/null @@ -1,15 +0,0 @@ --- BNF Converter: Error Monad --- Copyright (C) 2004 Author: Aarne Ranta - --- This file comes with NO WARRANTY and may be used FOR ANY PURPOSE. -module ErrM where - --- the Error monad: like Maybe type with error msgs - -data Err a = Ok a | Bad String - deriving (Read, Show, Eq) - -instance Monad Err where - return = Ok - Ok a >>= f = f a - Bad s >>= f = Bad s diff --git a/examples/gfcc/compiler/FILES b/examples/gfcc/compiler/FILES deleted file mode 100644 index 8b1d89a90..000000000 --- a/examples/gfcc/compiler/FILES +++ /dev/null @@ -1,51 +0,0 @@ -GF sources: ----------- -Imper.gf -- abstract syntax of an imperative language -ImperC.gf -- concrete syntax for C notation -ImperJVM.gf -- concrete syntax for JVM notation -ResImper.gf -- resource module for concrete syntaxes - -Scripts: -------- -gfcc -- the main compiler executable reading Foo.c ; shell script -typecheck.gfs -- the type checker and constraint solver ; GF editor script -CleanJVM.hs -- cleans up jvm.tmp to produce Foo.j ; Haskell module -makefile -- builds the compiler from GF source ; Unix Make file - -Runtime system: --------------- - -runtime.j -- jasmin source of the runtime class - -Generated files: ---------------- -Imper.gfcm -- canonical multilingual GF grammar for C and JVM -ImperC.cf -- LBNF grammar for C generated from Imper.gfcm -TestImperC -- executable parser generated from ImperC.cf -runtime.class -- runtime binary generated from runtime.j -gft.tmp -- parse result generated by the compiler front end -jvm.tmp -- pseudo-JVM produced by GF linearization -TestImperC -- external parser generated by BNFC -TestImperC.hs -- the external parser Main module -ParImperC.hs -- the external parser parser module -LexImperC.hs -- the external parser lexer module - - -Required programs to use the compiler: -------------------------------------- -gf+ -- Grammatical Framework version 2.1beta, >= 23/9/2004 -jasmin -- JVM assembler (to compile Foo.j to Foo.class) - -Required programs to build the compiler: ---------------------------------------- -bnfc -- BNF Converter version 2.2beta, >= 23/9/2004 -happy -- parser generator for Haskell, >= 1.13 -alex -- lexer generator for Haskell, >= 2.0 -Profile.hs -- BNFC source file (formats/profile), must be on your path -Trees.hs -- BNFC source file (formats/profile), must be on your path - -File formats: ------------- -Foo.c -- C source file -Foo.j -- generated Jasmin JVM assembler file -Foo.class -- assembled JVM bytecode file diff --git a/examples/gfcc/compiler/LexImperC.hs b/examples/gfcc/compiler/LexImperC.hs deleted file mode 100644 index ceec89d25..000000000 --- a/examples/gfcc/compiler/LexImperC.hs +++ /dev/null @@ -1,288 +0,0 @@ -{-# OPTIONS -cpp #-} -{-# LINE 3 "LexImperC.x" #-} -module LexImperC where - -import ErrM - -#if __GLASGOW_HASKELL__ >= 503 -import Data.Array -import Data.Char (ord) -import Data.Array.Base (unsafeAt) -#else -import Array -import Char (ord) -#endif -alex_base :: Array Int Int -alex_base = listArray (0,10) [1,57,66,0,37,-28,36,46,154,362,51] - -alex_table :: Array Int Int -alex_table = listArray (0,617) [0,-1,-1,-1,-1,-1,-1,-1,-1,-1,2,2,2,2,2,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,2,-1,6,-1,-1,-1,-1,-1,3,3,3,3,3,3,3,-1,10,10,10,10,10,10,10,10,10,10,-1,3,3,3,-1,-1,-1,2,2,2,2,2,3,7,5,4,2,2,2,2,2,3,0,0,0,0,0,0,0,0,2,0,0,-1,-1,-1,-1,-1,-1,2,10,10,10,10,10,10,10,10,10,10,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3,-1,3,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,9,0,0,0,0,0,0,0,0,9,9,9,9,9,9,9,9,9,9,0,0,0,0,-1,0,0,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,-1,9,0,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,0,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,0,0,0,0,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,0,9,0,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,0,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,0,9,9,9,9,9,9,9,9] - -alex_check :: Array Int Int -alex_check = listArray (0,617) [-1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,9,10,11,12,13,34,100,37,102,9,10,11,12,13,34,-1,-1,-1,-1,-1,-1,-1,-1,32,-1,-1,91,92,93,94,95,96,32,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,39,-1,-1,-1,-1,-1,-1,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,215,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,247,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,-1,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,39,248,249,250,251,252,253,254,255,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,-1,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,-1,248,249,250,251,252,253,254,255] - -alex_deflt :: Array Int Int -alex_deflt = listArray (0,10) [8,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1] - -alex_accept = listArray (0::Int,10) [[],[],[(AlexAccSkip)],[(AlexAcc (alex_action_1))],[],[],[],[],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_3))]] -{-# LINE 31 "LexImperC.x" #-} - -tok f p s = f p s - -data Tok = - TS String -- reserved words - | TL String -- string literals - | TI String -- integer literals - | TV String -- identifiers - | TD String -- double precision float literals - | TC String -- character literals - - deriving (Eq,Show,Ord) - -data Token = - PT Posn Tok - | Err Posn - deriving (Eq,Show,Ord) - -tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l -tokenPos (Err (Pn _ l _) :_) = "line " ++ show l -tokenPos _ = "end of file" - -posLineCol (Pn _ l c) = (l,c) -mkPosToken t@(PT p _) = (posLineCol p, prToken t) - -prToken t = case t of - PT _ (TS s) -> s - PT _ (TI s) -> s - PT _ (TV s) -> s - PT _ (TD s) -> s - PT _ (TC s) -> s - - _ -> show t - -data BTree = N | B String Tok BTree BTree deriving (Show) - -eitherResIdent :: (String -> Tok) -> String -> Tok -eitherResIdent tv s = treeFind resWords - where - treeFind N = tv s - treeFind (B a t left right) | s < a = treeFind left - | s > a = treeFind right - | s == a = t - -resWords = b "int" (b "float" (b "else" N N) (b "if" N N)) (b "return" (b "printf" N N) (b "while" N N)) - where b s = B s (TS s) - -unescapeInitTail :: String -> String -unescapeInitTail = unesc . tail where - unesc s = case s of - '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs - '\\':'n':cs -> '\n' : unesc cs - '\\':'t':cs -> '\t' : unesc cs - '"':[] -> [] - c:cs -> c : unesc cs - _ -> [] - -------------------------------------------------------------------- --- Alex wrapper code. --- A modified "posn" wrapper. -------------------------------------------------------------------- - -data Posn = Pn !Int !Int !Int - deriving (Eq, Show,Ord) - -alexStartPos :: Posn -alexStartPos = Pn 0 1 1 - -alexMove :: Posn -> Char -> Posn -alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1) -alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1 -alexMove (Pn a l c) _ = Pn (a+1) l (c+1) - -type AlexInput = (Posn, -- current position, - Char, -- previous char - String) -- current input string - -tokens :: String -> [Token] -tokens str = go (alexStartPos, '\n', str) - where - go :: (Posn, Char, String) -> [Token] - go inp@(pos, _, str) = - case alexScan inp 0 of - AlexEOF -> [] - AlexError (pos, _, _) -> fail $ show pos ++ ": lexical error" - AlexSkip inp' len -> go inp' - AlexToken inp' len act -> act pos (take len str) : (go inp') - -alexGetChar :: AlexInput -> Maybe (Char,AlexInput) -alexGetChar (p, c, []) = Nothing -alexGetChar (p, _, (c:s)) = - let p' = alexMove p c - in p' `seq` Just (c, (p', c, s)) - -alexInputPrevChar :: AlexInput -> Char -alexInputPrevChar (p, c, s) = c - -alex_action_1 = tok (\p s -> PT p (TS s)) -alex_action_2 = tok (\p s -> PT p (eitherResIdent TV s)) -alex_action_3 = tok (\p s -> PT p (TI s)) -{-# LINE 1 "GenericTemplate.hs" #-} --- ----------------------------------------------------------------------------- --- ALEX TEMPLATE --- --- This code is in the PUBLIC DOMAIN; you may copy it freely and use --- it for any purpose whatsoever. - --- ----------------------------------------------------------------------------- --- INTERNALS and main scanner engine - -{-# LINE 22 "GenericTemplate.hs" #-} - - - - - - - - - - - - - - - - - - - - - - - -{-# LINE 66 "GenericTemplate.hs" #-} - -alexIndexShortOffAddr arr off = arr ! off - - --- ----------------------------------------------------------------------------- --- Main lexing routines - -data AlexReturn a - = AlexEOF - | AlexError !AlexInput - | AlexSkip !AlexInput !Int - | AlexToken !AlexInput !Int a - --- alexScan :: AlexInput -> StartCode -> Maybe (AlexInput,Int,act) -alexScan input (sc) - = alexScanUser undefined input (sc) - -alexScanUser user input (sc) - = case alex_scan_tkn user input (0) input sc AlexNone of - (AlexNone, input') -> - case alexGetChar input of - Nothing -> - - - - AlexEOF - Just _ -> - - - - AlexError input - - (AlexLastSkip input len, _) -> - - - - AlexSkip input len - - (AlexLastAcc k input len, _) -> - - - - AlexToken input len k - - --- Push the input through the DFA, remembering the most recent accepting --- state it encountered. - -alex_scan_tkn user orig_input len input s last_acc = - input `seq` -- strict in the input - case s of - (-1) -> (last_acc, input) - _ -> alex_scan_tkn' user orig_input len input s last_acc - -alex_scan_tkn' user orig_input len input s last_acc = - let - new_acc = check_accs (alex_accept `unsafeAt` (s)) - in - new_acc `seq` - case alexGetChar input of - Nothing -> (new_acc, input) - Just (c, new_input) -> - - - - let - base = alexIndexShortOffAddr alex_base s - (ord_c) = ord c - offset = (base + ord_c) - check = alexIndexShortOffAddr alex_check offset - - new_s = if (offset >= (0)) && (check == ord_c) - then alexIndexShortOffAddr alex_table offset - else alexIndexShortOffAddr alex_deflt s - in - alex_scan_tkn user orig_input (len + (1)) new_input new_s new_acc - - where - check_accs [] = last_acc - check_accs (AlexAcc a : _) = AlexLastAcc a input (len) - check_accs (AlexAccSkip : _) = AlexLastSkip input (len) - check_accs (AlexAccPred a pred : rest) - | pred user orig_input (len) input - = AlexLastAcc a input (len) - check_accs (AlexAccSkipPred pred : rest) - | pred user orig_input (len) input - = AlexLastSkip input (len) - check_accs (_ : rest) = check_accs rest - -data AlexLastAcc a - = AlexNone - | AlexLastAcc a !AlexInput !Int - | AlexLastSkip !AlexInput !Int - -data AlexAcc a user - = AlexAcc a - | AlexAccSkip - | AlexAccPred a (AlexAccPred user) - | AlexAccSkipPred (AlexAccPred user) - -type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool - --- ----------------------------------------------------------------------------- --- Predicates on a rule - -alexAndPred p1 p2 user in1 len in2 - = p1 user in1 len in2 && p2 user in1 len in2 - ---alexPrevCharIsPred :: Char -> AlexAccPred _ -alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input - ---alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ -alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input - ---alexRightContext :: Int -> AlexAccPred _ -alexRightContext (sc) user _ _ input = - case alex_scan_tkn user input (0) input sc AlexNone of - (AlexNone, _) -> False - _ -> True - -- TODO: there's no need to find the longest - -- match when checking the right context, just - -- the first match will do. - --- used by wrappers -iUnbox (i) = i diff --git a/examples/gfcc/compiler/ParImperC.hs b/examples/gfcc/compiler/ParImperC.hs deleted file mode 100644 index afa46955c..000000000 --- a/examples/gfcc/compiler/ParImperC.hs +++ /dev/null @@ -1,919 +0,0 @@ -{-# OPTIONS -fglasgow-exts -cpp #-} --- parser produced by Happy Version 1.13 - -module ParImperC where -import Trees -import LexImperC -import ErrM -import Array -#if __GLASGOW_HASKELL__ >= 503 -import GHC.Exts -#else -import GlaExts -#endif - -newtype HappyAbsSyn t6 t7 = HappyAbsSyn (() -> ()) -happyIn6 :: t6 -> (HappyAbsSyn t6 t7) -happyIn6 x = unsafeCoerce# x -{-# INLINE happyIn6 #-} -happyOut6 :: (HappyAbsSyn t6 t7) -> t6 -happyOut6 x = unsafeCoerce# x -{-# INLINE happyOut6 #-} -happyIn7 :: t7 -> (HappyAbsSyn t6 t7) -happyIn7 x = unsafeCoerce# x -{-# INLINE happyIn7 #-} -happyOut7 :: (HappyAbsSyn t6 t7) -> t7 -happyOut7 x = unsafeCoerce# x -{-# INLINE happyOut7 #-} -happyIn8 :: (CFTree) -> (HappyAbsSyn t6 t7) -happyIn8 x = unsafeCoerce# x -{-# INLINE happyIn8 #-} -happyOut8 :: (HappyAbsSyn t6 t7) -> (CFTree) -happyOut8 x = unsafeCoerce# x -{-# INLINE happyOut8 #-} -happyIn9 :: (CFTree) -> (HappyAbsSyn t6 t7) -happyIn9 x = unsafeCoerce# x -{-# INLINE happyIn9 #-} -happyOut9 :: (HappyAbsSyn t6 t7) -> (CFTree) -happyOut9 x = unsafeCoerce# x -{-# INLINE happyOut9 #-} -happyIn10 :: (CFTree) -> (HappyAbsSyn t6 t7) -happyIn10 x = unsafeCoerce# x -{-# INLINE happyIn10 #-} -happyOut10 :: (HappyAbsSyn t6 t7) -> (CFTree) -happyOut10 x = unsafeCoerce# x -{-# INLINE happyOut10 #-} -happyIn11 :: (CFTree) -> (HappyAbsSyn t6 t7) -happyIn11 x = unsafeCoerce# x -{-# INLINE happyIn11 #-} -happyOut11 :: (HappyAbsSyn t6 t7) -> (CFTree) -happyOut11 x = unsafeCoerce# x -{-# INLINE happyOut11 #-} -happyIn12 :: (CFTree) -> (HappyAbsSyn t6 t7) -happyIn12 x = unsafeCoerce# x -{-# INLINE happyIn12 #-} -happyOut12 :: (HappyAbsSyn t6 t7) -> (CFTree) -happyOut12 x = unsafeCoerce# x -{-# INLINE happyOut12 #-} -happyIn13 :: (CFTree) -> (HappyAbsSyn t6 t7) -happyIn13 x = unsafeCoerce# x -{-# INLINE happyIn13 #-} -happyOut13 :: (HappyAbsSyn t6 t7) -> (CFTree) -happyOut13 x = unsafeCoerce# x -{-# INLINE happyOut13 #-} -happyIn14 :: (CFTree) -> (HappyAbsSyn t6 t7) -happyIn14 x = unsafeCoerce# x -{-# INLINE happyIn14 #-} -happyOut14 :: (HappyAbsSyn t6 t7) -> (CFTree) -happyOut14 x = unsafeCoerce# x -{-# INLINE happyOut14 #-} -happyIn15 :: (CFTree) -> (HappyAbsSyn t6 t7) -happyIn15 x = unsafeCoerce# x -{-# INLINE happyIn15 #-} -happyOut15 :: (HappyAbsSyn t6 t7) -> (CFTree) -happyOut15 x = unsafeCoerce# x -{-# INLINE happyOut15 #-} -happyIn16 :: (CFTree) -> (HappyAbsSyn t6 t7) -happyIn16 x = unsafeCoerce# x -{-# INLINE happyIn16 #-} -happyOut16 :: (HappyAbsSyn t6 t7) -> (CFTree) -happyOut16 x = unsafeCoerce# x -{-# INLINE happyOut16 #-} -happyIn17 :: (CFTree) -> (HappyAbsSyn t6 t7) -happyIn17 x = unsafeCoerce# x -{-# INLINE happyIn17 #-} -happyOut17 :: (HappyAbsSyn t6 t7) -> (CFTree) -happyOut17 x = unsafeCoerce# x -{-# INLINE happyOut17 #-} -happyIn18 :: (CFTree) -> (HappyAbsSyn t6 t7) -happyIn18 x = unsafeCoerce# x -{-# INLINE happyIn18 #-} -happyOut18 :: (HappyAbsSyn t6 t7) -> (CFTree) -happyOut18 x = unsafeCoerce# x -{-# INLINE happyOut18 #-} -happyIn19 :: (CFTree) -> (HappyAbsSyn t6 t7) -happyIn19 x = unsafeCoerce# x -{-# INLINE happyIn19 #-} -happyOut19 :: (HappyAbsSyn t6 t7) -> (CFTree) -happyOut19 x = unsafeCoerce# x -{-# INLINE happyOut19 #-} -happyIn20 :: (CFTree) -> (HappyAbsSyn t6 t7) -happyIn20 x = unsafeCoerce# x -{-# INLINE happyIn20 #-} -happyOut20 :: (HappyAbsSyn t6 t7) -> (CFTree) -happyOut20 x = unsafeCoerce# x -{-# INLINE happyOut20 #-} -happyIn21 :: (CFTree) -> (HappyAbsSyn t6 t7) -happyIn21 x = unsafeCoerce# x -{-# INLINE happyIn21 #-} -happyOut21 :: (HappyAbsSyn t6 t7) -> (CFTree) -happyOut21 x = unsafeCoerce# x -{-# INLINE happyOut21 #-} -happyInTok :: Token -> (HappyAbsSyn t6 t7) -happyInTok x = unsafeCoerce# x -{-# INLINE happyInTok #-} -happyOutTok :: (HappyAbsSyn t6 t7) -> Token -happyOutTok x = unsafeCoerce# x -{-# INLINE happyOutTok #-} - -happyActOffsets :: HappyAddr -happyActOffsets = HappyA# "\x1c\x00\xfc\xff\x05\x00\xc0\x00\x00\x00\xcb\x00\xc2\x00\xbf\x00\x00\x00\x21\x00\xbe\x00\x00\x00\x05\x00\x00\x00\xc7\x00\xba\x00\xb3\x00\xfc\xff\x00\x00\xc5\x00\x00\x00\xc4\x00\x03\x00\xc3\x00\xb1\x00\xaa\x00\xc1\x00\x05\x00\xbd\x00\x00\x00\x0c\x00\x05\x00\xb9\x00\xbc\x00\x05\x00\xbb\x00\x05\x00\x05\x00\x05\x00\x05\x00\xa4\x00\x01\x00\xb7\x00\xb8\x00\x00\x00\x00\x00\xaf\x00\xfb\xff\xaf\x00\x00\x00\x00\x00\xb5\x00\xfc\xff\xfc\xff\xb6\x00\xb0\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x11\x00\x9f\x00\xb2\x00\xae\x00\xfc\xff\x05\x00\xfc\xff\x00\x00\x00\x00\xfc\xff\x00\x00\x05\x00\x00\x00\x00\x00\xa3\x00\xad\x00\xfc\xff\xfc\xff\xa9\x00\xa5\x00\x1c\x00\xfc\xff\x9c\x00\x00\x00\x59\x00\xfc\xff\xfc\xff\xfc\xff\x56\x00\x00\x00\x53\x00\x00\x00\x47\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x35\x00\x00\x00"# - -happyGotoOffsets :: HappyAddr -happyGotoOffsets = HappyA# "\xa2\x00\x5c\x00\x90\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x82\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x7b\x00\x00\x00\x00\x00\x33\x00\x74\x00\x00\x00\x00\x00\x6d\x00\x00\x00\xa7\x00\xa0\x00\x97\x00\x99\x00\x2f\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x0b\x00\x00\x00\x00\x00\x4d\x00\x66\x00\x4c\x00\x00\x00\x00\x00\x49\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x48\x00\x3e\x00\x00\x00\x00\x00\xff\xff\x16\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3a\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x9a\x00\x00\x00\x00\x00\x00\x00"# - -happyDefActions :: HappyAddr -happyDefActions = HappyA# "\xd6\xff\xe9\xff\x00\x00\x00\x00\xfc\xff\xed\xff\xee\xff\x00\x00\xfa\xff\xf9\xff\xf7\xff\xf4\xff\x00\x00\xfb\xff\x00\x00\x00\x00\x00\x00\xe9\xff\xe1\xff\x00\x00\xe0\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe5\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\xff\x00\x00\xf0\xff\xef\xff\xf5\xff\xf8\xff\xf6\xff\xf3\xff\xf2\xff\x00\x00\xe9\xff\xe9\xff\x00\x00\x00\x00\xe3\xff\xe2\xff\xe6\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe9\xff\x00\x00\xe9\xff\xeb\xff\xea\xff\xe9\xff\xf1\xff\x00\x00\xda\xff\xec\xff\x00\x00\x00\x00\xe9\xff\xe9\xff\x00\x00\xdc\xff\x00\x00\xe9\xff\x00\x00\xe4\xff\x00\x00\xe9\xff\xe9\xff\xe9\xff\x00\x00\xdb\xff\x00\x00\xdd\xff\x00\x00\xd6\xff\xe7\xff\xe8\xff\xd4\xff\xd6\xff\xd5\xff\xde\xff"# - -happyCheck :: HappyAddr -happyCheck = HappyA# "\xff\xff\x05\x00\x01\x00\x02\x00\x01\x00\x0a\x00\x01\x00\x04\x00\x09\x00\x0e\x00\x0b\x00\x00\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x02\x00\x08\x00\x09\x00\x00\x00\x16\x00\x17\x00\x16\x00\x17\x00\x16\x00\x17\x00\x07\x00\x09\x00\x09\x00\x0b\x00\x10\x00\x0c\x00\x12\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x0a\x00\x10\x00\x0c\x00\x12\x00\x0e\x00\x01\x00\x0d\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x07\x00\x07\x00\x09\x00\x09\x00\x07\x00\x07\x00\x09\x00\x09\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x19\x00\x07\x00\x07\x00\x09\x00\x09\x00\x07\x00\x07\x00\x09\x00\x09\x00\x00\x00\x00\x00\x06\x00\x04\x00\x00\x00\x00\x00\x04\x00\x07\x00\x07\x00\x09\x00\x09\x00\x07\x00\x07\x00\x09\x00\x09\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x00\x00\x01\x00\x00\x00\x01\x00\x04\x00\x05\x00\x06\x00\x05\x00\x06\x00\x00\x00\x01\x00\x06\x00\x09\x00\x0a\x00\x05\x00\x06\x00\x00\x00\x01\x00\x0f\x00\x09\x00\x09\x00\x07\x00\x06\x00\x05\x00\x02\x00\x0f\x00\x0f\x00\x0f\x00\x05\x00\x02\x00\x16\x00\x02\x00\x07\x00\x02\x00\x04\x00\x02\x00\x17\x00\x0d\x00\x02\x00\x07\x00\x06\x00\x04\x00\x04\x00\x01\x00\x19\x00\x01\x00\x01\x00\x01\x00\x16\x00\xff\xff\x16\x00\x03\x00\x0d\x00\x01\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x00\xff\xff\xff\xff\x16\x00\xff\xff\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# - -happyTable :: HappyAddr -happyTable = HappyA# "\x00\x00\x12\x00\x0d\x00\x2d\x00\x0d\x00\x26\x00\x0d\x00\x1e\x00\x3d\x00\x28\x00\x5b\x00\x4f\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x05\x00\x40\x00\x39\x00\x3a\x00\x0e\x00\x05\x00\x0e\x00\x05\x00\x0e\x00\x05\x00\x0e\x00\x59\x00\x3d\x00\x10\x00\x3e\x00\x13\x00\x5a\x00\x15\x00\x05\x00\x06\x00\x2a\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x26\x00\x13\x00\x27\x00\x15\x00\x28\x00\x2d\x00\x48\x00\x05\x00\x06\x00\x2a\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0e\x00\x0e\x00\x37\x00\x1a\x00\x0e\x00\x0e\x00\x2b\x00\x5e\x00\x5f\x00\x10\x00\x10\x00\x56\x00\x52\x00\x10\x00\x10\x00\x0e\x00\x0e\x00\x21\x00\x62\x00\x0e\x00\x0e\x00\xde\xff\x53\x00\x49\x00\x10\x00\x10\x00\x4a\x00\x4c\x00\x10\x00\x10\x00\x0e\x00\x0e\x00\x5d\x00\x5e\x00\x0e\x00\x0e\x00\x58\x00\x43\x00\x44\x00\x10\x00\x10\x00\x20\x00\x0f\x00\x10\x00\x10\x00\x05\x00\x06\x00\x4b\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x05\x00\x06\x00\x33\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x05\x00\x06\x00\x36\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x05\x00\x06\x00\x3b\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x05\x00\x06\x00\x1c\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x05\x00\x06\x00\x23\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x05\x00\x06\x00\x05\x00\x06\x00\x2f\x00\x0a\x00\x0b\x00\x2e\x00\x0b\x00\x05\x00\x06\x00\x59\x00\x18\x00\x62\x00\x30\x00\x0b\x00\x05\x00\x06\x00\x63\x00\x18\x00\x18\x00\x51\x00\x31\x00\x52\x00\x55\x00\x60\x00\x19\x00\x56\x00\x4e\x00\x4f\x00\x05\x00\x41\x00\x42\x00\x43\x00\x46\x00\x47\x00\x0e\x00\x25\x00\x33\x00\x48\x00\x36\x00\x35\x00\x3b\x00\x3d\x00\xff\xff\x1c\x00\x1f\x00\x20\x00\x05\x00\x00\x00\x05\x00\x23\x00\x25\x00\x2a\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x05\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -happyReduceArr = array (3, 43) [ - (3 , happyReduce_3), - (4 , happyReduce_4), - (5 , happyReduce_5), - (6 , happyReduce_6), - (7 , happyReduce_7), - (8 , happyReduce_8), - (9 , happyReduce_9), - (10 , happyReduce_10), - (11 , happyReduce_11), - (12 , happyReduce_12), - (13 , happyReduce_13), - (14 , happyReduce_14), - (15 , happyReduce_15), - (16 , happyReduce_16), - (17 , happyReduce_17), - (18 , happyReduce_18), - (19 , happyReduce_19), - (20 , happyReduce_20), - (21 , happyReduce_21), - (22 , happyReduce_22), - (23 , happyReduce_23), - (24 , happyReduce_24), - (25 , happyReduce_25), - (26 , happyReduce_26), - (27 , happyReduce_27), - (28 , happyReduce_28), - (29 , happyReduce_29), - (30 , happyReduce_30), - (31 , happyReduce_31), - (32 , happyReduce_32), - (33 , happyReduce_33), - (34 , happyReduce_34), - (35 , happyReduce_35), - (36 , happyReduce_36), - (37 , happyReduce_37), - (38 , happyReduce_38), - (39 , happyReduce_39), - (40 , happyReduce_40), - (41 , happyReduce_41), - (42 , happyReduce_42), - (43 , happyReduce_43) - ] - -happy_n_terms = 26 :: Int -happy_n_nonterms = 16 :: Int - -happyReduce_3 = happySpecReduce_1 0# happyReduction_3 -happyReduction_3 happy_x_1 - = case happyOutTok happy_x_1 of { (PT _ (TV happy_var_1)) -> - happyIn6 - (mkAtTree (AV (Ident happy_var_1)) - )} - -happyReduce_4 = happySpecReduce_1 1# happyReduction_4 -happyReduction_4 happy_x_1 - = case happyOutTok happy_x_1 of { (PT _ (TI happy_var_1)) -> - happyIn7 - (mkAtTree (AI ((read happy_var_1) :: Integer)) - )} - -happyReduce_5 = happySpecReduce_1 2# happyReduction_5 -happyReduction_5 happy_x_1 - = case happyOut9 happy_x_1 of { happy_var_1 -> - happyIn8 - (happy_var_1 - )} - -happyReduce_6 = happySpecReduce_1 3# happyReduction_6 -happyReduction_6 happy_x_1 - = case happyOut10 happy_x_1 of { happy_var_1 -> - happyIn9 - (happy_var_1 - )} - -happyReduce_7 = happySpecReduce_3 3# happyReduction_7 -happyReduction_7 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut10 happy_x_1 of { happy_var_1 -> - case happyOut10 happy_x_3 of { happy_var_3 -> - happyIn9 - (mkFunTree "ELt" [([],[]),([],[]),([],[0]),([],[1])] [ happy_var_1 , happy_var_3 ] - )}} - -happyReduce_8 = happySpecReduce_1 4# happyReduction_8 -happyReduction_8 happy_x_1 - = case happyOut11 happy_x_1 of { happy_var_1 -> - happyIn10 - (happy_var_1 - )} - -happyReduce_9 = happySpecReduce_3 4# happyReduction_9 -happyReduction_9 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut10 happy_x_1 of { happy_var_1 -> - case happyOut11 happy_x_3 of { happy_var_3 -> - happyIn10 - (mkFunTree "EAdd" [([],[]),([],[]),([],[0]),([],[1])] [ happy_var_1 , happy_var_3 ] - )}} - -happyReduce_10 = happySpecReduce_3 4# happyReduction_10 -happyReduction_10 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut10 happy_x_1 of { happy_var_1 -> - case happyOut11 happy_x_3 of { happy_var_3 -> - happyIn10 - (mkFunTree "ESub" [([],[]),([],[]),([],[0]),([],[1])] [ happy_var_1 , happy_var_3 ] - )}} - -happyReduce_11 = happySpecReduce_1 5# happyReduction_11 -happyReduction_11 happy_x_1 - = case happyOut12 happy_x_1 of { happy_var_1 -> - happyIn11 - (happy_var_1 - )} - -happyReduce_12 = happySpecReduce_3 5# happyReduction_12 -happyReduction_12 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut11 happy_x_1 of { happy_var_1 -> - case happyOut12 happy_x_3 of { happy_var_3 -> - happyIn11 - (mkFunTree "EMul" [([],[]),([],[]),([],[0]),([],[1])] [ happy_var_1 , happy_var_3 ] - )}} - -happyReduce_13 = happySpecReduce_3 6# happyReduction_13 -happyReduction_13 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut8 happy_x_2 of { happy_var_2 -> - happyIn12 - (happy_var_2 - )} - -happyReduce_14 = happyReduce 4# 6# happyReduction_14 -happyReduction_14 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut6 happy_x_1 of { happy_var_1 -> - case happyOut19 happy_x_3 of { happy_var_3 -> - happyIn12 - (mkFunTree "EApp" [([],[]),([],[]),([],[0]),([],[1])] [ happy_var_1 , happy_var_3 ] - ) `HappyStk` happyRest}} - -happyReduce_15 = happySpecReduce_3 6# happyReduction_15 -happyReduction_15 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut6 happy_x_1 of { happy_var_1 -> - happyIn12 - (mkFunTree "EAppNil" [([],[]),([],[0])] [ happy_var_1 ] - )} - -happyReduce_16 = happySpecReduce_3 6# happyReduction_16 -happyReduction_16 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut7 happy_x_1 of { happy_var_1 -> - case happyOut7 happy_x_3 of { happy_var_3 -> - happyIn12 - (mkFunTree "EFloat" [([],[0]),([],[1])] [ happy_var_1 , happy_var_3 ] - )}} - -happyReduce_17 = happySpecReduce_1 6# happyReduction_17 -happyReduction_17 happy_x_1 - = case happyOut7 happy_x_1 of { happy_var_1 -> - happyIn12 - (mkFunTree "EInt" [([],[0])] [ happy_var_1 ] - )} - -happyReduce_18 = happySpecReduce_1 6# happyReduction_18 -happyReduction_18 happy_x_1 - = case happyOut6 happy_x_1 of { happy_var_1 -> - happyIn12 - (mkFunTree "EVar" [([],[]),([],[0])] [ happy_var_1 ] - )} - -happyReduce_19 = happyReduce 5# 7# happyReduction_19 -happyReduction_19 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut6 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - case happyOut13 happy_x_5 of { happy_var_5 -> - happyIn13 - (mkFunTree "Assign" [([],[]),([],[0]),([],[1]),([],[2])] [ happy_var_1 , happy_var_3 , happy_var_5 ] - ) `HappyStk` happyRest}}} - -happyReduce_20 = happyReduce 4# 7# happyReduction_20 -happyReduction_20 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut13 happy_x_2 of { happy_var_2 -> - case happyOut13 happy_x_4 of { happy_var_4 -> - happyIn13 - (mkFunTree "Block" [([],[0]),([],[1])] [ happy_var_2 , happy_var_4 ] - ) `HappyStk` happyRest}} - -happyReduce_21 = happyReduce 4# 7# happyReduction_21 -happyReduction_21 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut15 happy_x_1 of { happy_var_1 -> - case happyOut6 happy_x_2 of { happy_var_2 -> - case happyOut13 happy_x_4 of { happy_var_4 -> - happyIn13 - (mkFunTree "Decl" [([],[0]),([[1]],[2])] [ happy_var_1 , happy_var_2 , happy_var_4 ] - ) `HappyStk` happyRest}}} - -happyReduce_22 = happySpecReduce_0 7# happyReduction_22 -happyReduction_22 = happyIn13 - (mkFunTree "End" [] [ ] - ) - -happyReduce_23 = happyReduce 8# 7# happyReduction_23 -happyReduction_23 (happy_x_8 `HappyStk` - happy_x_7 `HappyStk` - happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut8 happy_x_3 of { happy_var_3 -> - case happyOut13 happy_x_5 of { happy_var_5 -> - case happyOut13 happy_x_7 of { happy_var_7 -> - case happyOut13 happy_x_8 of { happy_var_8 -> - happyIn13 - (mkFunTree "IfElse" [([],[0]),([],[1]),([],[2]),([],[3])] [ happy_var_3 , happy_var_5 , happy_var_7 , happy_var_8 ] - ) `HappyStk` happyRest}}}} - -happyReduce_24 = happyReduce 8# 7# happyReduction_24 -happyReduction_24 (happy_x_8 `HappyStk` - happy_x_7 `HappyStk` - happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut14 happy_x_3 of { happy_var_3 -> - case happyOut8 happy_x_5 of { happy_var_5 -> - case happyOut13 happy_x_8 of { happy_var_8 -> - happyIn13 - (mkFunTree "Printf" [([],[0]),([],[1]),([],[2])] [ happy_var_3 , happy_var_5 , happy_var_8 ] - ) `HappyStk` happyRest}}} - -happyReduce_25 = happySpecReduce_3 7# happyReduction_25 -happyReduction_25 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut8 happy_x_2 of { happy_var_2 -> - happyIn13 - (mkFunTree "Return" [([],[]),([],[0])] [ happy_var_2 ] - )} - -happyReduce_26 = happySpecReduce_2 7# happyReduction_26 -happyReduction_26 happy_x_2 - happy_x_1 - = happyIn13 - (mkFunTree "Returnv" [] [ ] - ) - -happyReduce_27 = happyReduce 6# 7# happyReduction_27 -happyReduction_27 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut8 happy_x_3 of { happy_var_3 -> - case happyOut13 happy_x_5 of { happy_var_5 -> - case happyOut13 happy_x_6 of { happy_var_6 -> - happyIn13 - (mkFunTree "While" [([],[0]),([],[1]),([],[2])] [ happy_var_3 , happy_var_5 , happy_var_6 ] - ) `HappyStk` happyRest}}} - -happyReduce_28 = happySpecReduce_1 8# happyReduction_28 -happyReduction_28 happy_x_1 - = happyIn14 - (mkFunTree "TFloat" [] [ ] - ) - -happyReduce_29 = happySpecReduce_1 8# happyReduction_29 -happyReduction_29 happy_x_1 - = happyIn14 - (mkFunTree "TInt" [] [ ] - ) - -happyReduce_30 = happySpecReduce_1 9# happyReduction_30 -happyReduction_30 happy_x_1 - = happyIn15 - (mkFunTree "TFloat" [] [ ] - ) - -happyReduce_31 = happySpecReduce_1 9# happyReduction_31 -happyReduction_31 happy_x_1 - = happyIn15 - (mkFunTree "TInt" [] [ ] - ) - -happyReduce_32 = happySpecReduce_1 10# happyReduction_32 -happyReduction_32 happy_x_1 - = case happyOut21 happy_x_1 of { happy_var_1 -> - happyIn16 - (mkFunTree "RecCons" [([],[]),([],[]),([[]],[]),([],[0])] [ happy_var_1 ] - )} - -happyReduce_33 = happySpecReduce_1 10# happyReduction_33 -happyReduction_33 happy_x_1 - = case happyOut21 happy_x_1 of { happy_var_1 -> - happyIn16 - (mkFunTree "RecOne" [([],[]),([[]],[]),([],[0])] [ happy_var_1 ] - )} - -happyReduce_34 = happyReduce 4# 11# happyReduction_34 -happyReduction_34 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut15 happy_x_1 of { happy_var_1 -> - case happyOut6 happy_x_2 of { happy_var_2 -> - case happyOut17 happy_x_4 of { happy_var_4 -> - happyIn17 - (mkFunTree "RecCons" [([],[0]),([],[]),([[1]],[2]),([],[])] [ happy_var_1 , happy_var_2 , happy_var_4 ] - ) `HappyStk` happyRest}}} - -happyReduce_35 = happySpecReduce_2 11# happyReduction_35 -happyReduction_35 happy_x_2 - happy_x_1 - = case happyOut15 happy_x_1 of { happy_var_1 -> - case happyOut6 happy_x_2 of { happy_var_2 -> - happyIn17 - (mkFunTree "RecOne" [([],[0]),([[1]],[]),([],[])] [ happy_var_1 , happy_var_2 ] - )}} - -happyReduce_36 = happySpecReduce_1 12# happyReduction_36 -happyReduction_36 happy_x_1 - = case happyOut13 happy_x_1 of { happy_var_1 -> - happyIn18 - (mkFunTree "RecOne" [([],[]),([[]],[0]),([],[])] [ happy_var_1 ] - )} - -happyReduce_37 = happySpecReduce_3 13# happyReduction_37 -happyReduction_37 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut19 happy_x_3 of { happy_var_3 -> - happyIn19 - (mkFunTree "ConsExp" [([],[]),([],[]),([],[0]),([],[1])] [ happy_var_1 , happy_var_3 ] - )}} - -happyReduce_38 = happySpecReduce_1 13# happyReduction_38 -happyReduction_38 happy_x_1 - = case happyOut8 happy_x_1 of { happy_var_1 -> - happyIn19 - (mkFunTree "OneExp" [([],[]),([],[0])] [ happy_var_1 ] - )} - -happyReduce_39 = happySpecReduce_2 14# happyReduction_39 -happyReduction_39 happy_x_2 - happy_x_1 - = case happyOut15 happy_x_1 of { happy_var_1 -> - case happyOut20 happy_x_2 of { happy_var_2 -> - happyIn20 - (mkFunTree "ConsTyp" [([],[0]),([],[1])] [ happy_var_1 , happy_var_2 ] - )}} - -happyReduce_40 = happySpecReduce_0 14# happyReduction_40 -happyReduction_40 = happyIn20 - (mkFunTree "NilTyp" [] [ ] - ) - -happyReduce_41 = happySpecReduce_0 15# happyReduction_41 -happyReduction_41 = happyIn21 - (mkFunTree "Empty" [] [ ] - ) - -happyReduce_42 = happyReduce 10# 15# happyReduction_42 -happyReduction_42 (happy_x_10 `HappyStk` - happy_x_9 `HappyStk` - happy_x_8 `HappyStk` - happy_x_7 `HappyStk` - happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut15 happy_x_1 of { happy_var_1 -> - case happyOut6 happy_x_2 of { happy_var_2 -> - case happyOut17 happy_x_4 of { happy_var_4 -> - case happyOut18 happy_x_7 of { happy_var_7 -> - case happyOut16 happy_x_10 of { happy_var_10 -> - happyIn21 - (mkFunTree "Funct" [([],[]),([],[0]),([[1]],[2,3,4])] [ happy_var_1 , happy_var_2 , happy_var_4 , happy_var_7 , happy_var_10 ] - ) `HappyStk` happyRest}}}}} - -happyReduce_43 = happyReduce 9# 15# happyReduction_43 -happyReduction_43 (happy_x_9 `HappyStk` - happy_x_8 `HappyStk` - happy_x_7 `HappyStk` - happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut15 happy_x_1 of { happy_var_1 -> - case happyOut6 happy_x_2 of { happy_var_2 -> - case happyOut13 happy_x_6 of { happy_var_6 -> - case happyOut21 happy_x_9 of { happy_var_9 -> - happyIn21 - (mkFunTree "FunctNil" [([],[0]),([],[2]),([[1]],[3])] [ happy_var_1 , happy_var_2 , happy_var_6 , happy_var_9 ] - ) `HappyStk` happyRest}}}} - -happyNewToken action sts stk [] = - happyDoAction 25# (error "reading EOF!") action sts stk [] - -happyNewToken action sts stk (tk:tks) = - let cont i = happyDoAction i tk action sts stk tks in - case tk of { - PT _ (TS "(") -> cont 1#; - PT _ (TS ")") -> cont 2#; - PT _ (TS "=") -> cont 3#; - PT _ (TS ";") -> cont 4#; - PT _ (TS "{") -> cont 5#; - PT _ (TS "}") -> cont 6#; - PT _ (TS ",") -> cont 7#; - PT _ (TS "\"%f\"") -> cont 8#; - PT _ (TS "\"%d\"") -> cont 9#; - PT _ (TS "+") -> cont 10#; - PT _ (TS ".") -> cont 11#; - PT _ (TS "<") -> cont 12#; - PT _ (TS "*") -> cont 13#; - PT _ (TS "-") -> cont 14#; - PT _ (TS "else") -> cont 15#; - PT _ (TS "float") -> cont 16#; - PT _ (TS "if") -> cont 17#; - PT _ (TS "int") -> cont 18#; - PT _ (TS "printf") -> cont 19#; - PT _ (TS "return") -> cont 20#; - PT _ (TS "while") -> cont 21#; - PT _ (TV happy_dollar_dollar) -> cont 22#; - PT _ (TI happy_dollar_dollar) -> cont 23#; - _ -> cont 24#; - _ -> happyError tks - } - -happyThen :: Err a -> (a -> Err b) -> Err b -happyThen = (thenM) -happyReturn :: a -> Err a -happyReturn = (returnM) -happyThen1 m k tks = (thenM) m (\a -> k a tks) -happyReturn1 = \a tks -> (returnM) a - -pProgram tks = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut21 x)) - -pStm tks = happyThen (happyParse 1# tks) (\x -> happyReturn (happyOut13 x)) - -pExp tks = happyThen (happyParse 2# tks) (\x -> happyReturn (happyOut8 x)) - -happySeq = happyDontSeq - -returnM :: a -> Err a -returnM = return - -thenM :: Err a -> (a -> Err b) -> Err b -thenM = (>>=) - -happyError :: [Token] -> Err a -happyError ts = - Bad $ "syntax error at " ++ tokenPos ts ++ if null ts then [] else (" before " ++ unwords (map prToken (take 4 ts))) - -myLexer = tokens -{-# LINE 1 "GenericTemplate.hs" #-} --- $Id: ParImperC.hs,v 1.3 2004/12/20 08:57:05 aarne Exp $ - - - - - - - - - - - - - -{-# LINE 27 "GenericTemplate.hs" #-} - - - -data Happy_IntList = HappyCons Int# Happy_IntList - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -infixr 9 `HappyStk` -data HappyStk a = HappyStk a (HappyStk a) - ------------------------------------------------------------------------------ --- starting the parse - -happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll - ------------------------------------------------------------------------------ --- Accepting the parse - -happyAccept j tk st sts (HappyStk ans _) = (happyTcHack j - (happyTcHack st)) - (happyReturn1 ans) - ------------------------------------------------------------------------------ --- Arrays only: do the next action - - - -happyDoAction i tk st - = {- nothing -} - - - case action of - 0# -> {- nothing -} - happyFail i tk st - -1# -> {- nothing -} - happyAccept i tk st - n | (n <# (0# :: Int#)) -> {- nothing -} - - (happyReduceArr ! rule) i tk st - where rule = (I# ((negateInt# ((n +# (1# :: Int#)))))) - n -> {- nothing -} - - - happyShift new_state i tk st - where new_state = (n -# (1# :: Int#)) - where off = indexShortOffAddr happyActOffsets st - off_i = (off +# i) - check = if (off_i >=# (0# :: Int#)) - then (indexShortOffAddr happyCheck off_i ==# i) - else False - action | check = indexShortOffAddr happyTable off_i - | otherwise = indexShortOffAddr happyDefActions st - - - - - - - - - - - -indexShortOffAddr (HappyA# arr) off = -#if __GLASGOW_HASKELL__ > 500 - narrow16Int# i -#elif __GLASGOW_HASKELL__ == 500 - intToInt16# i -#else - (i `iShiftL#` 16#) `iShiftRA#` 16# -#endif - where -#if __GLASGOW_HASKELL__ >= 503 - i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) -#else - i = word2Int# ((high `shiftL#` 8#) `or#` low) -#endif - high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - low = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 2# - - - - - -data HappyAddr = HappyA# Addr# - - - - ------------------------------------------------------------------------------ --- HappyState data type (not arrays) - -{-# LINE 165 "GenericTemplate.hs" #-} - - ------------------------------------------------------------------------------ --- Shifting a token - -happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = - let i = (case unsafeCoerce# x of { (I# (i)) -> i }) in --- trace "shifting the error token" $ - happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) - -happyShift new_state i tk st sts stk = - happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk) - --- happyReduce is specialised for the common cases. - -happySpecReduce_0 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_0 nt fn j tk st@((action)) sts stk - = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) - -happySpecReduce_1 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') - = let r = fn v1 in - happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) - -happySpecReduce_2 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') - = let r = fn v1 v2 in - happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) - -happySpecReduce_3 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') - = let r = fn v1 v2 v3 in - happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) - -happyReduce k i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happyReduce k nt fn j tk st sts stk - = case happyDrop (k -# (1# :: Int#)) sts of - sts1@((HappyCons (st1@(action)) (_))) -> - let r = fn stk in -- it doesn't hurt to always seq here... - happyDoSeq r (happyGoto nt j tk st1 sts1 r) - -happyMonadReduce k nt fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happyMonadReduce k nt fn j tk st sts stk = - happyThen1 (fn stk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) - where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) - drop_stk = happyDropStk k stk - -happyDrop 0# l = l -happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t - -happyDropStk 0# l = l -happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs - ------------------------------------------------------------------------------ --- Moving to a new state after a reduction - - -happyGoto nt j tk st = - {- nothing -} - happyDoAction j tk new_state - where off = indexShortOffAddr happyGotoOffsets st - off_i = (off +# nt) - new_state = indexShortOffAddr happyTable off_i - - - - ------------------------------------------------------------------------------ --- Error recovery (0# is the error token) - --- parse error if we are in recovery and we fail again -happyFail 0# tk old_st _ stk = --- trace "failing" $ - happyError - - -{- We don't need state discarding for our restricted implementation of - "error". In fact, it can cause some bogus parses, so I've disabled it - for now --SDM - --- discard a state -happyFail 0# tk old_st (HappyCons ((action)) (sts)) - (saved_tok `HappyStk` _ `HappyStk` stk) = --- trace ("discarding state, depth " ++ show (length stk)) $ - happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk)) --} - --- Enter error recovery: generate an error token, --- save the old token and carry on. -happyFail i tk (action) sts stk = --- trace "entering error recovery" $ - happyDoAction 0# tk action sts ( (unsafeCoerce# (I# (i))) `HappyStk` stk) - --- Internal happy errors: - -notHappyAtAll = error "Internal Happy error\n" - ------------------------------------------------------------------------------ --- Hack to get the typechecker to accept our action functions - - -happyTcHack :: Int# -> a -> a -happyTcHack x y = y -{-# INLINE happyTcHack #-} - - ------------------------------------------------------------------------------ --- Seq-ing. If the --strict flag is given, then Happy emits --- happySeq = happyDoSeq --- otherwise it emits --- happySeq = happyDontSeq - -happyDoSeq, happyDontSeq :: a -> b -> b -happyDoSeq a b = a `seq` b -happyDontSeq a b = b - ------------------------------------------------------------------------------ --- Don't inline any functions from the template. GHC has a nasty habit --- of deciding to inline happyGoto everywhere, which increases the size of --- the generated parser quite a bit. - - -{-# NOINLINE happyDoAction #-} -{-# NOINLINE happyTable #-} -{-# NOINLINE happyCheck #-} -{-# NOINLINE happyActOffsets #-} -{-# NOINLINE happyGotoOffsets #-} -{-# NOINLINE happyDefActions #-} - -{-# NOINLINE happyShift #-} -{-# NOINLINE happySpecReduce_0 #-} -{-# NOINLINE happySpecReduce_1 #-} -{-# NOINLINE happySpecReduce_2 #-} -{-# NOINLINE happySpecReduce_3 #-} -{-# NOINLINE happyReduce #-} -{-# NOINLINE happyMonadReduce #-} -{-# NOINLINE happyGoto #-} -{-# NOINLINE happyFail #-} - --- end of Happy Template. diff --git a/examples/gfcc/compiler/Profile.hs b/examples/gfcc/compiler/Profile.hs deleted file mode 100644 index 0c549cd67..000000000 --- a/examples/gfcc/compiler/Profile.hs +++ /dev/null @@ -1,90 +0,0 @@ -module Profile (postParse) where - -import Trees -import ErrM - -import Monad -import List (nub) - - --- restoring parse trees for discontinuous constituents, bindings, etc. AR 25/1/2001 --- revised 8/4/2002 for the new profile structure - -postParse :: CFTree -> Err Exp -postParse tree = do - iterm <- tree2term tree - return $ term2trm iterm - --- an intermediate data structure -data ITerm = ITerm (Atom, BindVs) [ITerm] | IMeta deriving (Eq,Show) -type BindVs = [[Ident]] - --- the job is done in two passes: --- (1) tree2term: restore constituent order from Profile --- (2) term2trm: restore Bindings from Binds - -tree2term :: CFTree -> Err ITerm -tree2term (CFTree (cff@(CFFun (fun,pro)), trees)) = case fun of - AM -> return IMeta - _ -> do - args <- mapM mkArg pro - binds <- mapM mkBinds pro - return $ ITerm (fun, binds) args - where - mkArg (_,arg) = case arg of - [x] -> do -- one occurrence - trx <- trees !? x - tree2term trx - [] -> return IMeta -- suppression - _ -> do -- reduplication - trees' <- mapM (trees !?) arg - xs1 <- mapM tree2term trees' - xs2 <- checkArity xs1 - unif xs2 - - checkArity xs = if length (nub [length xx | ITerm _ xx <- xs']) > 1 - then Bad "arity error" - else return xs' - where xs' = [t | t@(ITerm _ _) <- xs] - unif xs = case [t | t@(ITerm _ _) <- xs] of - [] -> return $ IMeta - (ITerm fp@(f,_) xx : ts) -> do - let hs = [h | ITerm (h,_) _ <- ts, h /= f] - testErr (null hs) -- if fails, hs must be nonempty - ("unification expects " ++ prt f ++ " but found " ++ prt (head hs)) - xx' <- mapM unifArg [0 .. length xx - 1] - return $ ITerm fp xx' - where - unifArg i = unif [zz !! i | ITerm _ zz <- xs] - - mkBinds (xss,_) = mapM mkBind xss - mkBind xs = do - ts <- mapM (trees !?) xs - let vs = [x | CFTree (CFFun (AV x,_),[]) <- ts] - testErr (length ts == length vs) "non-variable in bound position" - case vs of - [x] -> return x - [] -> return $ Ident "h_" ---- uBoundVar - y:ys -> do - testErr (all (==y) ys) ("fail to unify bindings of " ++ prt y) - return y - -term2trm :: ITerm -> Exp -term2trm IMeta = EAtom AM -term2trm (ITerm (fun, binds) terms) = - let bterms = zip binds terms - in mkAppAtom fun [mkAbsR xs (term2trm t) | (xs,t) <- bterms] - - --- these are deprecated - where - mkAbsR c e = foldr EAbs e c - mkAppAtom a = mkApp (EAtom a) - mkApp = foldl EApp - --- !! with the error monad -(!?) :: [a] -> Int -> Err a -xs !? i = foldr (const . return) (Bad "too few elements in list") $ drop i xs - -testErr :: Bool -> String -> Err () -testErr cond msg = if cond then return () else Bad msg - diff --git a/examples/gfcc/compiler/README b/examples/gfcc/compiler/README deleted file mode 100644 index 862317d8c..000000000 --- a/examples/gfcc/compiler/README +++ /dev/null @@ -1,21 +0,0 @@ -C compiler written in GF. - -Usage: - - ./gfcc Foo.c - -produces the Jasmin file Foo.j - -Compile the compiler: - - make - -If you change the file ImperC.gf, you have to have BNFC 2.2, Happy, -and Alex, and use - - make compiler - -See FILES to find out what files and tools you need. - -(AR 23/9/2004 -- 8/11) - diff --git a/examples/gfcc/compiler/TestImperC.hs b/examples/gfcc/compiler/TestImperC.hs deleted file mode 100644 index a32777a5d..000000000 --- a/examples/gfcc/compiler/TestImperC.hs +++ /dev/null @@ -1,46 +0,0 @@ --- automatically generated by BNF Converter -module Main where - - -import Trees -import Profile -import IO ( stdin, hGetContents ) -import System ( getArgs, getProgName ) - -import LexImperC -import ParImperC -import ErrM - -type ParseFun = [Token] -> Err CFTree - -myLLexer = myLexer - -runFile :: ParseFun -> FilePath -> IO () -runFile p f = readFile f >>= run p - -run :: ParseFun -> String -> IO () -run p s = do - let ts = myLLexer s - let etree = p ts - case etree of - Ok tree -> do - case postParse tree of - Bad s -> do - putStrLn "\nParse Failed... CFTree:\n" - putStrLn $ prCFTree tree - putStrLn s - Ok tree -> do - putStrLn "\nParse Successful!" - putStrLn $ "\n[Abstract Syntax]\n\n" ++ prt tree - Bad s -> do - putStrLn s - putStrLn "\nParse failed... tokenization:" - print ts - -main :: IO () -main = do args <- getArgs - case args of - [] -> hGetContents stdin >>= run pProgram - [f] -> runFile pProgram f - _ -> do progName <- getProgName - putStrLn $ progName ++ ": excess arguments." diff --git a/examples/gfcc/compiler/Trees.hs b/examples/gfcc/compiler/Trees.hs deleted file mode 100644 index 57fbfd966..000000000 --- a/examples/gfcc/compiler/Trees.hs +++ /dev/null @@ -1,78 +0,0 @@ -module Trees where - -data Exp = - EApp Exp Exp - | EAbs Ident Exp - | EAtom Atom - deriving (Eq,Ord,Show) - -newtype CFTree = CFTree (CFFun,[CFTree]) deriving (Eq, Show) - -type CFCat = Ident - -newtype Ident = Ident String deriving (Eq, Ord, Show) - --- to build trees: the Atom contains a GF function, Cn | Meta | Vr | Literal -newtype CFFun = CFFun (Atom, Profile) deriving (Eq,Ord,Show) - -type Profile = [([[Int]],[Int])] - -data Atom = - AC Ident - | AV Ident - | AM - | AS String - | AI Integer - deriving (Eq,Ord,Show) - --- printing - -class Prt a where - prt :: a -> String - -instance Prt Exp where - prt e = case e of - EApp f a -> unwords [prt f, prt1 a] - EAbs x a -> "\\" ++ prt x ++ " -> " ++ prt a - EAtom a -> prt a - where - prt1 e = case e of - EAtom _ -> prt e - _ -> "(" ++ prt e ++ ")" - -instance Prt Atom where - prt a = case a of - AC x -> prt x - AV x -> prt x - AM -> "?" - AS s -> show s ---- - AI i -> show i - -instance Prt Ident where - prt (Ident x) = x - --- printing trees - -prCFTree :: CFTree -> String -prCFTree (CFTree (fun, trees)) = prCFFun fun ++ prs trees where - prs [] = "" - prs ts = " " ++ unwords (map ps ts) - ps t@(CFTree (_,[])) = prCFTree t - ps t = "(" ++ prCFTree t ++ ")" - -prCFFun :: CFFun -> String -prCFFun = prCFFun' True ---- False -- print profiles for debug - -prCFFun' :: Bool -> CFFun -> String -prCFFun' profs (CFFun (t, p)) = prt t ++ pp p where - pp p = if (not profs || normal p) then "" else "_" ++ concat (map show p) - normal p = and [x==y && null b | ((b,x),y) <- zip p (map (:[]) [0..])] - -prCFCat :: CFCat -> String -prCFCat c = prt c - -mkFunTree :: String -> Profile -> [CFTree] -> CFTree -mkFunTree f p ts = CFTree (CFFun (AC (Ident f),p), ts) - -mkAtTree :: Atom -> CFTree -mkAtTree a = CFTree (CFFun (a,[]), []) diff --git a/examples/gfcc/compiler/abs.c b/examples/gfcc/compiler/abs.c deleted file mode 100644 index 947711c13..000000000 --- a/examples/gfcc/compiler/abs.c +++ /dev/null @@ -1,20 +0,0 @@ -int abs (int x){ - int y ; - { - if (x < 0){ - y = 0 - x ; - } - else { - y = x ; - } - } - return y ; - } ; -int main () { - int i ; - i = abs (16); - printf ("%d",i) ; - return ; - } ; - - diff --git a/examples/gfcc/compiler/demo.c b/examples/gfcc/compiler/demo.c deleted file mode 100644 index d9a95d2b6..000000000 --- a/examples/gfcc/compiler/demo.c +++ /dev/null @@ -1,9 +0,0 @@ -int fact (int n) { - int f ; - f = 1 ; - while (1 < n) { - f = n * f ; - n = n - 1 ; - } - return f ; -} ; diff --git a/examples/gfcc/compiler/demo.gif b/examples/gfcc/compiler/demo.gif Binary files differdeleted file mode 100644 index 798c09170..000000000 --- a/examples/gfcc/compiler/demo.gif +++ /dev/null diff --git a/examples/gfcc/compiler/factorial.c b/examples/gfcc/compiler/factorial.c deleted file mode 100644 index 76fee32d0..000000000 --- a/examples/gfcc/compiler/factorial.c +++ /dev/null @@ -1,38 +0,0 @@ -int fact (int n) { - int f ; - f = 1 ; - { - while (1 < n) { - f = n * f ; - n = n - 1 ; - } - } - return f ; -} ; - -int factr (int n) { - int f ; - { - if (n < 2) { - f = 1 ; - } - else { - f = n * factr (n-1) ; - } - } - return f ; -} ; - -int main () { - int n ; - n = 1 ; - { - while (n < 11) { - printf("%d",fact(n)) ; - printf("%d",factr(n)) ; - n = n+1 ; - } - } - return ; -} ; - diff --git a/examples/gfcc/compiler/fibonacci.c b/examples/gfcc/compiler/fibonacci.c deleted file mode 100644 index 80e8a0d5c..000000000 --- a/examples/gfcc/compiler/fibonacci.c +++ /dev/null @@ -1,18 +0,0 @@ -int mx () { - return 5000000 ; -} ; - -int main () { - int lo ; int hi ; - lo = 1 ; - hi = lo ; - printf("%d",lo) ; - { - while (hi < mx()) { - printf("%d",hi) ; - hi = lo + hi ; - lo = hi - lo ; - } - } - return ; -} ; diff --git a/examples/gfcc/compiler/gfcc b/examples/gfcc/compiler/gfcc deleted file mode 100644 index 5be0e4094..000000000 --- a/examples/gfcc/compiler/gfcc +++ /dev/null @@ -1,4 +0,0 @@ -./TestImperC $1 | tail -1 >gft.tmp -echo "es -file=typecheck.gfs" | gf -s Imper.gfcm -runghc CleanJVM jvm.tmp $1 -rm *.tmp diff --git a/examples/gfcc/compiler/makefile b/examples/gfcc/compiler/makefile deleted file mode 100644 index c23fcc48d..000000000 --- a/examples/gfcc/compiler/makefile +++ /dev/null @@ -1,22 +0,0 @@ -GF=gf -SRC=../ - -all: parser gfcm runtime - -compiler: - echo "pm | wf Imper.gfcm ;; pg -lang=ImperC -printer=plbnf | wf ImperC.tmp" | $(GF) $(SRC)ImperC.gf $(SRC)ImperJVM.gf - echo "entrypoints Program, Stm, Exp ;" >entry.tmp - cat entry.tmp ImperC.tmp >ImperC.cf - bnfc -m -prof ImperC.cf - make -f Makefile - rm *.tmp - jasmin runtime.j - -parser: - ghc --make TestImperC.hs -o TestImperC - -gfcm: - echo "pm | wf Imper.gfcm" | $(GF) $(SRC)ImperC.gf $(SRC)ImperJVM.gf - -runtime: - jasmin runtime.j diff --git a/examples/gfcc/compiler/runtime.j b/examples/gfcc/compiler/runtime.j deleted file mode 100644 index 88db0b9b8..000000000 --- a/examples/gfcc/compiler/runtime.j +++ /dev/null @@ -1,55 +0,0 @@ -.class public runtime -.super java/lang/Object -; -; standard initializer -.method public <init>()V - aload_0 - invokenonvirtual java/lang/Object/<init>()V - return -.end method - -.method public static ilt(II)I -.limit locals 2 -.limit stack 2 - iload_0 - iload_1 - if_icmpge Label0 - iconst_1 - ireturn - Label0: - iconst_0 - ireturn -.end method - -.method public static flt(FF)I -.limit locals 2 -.limit stack 2 - fload_0 - fload_1 - fcmpl - ifge Label0 - iconst_1 - ireturn - Label0: - iconst_0 - ireturn -.end method - -.method public static iprintf(I)V -.limit locals 1 -.limit stack 1000 - getstatic java/lang/System/out Ljava/io/PrintStream; - iload_0 - invokevirtual java/io/PrintStream/println(I)V - return -.end method - -.method public static fprintf(F)V -.limit locals 1 -.limit stack 1000 - getstatic java/lang/System/out Ljava/io/PrintStream; - fload_0 - invokevirtual java/io/PrintStream/println(F)V - return -.end method - diff --git a/examples/gfcc/compiler/typecheck.gfs b/examples/gfcc/compiler/typecheck.gfs deleted file mode 100644 index 815108ddc..000000000 --- a/examples/gfcc/compiler/typecheck.gfs +++ /dev/null @@ -1,6 +0,0 @@ -n Program -open gft.tmp -' -c solve -' -save ImperJVM jvm.tmp |
