diff --git a/examples/tutorial/embedded/Makefile b/examples/tutorial/embedded/Makefile index 787c75e69..119d5d0fe 100644 --- a/examples/tutorial/embedded/Makefile +++ b/examples/tutorial/embedded/Makefile @@ -1,18 +1,11 @@ -all: gf hs run - -gf: - echo "pm | wf math.gfcm" | gf MathEng.gf MathFre.gf - -hs: gf - echo "pg -printer=haskell | wf GSyntax.hs" | gf math.gfcm - -run: hs +all: + gfc --make -haskell MathEng.gf MathFre.gf ghc --make -o ./math TransferLoop.hs strip math clean: - rm -f *.gfc *.gfr *.o *.hi + rm -f *.gfo *.o *.hi distclean: - rm -f GSyntax.hs math math.gfcm *.gfc *.gfr *.o *.hi + rm -f GSyntax.hs math Math.gfcc *.gfo *.o *.hi diff --git a/examples/tutorial/embedded/Makefile_gfcc b/examples/tutorial/embedded/Makefile_gfcc deleted file mode 100644 index 257128e60..000000000 --- a/examples/tutorial/embedded/Makefile_gfcc +++ /dev/null @@ -1,18 +0,0 @@ -all: gf hs run - -gf: - echo "pm -printer=gfcc | wf math.gfcc" | gf MathEng.gf MathFre.gf - -hs: gf - echo "pg -printer=gfcc_haskell | wf GSyntax.hs" | gf MathEng.gf MathFre.gf - -run: hs - ghc --make -o ./mathc TransferLoopGFCC.hs - strip mathc - -clean: - rm -f *.gfc *.gfr *.o *.hi - -distclean: - rm -f GSyntax.hs math math.gfcc *.gfc *.gfr *.o *.hi - diff --git a/examples/tutorial/embedded/TransferDef.hs b/examples/tutorial/embedded/TransferDef.hs index 4a86dc949..8be39107d 100644 --- a/examples/tutorial/embedded/TransferDef.hs +++ b/examples/tutorial/embedded/TransferDef.hs @@ -1,6 +1,6 @@ module TransferDef where -import GF.Embed.EmbedAPI (Tree) +import GF.GFCC.API (Tree) import GSyntax transfer :: Tree -> Tree diff --git a/examples/tutorial/embedded/TransferDefGFCC.hs b/examples/tutorial/embedded/TransferDefGFCC.hs deleted file mode 100644 index 00bbd5b3a..000000000 --- a/examples/tutorial/embedded/TransferDefGFCC.hs +++ /dev/null @@ -1,26 +0,0 @@ -module TransferDefGFCC where - -import GF.GFCC.API (Tree) -import GSyntax - -transfer :: Tree -> Tree -transfer = gf . answer . fg - -answer :: GQuestion -> GAnswer -answer p = case p of - GOdd x -> test odd x - GEven x -> test even x - GPrime x -> test prime x - -value :: GObject -> Int -value e = case e of - GNumber (GInt i) -> fromInteger i - -test :: (Int -> Bool) -> GObject -> GAnswer -test f x = if f (value x) then GYes else GNo - -prime :: Int -> Bool -prime x = elem x primes where - primes = sieve [2 .. x] - sieve (p:xs) = p : sieve [ n | n <- xs, n `mod` p > 0 ] - sieve [] = [] diff --git a/examples/tutorial/embedded/TransferLoop.hs b/examples/tutorial/embedded/TransferLoop.hs index 07b530f74..708578156 100644 --- a/examples/tutorial/embedded/TransferLoop.hs +++ b/examples/tutorial/embedded/TransferLoop.hs @@ -1,11 +1,11 @@ module Main where -import GF.Embed.EmbedAPI +import GF.GFCC.API import TransferDef (transfer) main :: IO () main = do - gr <- file2grammar "math.gfcm" + gr <- file2grammar "Math.gfcc" loop (translate transfer gr) loop :: (String -> String) -> IO () @@ -17,7 +17,7 @@ loop trans = do translate :: (Tree -> Tree) -> MultiGrammar -> String -> String translate tr gr = unlines . map transLine . lines where - transLine s = case parseAllLang gr (startCat gr) s of + transLine s = case parseAllLang gr "Question" s of (lg,t:_):_ -> linearize gr lg (tr t) _ -> "NO PARSE" diff --git a/examples/tutorial/embedded/TransferLoopGFCC.hs b/examples/tutorial/embedded/TransferLoopGFCC.hs deleted file mode 100644 index e76afb788..000000000 --- a/examples/tutorial/embedded/TransferLoopGFCC.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Main where - -import GF.GFCC.API -import TransferDefGFCC (transfer) - -main :: IO () -main = do - gr <- file2grammar "math.gfcc" - loop (translate transfer gr) - -loop :: (String -> String) -> IO () -loop trans = do - s <- getLine - if s == "quit" then putStrLn "bye" else do - putStrLn $ trans s - loop trans - -translate :: (Tree -> Tree) -> MultiGrammar -> String -> String -translate tr gr = unlines . map transLine . lines where - transLine s = case parseAllLang gr "Question" s of - (lg,t:_):_ -> linearize gr lg (tr t) - _ -> "NO PARSE" - diff --git a/lib/resource/Makefile b/lib/resource/Makefile index 803700023..69ce36372 100644 --- a/lib/resource/Makefile +++ b/lib/resource/Makefile @@ -207,6 +207,16 @@ gf3present: # $(GFNewPresC) -path=present:prelude:api:api/toplevel api/toplevel/OverLangEng.gf # mv api/toplevel/Over*.gfc api/Try*.gf? ../present +gf3mathematical: + $(GFNew) mathematical/MathematicalEng.gf + $(GFNew) mathematical/MathematicalNor.gf + $(GFNew) mathematical/MathematicalGer.gf + $(GFNew) mathematical/MathematicalSpa.gf + $(GFNew) mathematical/MathematicalIta.gf + $(GFNew) mathematical/MathematicalFre.gf + $(GFNew) mathematical/MathematicalSwe.gf + $(GFNew) mathematical/MathematicalFin.gf + mv mathematical/*.gfc ../mathematical gf3langs: mv ../present/LangSpa.gfo tmpLangSpa.gfo diff --git a/src/GF/Devel/GFCCtoHaskell.hs b/src/GF/Devel/GFCCtoHaskell.hs index 4b34d1123..f836413cc 100644 --- a/src/GF/Devel/GFCCtoHaskell.hs +++ b/src/GF/Devel/GFCCtoHaskell.hs @@ -29,13 +29,13 @@ import qualified Data.Map as Map -- | the main function grammar2haskell :: GFCC -> String grammar2haskell gr = encodeUTF8 $ foldr (++++) [] $ - haskPreamble ++ [datatypes gr', gfinstances gr', fginstances gr'] + haskPreamble ++ [datatypes gr', gfinstances gr'] where gr' = hSkeleton gr grammar2haskellGADT :: GFCC -> String grammar2haskellGADT gr = encodeUTF8 $ foldr (++++) [] $ ["{-# OPTIONS_GHC -fglasgow-exts #-}"] ++ - haskPreamble ++ [datatypesGADT gr', gfinstances gr', fginstances gr'] + haskPreamble ++ [datatypesGADT gr', gfinstances gr'] where gr' = hSkeleton gr -- | by this you can prefix all identifiers with stg; the default is 'G' @@ -47,13 +47,14 @@ haskPreamble = "module GSyntax where", "", "import GF.GFCC.DataGFCC", - "import GF.GFCC.Raw.AbsGFCCRaw", + "import GF.GFCC.AbsGFCC", "----------------------------------------------------", "-- automatic translation from GF to Haskell", "----------------------------------------------------", "", - "class Gf a where gf :: a -> Exp", - "class Fg a where fg :: Exp -> a", + "class Gf a where", + " gf :: a -> Exp", + " fg :: Exp -> a", "", predefInst "GString" "String" "DTr [] (AS s) []", "", @@ -70,8 +71,7 @@ haskPreamble = predefInst gtyp typ patt = "newtype" +++ gtyp +++ "=" +++ gtyp +++ typ +++ " deriving Show" +++++ "instance Gf" +++ gtyp +++ "where" ++++ - " gf (" ++ gtyp +++ "s) =" +++ patt +++++ - "instance Fg" +++ gtyp +++ "where" ++++ + " gf (" ++ gtyp +++ "s) =" +++ patt ++++ " fg t =" ++++ " case t of" ++++ " " +++ patt +++ " ->" +++ gtyp +++ "s" ++++ @@ -81,13 +81,12 @@ type OIdent = String type HSkeleton = [(OIdent, [(OIdent, [OIdent])])] -datatypes, gfinstances, fginstances :: (String,HSkeleton) -> String +datatypes, gfinstances :: (String,HSkeleton) -> String datatypes = (foldr (+++++) "") . (filter (/="")) . (map hDatatype) . snd -gfinstances (m,g) = (foldr (+++++) "") $ (filter (/="")) $ (map (hInstance m)) g -fginstances (m,g) = (foldr (+++++) "") $ (filter (/="")) $ (map (fInstance m)) g +gfinstances (m,g) = (foldr (+++++) "") $ (filter (/="")) $ (map (gfInstance m)) g -hDatatype :: (OIdent, [(OIdent, [OIdent])]) -> String -hInstance, fInstance :: String -> (OIdent, [(OIdent, [OIdent])]) -> String +hDatatype :: (OIdent, [(OIdent, [OIdent])]) -> String +gfInstance :: String -> (OIdent, [(OIdent, [OIdent])]) -> String hDatatype ("Cn",_) = "" --- hDatatype (cat,[]) = "" @@ -120,6 +119,7 @@ hDatatypeGADT (cat, rules) [ gId f +++ "::" +++ concatMap (\a -> gId a +++ "-> ") args ++ t | (f,args) <- rules ] where t = "Tree" +++ gId cat ++ "_" +gfInstance m crs = hInstance m crs ++++ fInstance m crs ----hInstance m ("Cn",_) = "" --- seems to belong to an old applic. AR 18/5/2004 hInstance m (cat,[]) = "" @@ -133,13 +133,12 @@ hInstance m (cat,rules) -- no show for GADTs -- ++++ " gf (" ++ gId cat +++ "xs) = error (\"Bad " ++ cat ++ " value: \" ++ show xs)" | otherwise = - "instance Gf" +++ gId cat +++ "where" ++ - (if length rules == 1 then "" else "\n") +++ - foldr1 (\x y -> x ++ "\n" +++ y) [mkInst f xx | (f,xx) <- rules] + "instance Gf" +++ gId cat +++ "where\n" ++ + unlines [mkInst f xx | (f,xx) <- rules] where ec = elemCat cat baseVars = mkVars (baseSize (cat,rules)) - mkInst f xx = let xx' = mkVars (length xx) in "gf " ++ + mkInst f xx = let xx' = mkVars (length xx) in " gf " ++ (if length xx == 0 then gId f else prParenth (gId f +++ foldr1 (+++) xx')) +++ "=" +++ mkRHS f xx' mkVars n = ["x" ++ show i | i <- [1..n]] @@ -150,14 +149,13 @@ hInstance m (cat,rules) ----fInstance m ("Cn",_) = "" --- fInstance m (cat,[]) = "" fInstance m (cat,rules) = - "instance Fg" +++ gId cat +++ "where" ++++ - " fg t =" ++++ - " case t of" ++++ - foldr1 (\x y -> x ++ "\n" ++ y) [mkInst f xx | (f,xx) <- rules] ++++ - " _ -> error (\"no" +++ cat ++ " \" ++ show t)" + " fg t =" ++++ + " case t of" ++++ + unlines [mkInst f xx | (f,xx) <- rules] ++++ + " _ -> error (\"no" +++ cat ++ " \" ++ show t)" where mkInst f xx = - " DTr [] (AC (CId \"" ++ f ++ "\")) " ++ + " DTr [] (AC (CId \"" ++ f ++ "\")) " ++ "[" ++ prTList "," xx' ++ "]" +++ "->" +++ mkRHS f xx' where xx' = ["x" ++ show i | (_,i) <- zip xx [1..]] diff --git a/src/Makefile b/src/Makefile index 7c0273485..421409280 100644 --- a/src/Makefile +++ b/src/Makefile @@ -69,6 +69,10 @@ endif all: unix gfdoc $(BUILD_JAR) lib +static: GHCFLAGS += -optl-static +static: unix + + gf: unix unix: today opt