mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-20 18:29:33 -06:00
changed names of resource-1.3; added a note on homepage on release
This commit is contained in:
aarne
@@ -1,8 +0,0 @@
|
||||
interface LexMath = open Syntax in {
|
||||
|
||||
oper
|
||||
even_A : A ;
|
||||
odd_A : A ;
|
||||
prime_A : A ;
|
||||
|
||||
}
|
||||
@@ -1,8 +0,0 @@
|
||||
instance LexMathEng of LexMath = open SyntaxEng, ParadigmsEng in {
|
||||
|
||||
oper
|
||||
even_A = mkA "even" ;
|
||||
odd_A = mkA "odd" ;
|
||||
prime_A = mkA "prime" ;
|
||||
|
||||
}
|
||||
@@ -1,8 +0,0 @@
|
||||
instance LexMathFre of LexMath = open SyntaxFre, ParadigmsFre in {
|
||||
|
||||
oper
|
||||
even_A = mkA "pair" ;
|
||||
odd_A = mkA "impair" ;
|
||||
prime_A = mkA "premier" ;
|
||||
|
||||
}
|
||||
@@ -1,11 +0,0 @@
|
||||
all:
|
||||
gfc --make -haskell MathEng.gf MathFre.gf
|
||||
ghc --make -o ./math TransferLoop.hs
|
||||
strip math
|
||||
|
||||
clean:
|
||||
rm -f *.gfo *.o *.hi
|
||||
|
||||
distclean:
|
||||
rm -f GSyntax.hs math Math.gfcc *.gfo *.o *.hi
|
||||
|
||||
@@ -1,14 +0,0 @@
|
||||
abstract Math = {
|
||||
|
||||
cat Answer ; Question ; Object ;
|
||||
|
||||
fun
|
||||
Even : Object -> Question ;
|
||||
Odd : Object -> Question ;
|
||||
Prime : Object -> Question ;
|
||||
Number : Int -> Object ;
|
||||
|
||||
Yes : Answer ;
|
||||
No : Answer ;
|
||||
|
||||
}
|
||||
@@ -1,6 +0,0 @@
|
||||
--# -path=.:present:prelude:mathematical
|
||||
|
||||
concrete MathEng of Math = MathI with
|
||||
(Syntax = SyntaxEng),
|
||||
(Symbol = SymbolEng),
|
||||
(LexMath = LexMathEng) ;
|
||||
@@ -1,6 +0,0 @@
|
||||
--# -path=.:present:prelude:mathematical
|
||||
|
||||
concrete MathFre of Math = MathI with
|
||||
(Syntax = SyntaxFre),
|
||||
(Symbol = SymbolFre),
|
||||
(LexMath = LexMathFre) ;
|
||||
@@ -1,23 +0,0 @@
|
||||
incomplete concrete MathI of Math =
|
||||
open Syntax, Symbol, LexMath in {
|
||||
|
||||
flags startcat = Question ; lexer = textlit ; unlexer = text ;
|
||||
|
||||
lincat
|
||||
Answer = Text ;
|
||||
Question = Text ;
|
||||
Object = NP ;
|
||||
|
||||
lin
|
||||
Even = questAdj even_A ;
|
||||
Odd = questAdj odd_A ;
|
||||
Prime = questAdj prime_A ;
|
||||
Number n = mkNP (IntPN n) ;
|
||||
|
||||
Yes = mkText yes_Phr ;
|
||||
No = mkText no_Phr ;
|
||||
|
||||
oper
|
||||
questAdj : A -> NP -> Text = \adj,x -> mkText (mkQS (mkCl x adj)) ;
|
||||
|
||||
}
|
||||
@@ -1,26 +0,0 @@
|
||||
module TransferDef 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 [] = []
|
||||
@@ -1,23 +0,0 @@
|
||||
module Main where
|
||||
|
||||
import GF.GFCC.API
|
||||
import TransferDef (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"
|
||||
|
||||
@@ -1,16 +0,0 @@
|
||||
module Main where
|
||||
|
||||
import GF.Embed.EmbedAPI
|
||||
import System (getArgs)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
file:_ <- getArgs
|
||||
gr <- file2grammar file
|
||||
interact (translate gr)
|
||||
|
||||
translate :: MultiGrammar -> String -> String
|
||||
translate gr = unlines . map transLine . lines where
|
||||
transLine s =
|
||||
let (lang,tree:_):_ = parseAllLang gr (startCat gr) s
|
||||
in unlines [linearize gr lg tree | lg <- languages gr, lg /= lang]
|
||||
@@ -1,23 +0,0 @@
|
||||
module Main where
|
||||
|
||||
import GF.Embed.EmbedAPI
|
||||
import System (getArgs)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
file:_ <- getArgs
|
||||
gr <- file2grammar file
|
||||
loop (translate gr)
|
||||
|
||||
loop :: (String -> String) -> IO ()
|
||||
loop trans = do
|
||||
s <- getLine
|
||||
if s == "quit" then putStrLn "bye" else do
|
||||
putStrLn $ trans s
|
||||
loop trans
|
||||
|
||||
translate :: MultiGrammar -> String -> String
|
||||
translate gr = unlines . map transLine . lines where
|
||||
transLine s = case parseAllLang gr (startCat gr) s of
|
||||
(lg,t:_):_ -> unlines [linearize gr l t | l <- languages gr, l /= lg]
|
||||
_ -> "NO PARSE"
|
||||
@@ -1,100 +0,0 @@
|
||||
module GSyntax where
|
||||
|
||||
import GF.Infra.Ident
|
||||
import GF.Grammar.Grammar
|
||||
import GF.Grammar.PrGrammar
|
||||
import GF.Grammar.Macros
|
||||
import GF.Data.Operations
|
||||
----------------------------------------------------
|
||||
-- automatic translation from GF to Haskell
|
||||
----------------------------------------------------
|
||||
|
||||
class Gf a where gf :: a -> Trm
|
||||
class Fg a where fg :: Trm -> a
|
||||
|
||||
newtype GString = GString String deriving Show
|
||||
|
||||
instance Gf GString where
|
||||
gf (GString s) = K s
|
||||
|
||||
instance Fg GString where
|
||||
fg t =
|
||||
case termForm t of
|
||||
Ok ([], K s ,[]) -> GString s
|
||||
_ -> error ("no GString " ++ prt t)
|
||||
|
||||
newtype GInt = GInt Integer deriving Show
|
||||
|
||||
instance Gf GInt where
|
||||
gf (GInt s) = EInt s
|
||||
|
||||
instance Fg GInt where
|
||||
fg t =
|
||||
case termForm t of
|
||||
Ok ([], EInt s ,[]) -> GInt s
|
||||
_ -> error ("no GInt " ++ prt t)
|
||||
|
||||
newtype GFloat = GFloat Double deriving Show
|
||||
|
||||
instance Gf GFloat where
|
||||
gf (GFloat s) = EFloat s
|
||||
|
||||
instance Fg GFloat where
|
||||
fg t =
|
||||
case termForm t of
|
||||
Ok ([], EFloat s ,[]) -> GFloat s
|
||||
_ -> error ("no GFloat " ++ prt t)
|
||||
|
||||
----------------------------------------------------
|
||||
-- below this line machine-generated
|
||||
----------------------------------------------------
|
||||
|
||||
data GAnswer =
|
||||
GYes
|
||||
| GNo
|
||||
deriving Show
|
||||
|
||||
data GObject = GNumber GInt
|
||||
deriving Show
|
||||
|
||||
data GQuestion =
|
||||
GPrime GObject
|
||||
| GOdd GObject
|
||||
| GEven GObject
|
||||
deriving Show
|
||||
|
||||
|
||||
instance Gf GAnswer where
|
||||
gf GYes = appqc "Math" "Yes" []
|
||||
gf GNo = appqc "Math" "No" []
|
||||
|
||||
instance Gf GObject where gf (GNumber x1) = appqc "Math" "Number" [gf x1]
|
||||
|
||||
instance Gf GQuestion where
|
||||
gf (GPrime x1) = appqc "Math" "Prime" [gf x1]
|
||||
gf (GOdd x1) = appqc "Math" "Odd" [gf x1]
|
||||
gf (GEven x1) = appqc "Math" "Even" [gf x1]
|
||||
|
||||
|
||||
instance Fg GAnswer where
|
||||
fg t =
|
||||
case termForm t of
|
||||
Ok ([], Q (IC "Math") (IC "Yes"),[]) -> GYes
|
||||
Ok ([], Q (IC "Math") (IC "No"),[]) -> GNo
|
||||
_ -> error ("no Answer " ++ prt t)
|
||||
|
||||
instance Fg GObject where
|
||||
fg t =
|
||||
case termForm t of
|
||||
Ok ([], Q (IC "Math") (IC "Number"),[x1]) -> GNumber (fg x1)
|
||||
_ -> error ("no Object " ++ prt t)
|
||||
|
||||
instance Fg GQuestion where
|
||||
fg t =
|
||||
case termForm t of
|
||||
Ok ([], Q (IC "Math") (IC "Prime"),[x1]) -> GPrime (fg x1)
|
||||
Ok ([], Q (IC "Math") (IC "Odd"),[x1]) -> GOdd (fg x1)
|
||||
Ok ([], Q (IC "Math") (IC "Even"),[x1]) -> GEven (fg x1)
|
||||
_ -> error ("no Question " ++ prt t)
|
||||
|
||||
|
||||
@@ -1,38 +0,0 @@
|
||||
module Main where
|
||||
|
||||
import GSyntax
|
||||
import GF.Embed.EmbedAPI
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
gr <- file2grammar "math.gfcm"
|
||||
loop gr
|
||||
|
||||
loop :: MultiGrammar -> IO ()
|
||||
loop gr = do
|
||||
s <- getLine
|
||||
interpret gr s
|
||||
loop gr
|
||||
|
||||
interpret :: MultiGrammar -> String -> IO ()
|
||||
interpret gr s = do
|
||||
let ltss = parseAllLang gr "Question" s
|
||||
case ltss of
|
||||
[] -> putStrLn "no parse"
|
||||
(l,t:_):_ -> putStrLn $ linearize gr l $ gf $ answer $ fg t
|
||||
|
||||
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 = (< 8) ----
|
||||
Reference in New Issue
Block a user