msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

updated synopsis, removed GF/devel/

Browse Source
This commit is contained in:
aarne
2008-06-27 11:59:03 +00:00
parent 64d2a981a9
commit 73e401cee2
38 changed files with 29 additions and 2075 deletions
Download Patch File Download Diff File Expand all files Collapse all files

36
devel/compiler/Compile.hs
View File

@@ -1,36 +0,0 @@
module Compile where
import AbsSrc
import AbsTgt
import SMacros
import TMacros
import Eval
import Param
import STM
import Env
import qualified Data.Map as M
compile :: Grammar -> Env
compile (Gr defs) = err error snd $ appSTM (mapM_ compDef defs) emptyEnv
compDef :: Def -> STM Env ()
compDef d = case d of
DLin f ty exp -> do
val <- eval exp
addType f ty
addVal f val
DOper f ty exp -> do
addType f ty
addOper f exp
DPar p cs -> do
v <- sizeParType cs
let ty = TBas p
addParsize ty $ fst v
vals <- allParVals cs
addPartype ty vals
mapM_ (uncurry addParVal) (zip vals (map VPar [0..]))
DOpty a ty -> do
addTypedef a ty

56
devel/compiler/Env.hs
View File

@@ -1,56 +0,0 @@
module Env where
import AbsSrc
import AbsTgt
import STM
import qualified Data.Map as M
data Env = Env {
values :: M.Map Ident Val,
types :: M.Map Ident Type,
opers :: M.Map Ident Exp,
typedefs :: M.Map Ident Type,
parsizes :: M.Map Type Int,
partypes :: M.Map Type [Exp],
parvals :: M.Map Exp Val,
vars :: M.Map Ident Val
--- constrs :: M.Map Ident ([Int] -> Int)
}
emptyEnv = Env M.empty M.empty M.empty M.empty M.empty M.empty M.empty M.empty
lookEnv :: (Show i, Ord i) => (Env -> M.Map i a) -> i -> STM Env a
lookEnv field c = do
s <- readSTM
maybe (raise $ "unknown " ++ show c) return $ M.lookup c $ field s
addVal :: Ident -> Val -> STM Env ()
addVal c v = updateSTM (\env -> (env{values = M.insert c v (values env)}))
addType :: Ident -> Type -> STM Env ()
addType c v = updateSTM (\env -> (env{types = M.insert c v (types env)}))
addOper :: Ident -> Exp -> STM Env ()
addOper c v = updateSTM (\env -> (env{opers = M.insert c v (opers env)}))
addTypedef :: Ident -> Type -> STM Env ()
addTypedef c v = updateSTM (\env -> (env{typedefs = M.insert c v (typedefs env)}))
addParsize :: Type -> Int -> STM Env ()
addParsize c v = updateSTM (\env -> (env{parsizes = M.insert c v (parsizes env)}))
addPartype :: Type -> [Exp] -> STM Env ()
addPartype c v = updateSTM (\env -> (env{partypes = M.insert c v (partypes env)}))
addParVal :: Exp -> Val -> STM Env ()
addParVal c v = updateSTM (\env -> (env{parvals = M.insert c v (parvals env)}))
---addEnv :: (Env -> M.Map Ident a) -> Ident -> a -> STM Env ()
---addEnv field c v = updateSTM (\env -> (env{field = M.insert c v (field env)},()))
addVar :: Ident -> STM Env ()
addVar x = do
s <- readSTM
let i = M.size $ vars s
updateSTM (\env -> (env{vars = M.insert x (VArg $ toInteger i) (vars env)}))

57
devel/compiler/Eval.hs
View File

@@ -1,57 +0,0 @@
module Eval where
import AbsSrc
import AbsTgt
import SMacros
import TMacros
import Match
import Env
import STM
eval :: Exp -> STM Env Val
eval e = case e of
EAbs x b -> do
addVar x ---- adds new VArg i
eval b
EApp _ _ -> do
let (f,xs) = apps e
xs' <- mapM eval xs
case f of
ECon c -> do
v <- lookEnv values c
return $ appVal v xs'
EOpr c -> do
e <- lookEnv opers c
v <- eval e ---- not possible in general
return $ appVal v xs'
ECon c -> lookEnv values c
EOpr c -> lookEnv opers c >>= eval ---- not possible in general
EVar x -> lookEnv vars x
ECst _ _ -> lookEnv parvals e
EStr s -> return $ VTok s
ECat x y -> do
x' <- eval x
y' <- eval y
return $ VCat x' y'
ERec fs -> do
vs <- mapM eval [e | FExp _ e <- fs]
return $ VRec vs
ETab ty cs -> do
-- sz <- lookEnv parsizes ty
-- let ps = map (VPar . toInteger) [0..sz-1]
ps <- lookEnv partypes ty
vs <- mapM (\p -> match cs p >>= eval) ps
return $ VRec vs
ESel t v -> do
t' <- eval t
v' <- eval v
---- pattern match first
return $ compVal [] $ VPro t' v' ---- []
EPro t v@(Lab _ i) -> do
t' <- eval t
return $ compVal [] $ VPro t' (VPar i)

21
devel/compiler/Match.hs
View File

@@ -1,21 +0,0 @@
module Match where
import AbsSrc
import AbsTgt
import Env
import STM
match :: [Case] -> Exp -> STM Env Exp
match cs v = checks $ map (tryMatch v) cs
---- return substitution
tryMatch :: Exp -> Case -> STM Env Exp
tryMatch e (Cas p v) = if fit (e, p) then return v else raise "no fit" where
fit (exp,patt) = case (exp,patt) of
(ECst c es, PCon d ps) ->
c == d &&
length es == length ps &&
all fit (zip es ps)
(_,PVar _) -> True ---- not is exp contains variables

27
devel/compiler/Param.hs
View File

@@ -1,27 +0,0 @@
module Param where
import AbsSrc
import SMacros
import Env
import STM
sizeParType :: [Constr] -> STM Env (Int,Int)
sizeParType cs = do
scs <- mapM sizeC cs
return (sum scs, length cs)
where
sizeC (Con c ts) = do
ats <- mapM (lookEnv parsizes) ts
return $ product ats
allParVals :: [Constr] -> STM Env [Exp]
allParVals cs = do
ess <- mapM alls cs
return $ concat ess
where
alls (Con c []) = do
return [constr c []]
alls (Con c ts) = do
ess <- mapM (lookEnv partypes) ts
return [constr c es | es <- sequence ess]

48
devel/compiler/PrEnv.hs
View File

@@ -1,48 +0,0 @@
module PrEnv where
import Env
import AbsSrc
import AbsTgt
import qualified PrintSrc as S
import qualified PrintTgt as T
import qualified Data.Map as M
prEnv :: Env -> IO ()
prEnv env = do
putStrLn "--# types"
mapM_ putStrLn
[prs c ++ " : " ++ prs val | (c,val) <- M.toList $ types env]
putStrLn "--# typedefs"
mapM_ putStrLn
[prs c ++ " = " ++ prs val | (c,val) <- M.toList $ typedefs env]
putStrLn "--# partypes"
mapM_ putStrLn
[prs c ++ " = " ++ unwords (map prs val) | (c,val) <- M.toList $ partypes env]
putStrLn "--# parvals"
mapM_ putStrLn
[prs c ++ " = " ++ prt val | (c,val) <- M.toList $ parvals env]
putStrLn "--# values"
mapM_ putStrLn
[prs c ++ " = " ++ prt val | (c,val) <- M.toList $ values env]
prs :: (S.Print a) => a -> String
prs = S.printTree
prt :: (T.Print a) => a -> String
prt = T.printTree
{-
data Env = Env {
values :: M.Map Ident Val,
types :: M.Map Ident Type,
opers :: M.Map Ident Exp,
typedefs :: M.Map Ident Type,
partypes :: M.Map Type [Exp],
parvals :: M.Map Exp Val,
vars :: M.Map Ident Val
}
-}

16
devel/compiler/SMacros.hs
View File

@@ -1,16 +0,0 @@
module SMacros where
import AbsSrc
apps :: Exp -> (Exp,[Exp])
apps e = (f,reverse xs) where
(f,xs) = aps e
aps e = case e of
EApp f x -> let (f',xs) = aps f in (f',x:xs)
_ -> (e,[])
constr :: Ident -> [Exp] -> Exp
constr = ECst
mkApp :: Exp -> [Exp] -> Exp
mkApp f = foldl EApp f

94
devel/compiler/STM.hs
View File

@@ -1,94 +0,0 @@
module STM where
import Control.Monad
-- state monad
-- 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
fail = Bad
Ok a >>= f = f a
Bad s >>= f = Bad s
-- | analogue of @maybe@
err :: (String -> b) -> (a -> b) -> Err a -> b
err d f e = case e of
Ok a -> f a
Bad s -> d s
-- state monad with error; from Agda 6/11/2001
newtype STM s a = STM (s -> Err (a,s))
appSTM :: STM s a -> s -> Err (a,s)
appSTM (STM f) s = f s
stm :: (s -> Err (a,s)) -> STM s a
stm = STM
stmr :: (s -> (a,s)) -> STM s a
stmr f = stm (\s -> return (f s))
instance Monad (STM s) where
return a = STM (\s -> return (a,s))
STM c >>= f = STM (\s -> do
(x,s') <- c s
let STM f' = f x
f' s')
readSTM :: STM s s
readSTM = stmr (\s -> (s,s))
updateSTM :: (s -> s) -> STM s ()
updateSTM f = stmr (\s -> ((),f s))
writeSTM :: s -> STM s ()
writeSTM s = stmr (const ((),s))
done :: Monad m => m ()
done = return ()
class Monad m => ErrorMonad m where
raise :: String -> m a
handle :: m a -> (String -> m a) -> m a
handle_ :: m a -> m a -> m a
handle_ a b = a `handle` (\_ -> b)
instance ErrorMonad Err where
raise = Bad
handle a@(Ok _) _ = a
handle (Bad i) f = f i
instance ErrorMonad (STM s) where
raise msg = STM (\s -> raise msg)
handle (STM f) g = STM (\s -> (f s)
`handle` (\e -> let STM g' = (g e) in
g' s))
-- | if the first check fails try another one
checkAgain :: ErrorMonad m => m a -> m a -> m a
checkAgain c1 c2 = handle_ c1 c2
checks :: ErrorMonad m => [m a] -> m a
checks [] = raise "no chance to pass"
checks cs = foldr1 checkAgain cs
allChecks :: ErrorMonad m => [m a] -> m [a]
allChecks ms = case ms of
(m: ms) -> let rs = allChecks ms in handle_ (liftM2 (:) m rs) rs
_ -> return []
doUntil :: ErrorMonad m => (a -> Bool) -> [m a] -> m a
doUntil cond ms = case ms of
a:as -> do
v <- a
if cond v then return v else doUntil cond as
_ -> raise "no result"

68
devel/compiler/Src.cf
View File

@@ -1,68 +0,0 @@
Gr. Grammar ::= [Def] ;
DPar. Def ::= "param" Ident "=" [Constr] ;
DOper. Def ::= "oper" Ident ":" Type "=" Exp ;
DOpty. Def ::= "oper" Ident "=" Type ;
DLin. Def ::= "lin" Ident ":" Type "=" Exp ;
terminator Def ";" ;
Con. Constr ::= Ident [Type] ;
separator nonempty Constr "|" ;
TBas. Type1 ::= Ident ;
TVal. Type1 ::= "Ints" Integer ;
TRec. Type1 ::= "{" [Typing] "}" ;
TFun. Type ::= Type1 "->" Type ;
coercions Type 1 ;
terminator Type "" ;
FTyp. Typing ::= Label ":" Type ;
separator Typing ";" ;
Lab. Label ::= Ident "#" Integer ;
EVar. Exp2 ::= "$" Ident ;
EOpr. Exp2 ::= "&" Ident ;
ECon. Exp2 ::= Ident ;
EVal. Exp2 ::= Integer ;
EStr. Exp2 ::= String ;
ECst. Exp2 ::= "(" Ident "@" [Exp] ")" ;
ERec. Exp2 ::= "{" [Assign] "}" ;
EApp. Exp1 ::= Exp1 Exp2 ;
ESel. Exp1 ::= Exp1 "!" Exp2 ;
EPro. Exp1 ::= Exp1 "." Label ;
ETab. Exp1 ::= "table" Type "{" [Case] "}" ;
ECat. Exp ::= Exp "++" Exp1 ;
EAbs. Exp ::= "\\" Ident "->" Exp ;
coercions Exp 2 ;
separator Exp "," ;
FExp. Assign ::= Label "=" Exp ;
separator Assign ";" ;
Cas. Case ::= Patt "=>" Exp ;
separator Case ";" ;
PVal. Patt ::= Integer ;
PVar. Patt ::= "$" Ident ;
PRec. Patt ::= "{" [AssPatt] "}" ;
PCon. Patt ::= "(" Ident [Patt] ")" ;
terminator Patt "" ;
FPatt. AssPatt ::= Label "=" Patt ;
separator AssPatt ";" ;
comment "--" ;
comment "{-" "-}" ;

20
devel/compiler/TMacros.hs
View File

@@ -1,20 +0,0 @@
module TMacros where
import AbsTgt
appVal :: Val -> [Val] -> Val
appVal v vs = compVal vs v
compVal :: [Val] -> Val -> Val
compVal args = comp where
comp val = case val of
VRec vs -> VRec $ map comp vs
VPro r p -> case (comp r, comp p) of
(VRec vs, VPar i) -> vs !! fromInteger i
(r',p') -> VPro r' p' ---- not at runtime
VArg j
| i < length args -> args !! i ---- not needed at runtime
| otherwise -> val ---- not the right thing at compiletime either
where i = fromInteger j
VCat x y -> VCat (comp x) (comp y)
_ -> val

18
devel/compiler/Tgt.cf
View File

@@ -1,18 +0,0 @@
--- target language
Tg. Object ::= [Fun] ;
FVal. Fun ::= Id "=" Val ;
terminator Fun ";" ;
VRec. Val ::= "[" [Val] "]" ;
VPro. Val ::= "(" Val "." Val ")" ;
VTok. Val ::= String ;
VArg. Val ::= "$" Integer ;
VPar. Val ::= Integer ;
VCat. Val ::= "(" Val Val ")" ;
terminator Val "," ;
token Id (letter | '_') (letter | digit | '_' | '\'')* ;

34
devel/compiler/Top.hs
View File

@@ -1,34 +0,0 @@
module Main where
import IO ( stdin, hGetContents )
import System ( getArgs, getProgName )
import LexSrc
import ParSrc
import SkelSrc
import PrintSrc
import AbsSrc
import Compile
import PrEnv
import ErrM
type ParseFun a = [Token] -> Err a
myLLexer = myLexer
runFile :: ParseFun Grammar -> FilePath -> IO ()
runFile p f = readFile f >>= run p
run :: ParseFun Grammar -> String -> IO ()
run p s = let ts = myLLexer s in case p ts of
Bad s -> do putStrLn "Parse Failed...\n"
putStrLn s
Ok tree -> prEnv $ compile tree
main :: IO ()
main = do args <- getArgs
case args of
fs -> mapM_ (runFile pGrammar) fs

45
devel/compiler/ex.src
View File

@@ -1,45 +0,0 @@
param Num = Sg | Pl ;
param Gen = Masc | Fem ;
param AG = A Num Gen ;
oper Agr = {g#0 : Gen ; n#1 : Num} ;
oper CN = {s#1 : Num -> Str ; g#0 : Gen} ;
oper NP = {s#1 : Str ; a#0 : Agr} ;
oper artDef : Gen -> Str = \g -> table Gen {
(Masc) => "le" ;
(Fem) => "la"
} ! $g ;
lin Voiture : CN = {
s#1 = table Num {
(Sg) => "voiture" ;
(Pl) => "voitures"
} ;
g#0 = (Fem@)
} ;
lin Bus : CN = {
s#1 = table Num {$x => "bus"} ;
g#0 = (Masc@)
} ;
lin Indef : CN -> NP = \cn -> {
s#1 = table Gen {
(Masc) => "un" ;
$x => "une"
} ! $cn.g#0 ++ $cn.s#1 ! (Sg@) ;
a#0 = {g#0 = $cn.g#0 ; n#1 = (Sg@)}
} ;
lin Def : CN -> NP = \cn -> {
s#1 = &artDef $cn.g#0 ++ $cn.s#1 ! (Sg@) ;
a#0 = {g#0 = $cn.g#0 ; n#1 = (Sg@)}
} ;
lin UneVoiture : NP = Indef Voiture ;
lin LaVoiture : NP = Def Voiture ;

14
devel/koe/Koe.gf
View File

@@ -1,14 +0,0 @@
abstract Koe = {
flags startcat = S ;
cat S ; NP ; VP ;
fun
Pred : NP -> VP -> S ;
Je, Tu, Il, Elle, Nous, Vous, Ils, Elles : NP ;
Strong : VP ;
}

50
devel/koe/KoeFre.gf
View File

@@ -1,50 +0,0 @@
concrete KoeFre of Koe = {
flags coding=utf8 ;
param
Gen = Masc | Fem ;
Num = Sg | Pl ;
Per = P1 | P2 | P3 ;
oper
Agr : Type = {g : Gen ; n : Num ; p : Per} ;
predA : Str -> {s : Agr => Str} = \adj ->
{s = \\a => copula a.n a.p ++ regA adj a.g a.n} ;
copula : Num -> Per -> Str = \n,p -> case <n,p> of {
<Sg,P1> => "suis" ;
<Sg,P2> => "es" ;
<Sg,P3> => "est" ;
<Pl,P1> => "sommes" ;
<Pl,P2> => "êtes" ;
<Pl,P3> => "sont"
} ;
regA : Str -> Gen -> Num -> Str = \s,g,n -> case <g,n> of {
<Masc,Sg> => s ;
<Masc,Pl> => s + "s" ;
<Fem,Sg> => s + "e";
<Fem,Pl> => s + "es"
} ;
lincat
NP = {s : Str ; a : Agr} ;
VP = {s : Agr => Str} ;
lin
Pred np vp = {s = np.s ++ vp.s ! np.a} ;
Je = {s = "je" ; a = {g = Masc ; n = Sg ; p = P1}} ;
Tu = {s = "tu" ; a = {g = Masc ; n = Sg ; p = P2}} ;
Il = {s = "il" ; a = {g = Masc ; n = Sg ; p = P3}} ;
Elle = {s = "elle" ; a = {g = Fem ; n = Sg ; p = P3}} ;
Nous = {s = "nous" ; a = {g = Masc ; n = Pl ; p = P1}} ;
Vous = {s = "vous" ; a = {g = Masc ; n = Pl ; p = P2}} ;
Ils = {s = "ils" ; a = {g = Masc ; n = Pl ; p = P3}} ;
Elles = {s = "elles" ; a = {g = Fem ; n = Pl ; p = P3}} ;
Strong = predA "fort" ;
}

71
devel/phrases/Makefile
View File

@@ -1,71 +0,0 @@
GF_GRAMMAR_ABS = Travel
GF_GRAMMAR_ENG = $(GF_GRAMMAR_ABS)Eng
GF_GRAMMAR_THA = $(GF_GRAMMAR_ABS)Tha
GF_GRAMMAR_THP = $(GF_GRAMMAR_ABS)ThaiP
GF_GRAMMAR_CNC = $(GF_GRAMMAR_ABS)ThaiP $(GF_GRAMMAR_ABS)Tha $(GF_GRAMMAR_ABS)Eng
GF_GRAMMAR_CNC_FILES = $(addsuffix .gf, $(GF_GRAMMAR_CNC))
GF_GRAMMAR_FILES = $(addsuffix .gf, $(GF_GRAMMAR_ABS)) $(GF_GRAMMAR_CNC_FILES)
GEN_FILES = $(addsuffix .grxml, $(GF_GRAMMAR_ENG)) \
$(addsuffix .gram, $(GF_GRAMMAR_ENG)) \
$(addsuffix .jsgf, $(GF_GRAMMAR_ENG)) \
$(addsuffix .jsgf, $(GF_GRAMMAR_THA)) \
$(addsuffix .jsgf, $(GF_GRAMMAR_THP)) \
$(addsuffix .vxml, $(GF_GRAMMAR_ENG)) \
$(addsuffix .vxml-generic, $(GF_GRAMMAR_ENG)) \
$(addsuffix .vxml-grxml, $(GF_GRAMMAR_ENG)) \
$(addsuffix .vxml-gram, $(GF_GRAMMAR_ENG)) \
$(addsuffix .vxml-jsgf, $(GF_GRAMMAR_ENG)) \
$(addsuffix .js, $(GF_GRAMMAR_ABS))
SRG_FORMAT = gram
.PHONY: all clean
all: $(GEN_FILES)
%.grxml: %.gf
echo "pg -printer=srgs_xml_sisr_old | wf $@" | gf -s -nocpu -batch $^
tidy -q -xml -i -wrap 200 -m $@
# Work around tidy bug
perl -i -pe 's/ lang=/ xml:lang=/' $@
%.gram: %.gf
echo "pg -printer=srgs_abnf_sisr_old | wf $@" | gf -s -nocpu -batch $^
%.jsgf: %.gf
echo "pg -printer=jsgf_sisr_old | wf $@" | gf -s -nocpu -batch $^
%.vxml: %.vxml-$(SRG_FORMAT)
cp $^ $@
%.vxml-generic: %.gf
echo 'pg -printer=vxml | wf $@' | gf -s -nocpu -batch $^
tidy -q -xml -i -wrap 200 -m $@
# Work around tidy bug
perl -i -pe 's/ lang=/ xml:lang=/' $@
# Work around Opera bug
perl -i -pe "s/ src=\"#/ src=\"$*.vxml#/" $@
%.vxml-grxml: %.vxml-generic
cp $^ $@
%.vxml-gram: %.vxml-generic
cp $^ $@
perl -i -pe 's/\.grxml/\.gram/' $@
%.vxml-jsgf: %.vxml-generic
cp $^ $@
perl -i -pe 's/\.grxml/\.jsgf/' $@
# Work around Opera for Zaurus bug
perl -i -pe 's/ src="(.*\.jsgf)#(\w+)"/ src="$$1" root="$$2"/' $@
$(GF_GRAMMAR_ABS).js: $(GF_GRAMMAR_FILES)
echo "pm -printer=js | wf $@" | gf -s -nocpu -batch $(GF_GRAMMAR_CNC_FILES)
gflib.js: $(GF_LIB_PATH)/javascript/gflib.js
cat $^ > $@
clean:
-rm -f $(GEN_FILES)
-rm -f *.gfc

50
devel/phrases/Numeral.gf
View File

@@ -1,50 +0,0 @@
--1 Numerals
-- This grammar defines numerals from 1 to 999999.
-- The implementations are adapted from the
-- [numerals library http://www.cs.chalmers.se/~aarne/GF/examples/numerals/]
-- which defines numerals for 88 languages.
-- The resource grammar implementations add to this inflection (if needed)
-- and ordinal numbers.
--
-- *Note* 1. Number 1 as defined
-- in the category $Numeral$ here should not be used in the formation of
-- noun phrases, and should therefore be removed. Instead, one should use
-- [Structural Structural.html]$.one_Quant$. This makes the grammar simpler
-- because we can assume that numbers form plural noun phrases.
--
-- *Note* 2. The implementations introduce spaces between
-- parts of a numeral, which is often incorrect - more work on
-- (un)lexing is needed to solve this problem.
abstract Numeral = {
cat
Numeral ;
Digit ; -- 2..9
Sub10 ; -- 1..9
Sub100 ; -- 1..99
Sub1000 ; -- 1..999
Sub1000000 ; -- 1..999999
fun
num : Sub1000000 -> Numeral ;
n2, n3, n4, n5, n6, n7, n8, n9 : Digit ;
pot01 : Sub10 ; -- 1
pot0 : Digit -> Sub10 ; -- d * 1
pot110 : Sub100 ; -- 10
pot111 : Sub100 ; -- 11
pot1to19 : Digit -> Sub100 ; -- 10 + d
pot0as1 : Sub10 -> Sub100 ; -- coercion of 1..9
pot1 : Digit -> Sub100 ; -- d * 10
pot1plus : Digit -> Sub10 -> Sub100 ; -- d * 10 + n
pot1as2 : Sub100 -> Sub1000 ; -- coercion of 1..99
pot2 : Sub10 -> Sub1000 ; -- m * 100
pot2plus : Sub10 -> Sub100 -> Sub1000 ; -- m * 100 + n
pot2as3 : Sub1000 -> Sub1000000 ; -- coercion of 1..999
pot3 : Sub1000 -> Sub1000000 ; -- m * 1000
pot3plus : Sub1000 -> Sub1000 -> Sub1000000 ; -- m * 1000 + n
}

77
devel/phrases/NumeralEng.gf
View File

@@ -1,77 +0,0 @@
--# -path=.:prelude
concrete NumeralEng of Numeral = open Prelude in {
lincat
Numeral = {s : Str} ; ---{s : CardOrd => Str ; n : Num} ;
Digit = {s : DForm => CardOrd => Str} ;
Sub10 = {s : DForm => CardOrd => Str ; n : Num} ;
Sub100 = {s : CardOrd => Str ; n : Num} ;
Sub1000 = {s : CardOrd => Str ; n : Num} ;
Sub1000000 = {s : CardOrd => Str ; n : Num} ;
lin num x = {s = x.s ! NCard} ; ----
lin n2 = let two = mkNum "two" "twelve" "twenty" "second" in
{s = \\f,c => case <f,c> of {
<teen,NOrd> => "twelfth" ;
_ => two.s ! f ! c
}
} ;
lin n3 = mkNum "three" "thirteen" "thirty" "third" ;
lin n4 = mkNum "four" "fourteen" "forty" "fourth" ;
lin n5 = mkNum "five" "fifteen" "fifty" "fifth" ;
lin n6 = regNum "six" ;
lin n7 = regNum "seven" ;
lin n8 = mkNum "eight" "eighteen" "eighty" "eighth" ;
lin n9 = mkNum "nine" "nineteen" "ninety" "ninth" ;
lin pot01 = mkNum "one" "eleven" "ten" "first" ** {n = Sg} ;
lin pot0 d = d ** {n = Pl} ;
lin pot110 = regCardOrd "ten" ** {n = Pl} ;
lin pot111 = regCardOrd "eleven" ** {n = Pl} ;
lin pot1to19 d = {s = d.s ! teen} ** {n = Pl} ;
lin pot0as1 n = {s = n.s ! unit} ** {n = n.n} ;
lin pot1 d = {s = d.s ! ten} ** {n = Pl} ;
lin pot1plus d e = {
s = \\c => d.s ! ten ! NCard ++ "-" ++ e.s ! unit ! c ; n = Pl} ;
lin pot1as2 n = n ;
lin pot2 d = {s = \\c => d.s ! unit ! NCard ++ mkCard c "hundred"} ** {n = Pl} ;
lin pot2plus d e = {
s = \\c => d.s ! unit ! NCard ++ "hundred" ++ "and" ++ e.s ! c ; n = Pl} ;
lin pot2as3 n = n ;
lin pot3 n = {
s = \\c => n.s ! NCard ++ mkCard c "thousand" ; n = Pl} ;
lin pot3plus n m = {
s = \\c => n.s ! NCard ++ "thousand" ++ m.s ! c ; n = Pl} ;
oper
mkNum : Str -> Str -> Str -> Str -> {s : DForm => CardOrd => Str} =
\two, twelve, twenty, second ->
{s = table {
unit => table {NCard => two ; NOrd => second} ;
teen => \\c => mkCard c twelve ;
ten => \\c => mkCard c twenty
}
} ;
regNum : Str -> {s : DForm => CardOrd => Str} =
\six -> mkNum six (six + "teen") (six + "ty") (regOrd six) ;
regCardOrd : Str -> {s : CardOrd => Str} = \ten ->
{s = table {NCard => ten ; NOrd => regOrd ten}} ;
mkCard : CardOrd -> Str -> Str = \c,ten ->
(regCardOrd ten).s ! c ;
regOrd : Str -> Str = \ten ->
case last ten of {
"y" => init ten + "ieth" ;
_ => ten + "th"
} ;
param Num = Sg | Pl ;
CardOrd = NCard | NOrd ;
DForm = unit | teen | ten ;
}

70
devel/phrases/NumeralTha.gf
View File

@@ -1,70 +0,0 @@
--# -path=.:prelude:resource-1.0/thai
concrete NumeralTha of Numeral = open StringsTha in {
flags coding=utf8 ; unlexer=concat ;
lincat
Numeral = {s : Str} ;
Digit = {s : DForm => Str} ;
Sub10 = {s : DForm => Str} ;
Sub100 = {s : NForm => Str} ;
Sub1000 = {s : NForm => Str} ;
Sub1000000 = {s : Str} ;
lin
num x = x ;
pot01 = mkNum nvg_s nvg_s et_s ;
n2 = mkNum soog_s yii_s soog_s ;
n3 = regNum saam_s ;
n4 = regNum sii_s ;
n5 = regNum haa_s ;
n6 = regNum hok_s ;
n7 = regNum cet_s ;
n8 = regNum peet_s ;
n9 = regNum kaaw_s ;
pot0 d = d ;
pot110 = {s = sip} ;
pot111 = {s = table {
Unit => sip_s ++ et_s ;
Thousand => nvg_s ++ mvvn_s ++ nvg_s ++ phan_s
}
} ;
pot1to19 d = {s = table {
Unit => sip_s ++ d.s ! After ;
Thousand => nvg_s ++ mvvn_s ++ d.s ! Indep ++ phan_s
}
} ;
pot0as1 d = {s = \\n => d.s ! Indep ++ phan ! n} ;
pot1 d = {s = \\n => d.s ! ModTen ++ sip ! n} ;
pot1plus d e = {
s = \\n => d.s ! ModTen ++ sip ! n ++ e.s ! After ++ phan ! n
} ;
pot1as2 n = n ;
pot2 d = {s = \\n => d.s ! Indep ++ roy ! n} ;
pot2plus d e = {s = \\n => d.s ! Indep ++ roy ! n ++ e.s ! n} ;
pot2as3 n = {s = n.s ! Unit} ;
pot3 n = {s = n.s ! Thousand} ;
pot3plus n m = {s = n.s ! Thousand ++ m.s ! Unit} ;
param
DForm = Indep | ModTen | After ;
NForm = Unit | Thousand ;
oper
mkNum : Str -> Str -> Str -> {s : DForm => Str} = \x,y,z ->
{s = table {Indep => x ; ModTen => y ; After => z}} ;
regNum : Str -> {s : DForm => Str} = \x ->
mkNum x x x ;
sip = table {Unit => sip_s ; Thousand => mvvn_s} ;
roy = table {Unit => rooy_s ; Thousand => seen_s} ;
phan = table {Unit => [] ; Thousand => phan_s} ;
}

86
devel/phrases/NumeralThaiP.gf
View File

@@ -1,86 +0,0 @@
--# -path=.:prelude:resource-1.0/thai
concrete NumeralThaiP of Numeral = {
lincat
Numeral = {s : Str} ;
Digit = {s : DForm => Str} ;
Sub10 = {s : DForm => Str} ;
Sub100 = {s : NForm => Str} ;
Sub1000 = {s : NForm => Str} ;
Sub1000000 = {s : Str} ;
lin
num x = x ;
pot01 = mkNum nvg_s nvg_s et_s ;
n2 = mkNum soog_s yii_s soog_s ;
n3 = regNum saam_s ;
n4 = regNum sii_s ;
n5 = regNum haa_s ;
n6 = regNum hok_s ;
n7 = regNum cet_s ;
n8 = regNum peet_s ;
n9 = regNum kaaw_s ;
pot0 d = d ;
pot110 = {s = sip} ;
pot111 = {s = table {
Unit => sip_s ++ et_s ;
Thousand => nvg_s ++ mvvn_s ++ nvg_s ++ phan_s
}
} ;
pot1to19 d = {s = table {
Unit => sip_s ++ d.s ! After ;
Thousand => nvg_s ++ mvvn_s ++ d.s ! Indep ++ phan_s
}
} ;
pot0as1 d = {s = \\n => d.s ! Indep ++ phan ! n} ;
pot1 d = {s = \\n => d.s ! ModTen ++ sip ! n} ;
pot1plus d e = {
s = \\n => d.s ! ModTen ++ sip ! n ++ e.s ! After ++ phan ! n
} ;
pot1as2 n = n ;
pot2 d = {s = \\n => d.s ! Indep ++ roy ! n} ;
pot2plus d e = {s = \\n => d.s ! Indep ++ roy ! n ++ e.s ! n} ;
pot2as3 n = {s = n.s ! Unit} ;
pot3 n = {s = n.s ! Thousand} ;
pot3plus n m = {s = n.s ! Thousand ++ m.s ! Unit} ;
oper
phan_s = "pahn" ;
rooy_s = "rawy" ;
mvvn_s = "meun" ;
seen_s = "sain" ;
nvg_s = "neung" ;
soog_s = "song" ;
saam_s = "sahm" ;
sii_s = "see" ;
haa_s = "hah" ;
hok_s = "hok" ;
cet_s = "jet" ;
peet_s = "baat" ;
kaaw_s = "gow" ;
sip_s = "sip" ;
yii_s = "yee" ;
et_s = "et" ;
param
DForm = Indep | ModTen | After ;
NForm = Unit | Thousand ;
oper
mkNum : Str -> Str -> Str -> {s : DForm => Str} = \x,y,z ->
{s = table {Indep => x ; ModTen => y ; After => z}} ;
regNum : Str -> {s : DForm => Str} = \x ->
mkNum x x x ;
sip = table {Unit => sip_s ; Thousand => mvvn_s} ;
roy = table {Unit => rooy_s ; Thousand => seen_s} ;
phan = table {Unit => [] ; Thousand => phan_s} ;
}

32
devel/phrases/Numerals.gf
View File

@@ -1,32 +0,0 @@
-- numerals from 1 to 999999 in decimal notation
flags startcat=Numeral ;
cat
Numeral ; -- 0..
Digit ; -- 2..9
Sub10 ; -- 1..9
Sub100 ; -- 1..99
Sub1000 ; -- 1..999
Sub1000000 ; -- 1..999999
fun
num : Sub1000000 -> Numeral ;
n2, n3, n4, n5, n6, n7, n8, n9 : Digit ;
pot01 : Sub10 ; -- 1
pot0 : Digit -> Sub10 ; -- d * 1
pot110 : Sub100 ; -- 10
pot111 : Sub100 ; -- 11
pot1to19 : Digit -> Sub100 ; -- 10 + d
pot0as1 : Sub10 -> Sub100 ; -- coercion of 1..9
pot1 : Digit -> Sub100 ; -- d * 10
pot1plus : Digit -> Sub10 -> Sub100 ; -- d * 10 + n
pot1as2 : Sub100 -> Sub1000 ; -- coercion of 1..99
pot2 : Sub10 -> Sub1000 ; -- m * 100
pot2plus : Sub10 -> Sub100 -> Sub1000 ; -- m * 100 + n
pot2as3 : Sub1000 -> Sub1000000 ; -- coercion of 1..999
pot3 : Sub1000 -> Sub1000000 ; -- m * 1000
pot3plus : Sub1000 -> Sub1000 -> Sub1000000 ; -- m * 1000 + n

43
devel/phrases/NumeralsEng.gf
View File

@@ -1,43 +0,0 @@
include numerals.Abs.gf ;
param DForm = unit | teen | ten ;
lincat Numeral = { s : Str } ;
lincat Digit = {s : DForm => Str} ;
lincat Sub10 = {s : DForm => Str} ;
lincat Sub100 = { s : Str } ;
lincat Sub1000 = { s : Str } ;
lincat Sub1000000 = { s : Str } ;
oper mkNum : Str -> Str -> Str -> Lin Digit =
\two -> \twelve -> \twenty ->
{s = table {unit => two ; teen => twelve ; ten => twenty}} ;
oper regNum : Str -> Lin Digit =
\six -> mkNum six (six + "teen") (six + "ty") ;
oper ss : Str -> {s : Str} = \s -> {s = s} ;
lin num x = x ;
lin n2 = mkNum "two" "twelve" "twenty" ;
lin n3 = mkNum "three" "thirteen" "thirty" ;
lin n4 = mkNum "four" "fourteen" "forty" ;
lin n5 = mkNum "five" "fifteen" "fifty" ;
lin n6 = regNum "six" ;
lin n7 = regNum "seven" ;
lin n8 = mkNum "eight" "eighteen" "eighty" ;
lin n9 = regNum "nine" ;
lin pot01 = {s = table {f => "one"}} ;
lin pot0 d = {s = table {f => d.s ! f}} ;
lin pot110 = ss "ten" ;
lin pot111 = ss "eleven" ;
lin pot1to19 d = {s = d.s ! teen} ;
lin pot0as1 n = {s = n.s ! unit} ;
lin pot1 d = {s = d.s ! ten} ;
lin pot1plus d e = {s = d.s ! ten ++ "-" ++ e.s ! unit} ;
lin pot1as2 n = n ;
lin pot2 d = {s = d.s ! unit ++ "hundred"} ;
lin pot2plus d e = {s = d.s ! unit ++ "hundred" ++ "and" ++ e.s} ;
lin pot2as3 n = n ;
lin pot3 n = {s = n.s ++ "thousand"} ;
lin pot3plus n m = {s = n.s ++ "thousand" ++ m.s} ;

4
devel/phrases/PizzaDraw.gf
View File

@@ -1,4 +0,0 @@
concrete PizzaDraw of Pizza = {
}

55
devel/phrases/Travel.gf
View File

@@ -1,55 +0,0 @@
abstract Travel = Numeral ** {
cat
Order ;
cat
Output ;
fun
confirm : Order -> Number -> Output ;
-- the essential phrases from Lone Planet Thai Phrasebook
order : Phrase -> Order ;
cat
Phrase ;
Number ;
fun
Hello : Phrase ;
Goodbye : Phrase ;
Please : Phrase ;
ThankYou : Phrase ;
YoureWelcome : Phrase ;
Yes : Phrase ;
No : Phrase ;
ExcuseAttention : Phrase ;
ExcuseGetPast : Phrase ;
Sorry : Phrase ;
IUnderstand : Phrase ;
IDontUnderstand : Phrase ;
Help : Phrase ;
WhereAreToilets : Phrase ;
SayNumber : Numeral -> Phrase ;
One, Two, Three, Four, Five, Six, Seven, Eight, Nine, Ten : Number ;
cat
Product ;
Kind ;
fun
HowMuchCost : Product -> Order ;
IWantToHave : Product -> Order ;
This : Kind -> Product ;
Beer : Kind ;
Shirt : Kind ;
}

85
devel/phrases/TravelEng.gf
View File

@@ -1,85 +0,0 @@
--# -path=.:prelude:resource-1.0/thai
concrete TravelEng of Travel = NumeralEng ** open Prelude in {
flags startcat = Order; language = en_US;
lincat
Order = { s : Str } ;
printname cat
Order = "What would you like to say?" ;
lin
order is = { s = is.s } ;
lincat
Output = { s : Str } ;
lin
confirm o t = { s = o.s} ;
flags unlexer=unwords ;
lincat
Phrase = SS ;
Number = SS ;
lin
Hello = ss "hello" ;
Goodbye = ss "bye" ;
Please = ss "please" ;
ThankYou = ss "thanks" ;
YoureWelcome = ss ["you are welcome"] ;
Yes = ss "yes" ;
No = ss "no" ;
ExcuseAttention = ss ["excuse me"] ;
ExcuseGetPast = ss ["excuse me"] ;
Sorry = ss "sorry" ;
IUnderstand = ss ["I understand"] ;
IDontUnderstand = ss ["I do not understand"] ;
Help = ss "help" ;
WhereAreToilets = ss ["where are the toilets"] ;
SayNumber n = n ;
One = ss "one" ;
Two = ss "two" ;
Three = ss "three" ;
Four = ss "four" ;
Five = ss "five" ;
Six = ss "six" ;
Seven = ss "seven" ;
Eight = ss "eight" ;
Nine = ss "nine" ;
Ten = ss "ten" ;
lincat
Product = {s : Str} ;
Kind = {s : Str} ;
printname cat
Product = "what product do you mean?" ;
Kind = "what kind of product do you mean?" ;
lin
HowMuchCost p = {s = ["how much does"] ++ item p ++ "cost"} ;
IWantToHave p = {s = ["I would like to have"] ++ item p} ;
This k = {s = "this" ++ variants {k.s ; []}} ;
Beer = {s = "beer"} ;
Shirt = {s = "shirt"} ;
oper
item : SS -> Str = \p ->
variants {
p.s ;
-- no product given at all
"it"
} ;
}

81
devel/phrases/TravelTha.gf
View File

@@ -1,81 +0,0 @@
--# -path=.:prelude:resource-1.0/thai
concrete TravelTha of Travel = NumeralTha ** open Prelude, StringsTha in {
flags startcat = Order; language = en_US; coding=utf8 ;
lincat
Order = { s : Str } ;
printname cat
Order = "What would you like to say?" ;
lin
order is = { s = is.s } ;
lincat
Output = { s : Str } ;
lin
confirm o t = { s = o.s } ;
flags unlexer=concat ;
lincat
Phrase = SS ;
Number = SS ;
lin
Hello = ss (sawat_s ++ dii_s) ;
Goodbye = ss (laa_s ++ koon_s) ;
Please = ss (khoo_s) ;
ThankYou = ss (khoop_s ++ khun_s) ;
YoureWelcome = ss (yin_s ++ dii_s) ;
Yes = ss (chay_s) ;
No = ss (may_s) ;
ExcuseAttention = ss (khoo_s ++ thoot_s) ;
ExcuseGetPast = ss (khoo_s ++ aphai_s) ;
Sorry = ss (khoo_s ++ thoot_s) ;
IUnderstand = ss (phom_s ++ khow_s ++ jai_s) ;
IDontUnderstand = ss (phom_s ++ may_s ++ khow_s ++ jai_s) ;
Help = ss (chuay_s ++ duay_s) ;
WhereAreToilets = ss (hoog_s ++ nam_s ++ yuu_s ++ thii_s ++ nai_s) ;
SayNumber n = n ;
One = ss (nvg_s) ;
Two = ss (soog_s) ;
Three = ss (saam_s) ;
Four = ss (sii_s) ;
Five = ss (haa_s) ;
Six = ss (hok_s) ;
Seven = ss (cet_s) ;
Eight = ss (peet_s) ;
Nine = ss (kaaw_s) ;
Ten = ss (sip_s) ;
lincat
Product = {s : Str} ;
Kind = {s : Str} ;
printname cat
Product = "what product do you mean?" ;
Kind = "what kind of product do you mean?" ;
lin
HowMuchCost p = ss (p.s ++ thao_s ++ rai_s) ;
IWantToHave p = ss (khoo_s ++ p.s ++ noi_s) ;
This k = ss (k.s ++ nii_s) ;
Beer = ss biar_s ;
Shirt = ss (seua_s ++ cheut_s) ;
}

80
devel/phrases/TravelThaiP.gf
View File

@@ -1,80 +0,0 @@
--# -path=.:prelude:resource-1.0/thai
concrete TravelThaiP of Travel = NumeralThaiP ** open Prelude, StringsTha in {
flags startcat = Order; language = en_US ;
lincat
Order = { s : Str } ;
printname cat
Order = "What would you like to say?" ;
lin
order is = { s = is.s } ;
lincat
Output = { s : Str } ;
lin
confirm o t = { s = o.s } ;
flags unlexer=unwords ;
lincat
Phrase = SS ;
Number = SS ;
lin
Hello = ss ["sah wut dee"] ;
Goodbye = ss ["lah gorn"] ;
Please = ss "kor" ;
ThankYou = ss ["kop koon"] ;
YoureWelcome = ss ["yin dee"] ;
Yes = ss "chai" ;
No = ss "mai" ;
ExcuseAttention = ss ["koh tort"] ;
ExcuseGetPast = ss ["koh ahpai"] ;
Sorry = ss ["koh tort"] ;
IUnderstand = ss ["pom kow jai"] ;
IDontUnderstand = ss ["pom mai kow jai"] ;
Help = ss ["chew wai dewai"] ;
WhereAreToilets = ss ["hong narm yoo tee nai"] ;
SayNumber n = n ;
One = ss "neung" ;
Two = ss "song" ;
Three = ss "sahm" ;
Four = ss "see" ;
Five = ss "hah" ;
Six = ss "hok" ;
Seven = ss "jet" ;
Eight = ss "baat" ;
Nine = ss "gow" ;
Ten = ss "sip" ;
lincat
Product = {s : Str} ;
Kind = {s : Str} ;
printname cat
Product = "what product do you mean?" ;
Kind = "what kind of product do you mean?" ;
lin
HowMuchCost p = ss (p.s ++ "tao" ++ "rai") ;
IWantToHave p = ss ("kor" ++ p.s ++ "noy") ;
This k = ss (k.s ++ "nee") ;
Beer = ss "beea" ;
Shirt = ss ("seua" ++ "cheut") ;
}

18
devel/phrases/flash-controls.js
View File

@@ -1,18 +0,0 @@
function getFlashMovieObject(movieName) {
if (window.document[movieName]) {
return window.document[movieName];
}
if (document.embeds && document.embeds[movieName]) {
return document.embeds[movieName];
} else {
return document.getElementById(movieName);
}
}
function flashPlay(movieName) {
getFlashMovieObject(movieName).Play();
}
function flashPause(movieName) {
getFlashMovieObject(movieName).StopPlay();
}

252
devel/phrases/gflib.js
View File

@@ -1,252 +0,0 @@
/* Abstract syntax trees */
function Fun(name) {
this.name = name;
this.args = copy_arguments(arguments, 1);
}
Fun.prototype.print = function () { return this.show(0); } ;
Fun.prototype.show = function (prec) {
if (this.isMeta()) {
if (isUndefined(this.type)) {
return '?';
} else {
var s = '?:' + this.type;
if (prec > 0) {
s = "(" + s + ")" ;
}
return s;
}
} else {
var s = this.name;
var cs = this.args;
for (var i in cs) {
s += " " + cs[i].show(1);
}
if (prec > 0 && cs.length > 0) {
s = "(" + s + ")" ;
}
return s;
}
};
Fun.prototype.getArg = function (i) {
return this.args[i];
};
Fun.prototype.setArg = function (i,c) {
this.args[i] = c;
};
Fun.prototype.isMeta = function() {
return this.name == '?';
} ;
Fun.prototype.isComplete = function() {
if (this.isMeta()) {
return false;
} else {
for (var i in tree.args) {
if (!tree.args[i].isComplete()) {
return false;
}
}
return true;
}
} ;
/* Concrete syntax terms */
function Arr() { this.arr = copy_arguments(arguments, 0); }
Arr.prototype.tokens = function() { return this.arr[0].tokens(); };
Arr.prototype.sel = function(i) { return this.arr[i.toIndex()]; };
function Seq() { this.seq = copy_arguments(arguments, 0); }
Seq.prototype.tokens = function() {
var xs = new Array();
for (var i in this.seq) {
var ys = this.seq[i].tokens();
for (var j in ys) {
xs.push(ys[j]);
}
}
return xs;
};
function Variants() { this.variants = copy_arguments(arguments, 0); }
Variants.prototype.tokens = function() { return this.variants[0].tokens(); };
function Rp(index,value) { this.index = index; this.value = value; }
Rp.prototype.tokens = function() { return new Array(this.index); };
Rp.prototype.toIndex = function() { return this.index.toIndex(); };
function Suffix(prefix,suffix) { this.prefix = prefix; this.suffix = suffix; };
Suffix.prototype.tokens = function() {
var xs = this.suffix.tokens();
for (var i in xs) {
xs[i] = this.prefix + xs[i];
}
return xs;
};
Suffix.prototype.sel = function(i) { return new Suffix(this.prefix, this.suffix.sel(i)); };
function Meta() { }
Meta.prototype.tokens = function() { return new Array("?"); };
Meta.prototype.toIndex = function() { return 0; };
Meta.prototype.sel = function(i) { return this; };
function Str(value) { this.value = value; }
Str.prototype.tokens = function() { return new Array(this.value); };
function Int(value) { this.value = value; }
Int.prototype.tokens = function() { return new Array(this.value.toString()); };
Int.prototype.toIndex = function() { return this.value; };
/* Type annotation */
function Abstract() {
this.types = new Array();
}
Abstract.prototype.addType = function(fun, args, cat) {
this.types[fun] = new Type(args, cat);
} ;
Abstract.prototype.annotate = function(tree, type) {
if (tree.name == '?') {
tree.type = type;
} else {
var typ = this.types[tree.name];
for (var i in tree.args) {
this.annotate(tree.args[i], typ.args[i]);
}
}
return tree;
} ;
/* Hack to get around the fact that our SISR doesn't build real Fun objects. */
Abstract.prototype.copyTree = function(x) {
var t = new Fun(x.name);
if (!isUndefined(x.type)) {
t.type = x.type;
}
var cs = x.args;
if (!isUndefined(cs)) {
for (var i in cs) {
t.setArg(i, this.copyTree(cs[i]));
}
}
return t;
} ;
Abstract.prototype.parseTree = function(str, type) {
return this.annotate(this.parseTree_(str.match(/[\w\']+|\(|\)|\?/g), 0), type);
} ;
Abstract.prototype.parseTree_ = function(tokens, prec) {
if (tokens.length == 0 || tokens[0] == ")") { return null; }
var t = tokens.shift();
if (t == "(") {
var tree = this.parseTree_(tokens, 0);
tokens.shift();
return tree;
} else if (t == '?') {
return new Fun('?');
} else {
var tree = new Fun(t);
if (prec == 0) {
var c, i;
for (i = 0; (c = this.parseTree_(tokens, 1)) !== null; i++) {
tree.setArg(i,c);
}
}
return tree;
}
} ;
function Type(args, cat) {
this.args = args;
this.cat = cat;
}
/* Linearization */
function Concrete(abstr) {
this.abstr = abstr;
this.rules = new Array();
}
Concrete.prototype.rule = function (name, cs) { return this.rules[name](cs); };
Concrete.prototype.addRule = function (name, f) { this.rules[name] = f; };
Concrete.prototype.lindef = function (cat, v) { return this.rules["_d"+cat]([new Str(v)]); } ;
Concrete.prototype.linearize = function (tree) {
return this.unlex(this.linearizeToTerm(tree).tokens());
};
Concrete.prototype.linearizeToTerm = function (tree) {
if (tree.isMeta()) {
if (isUndefined(tree.type)) {
return new Meta();
} else {
return this.lindef(tree.type, tree.name);
}
} else {
var cs = new Array();
for (var i in tree.args) {
cs.push(this.linearizeToTerm(tree.args[i]));
}
return this.rule(tree.name, cs);
}
};
Concrete.prototype.unlex = function (ts) {
if (ts.length == 0) {
return "";
}
var noSpaceAfter = /^[\(\-\[]/;
var noSpaceBefore = /^[\.\,\?\!\)\:\;\-\]]/;
var s = "";
for (var i = 0; i < ts.length; i++) {
var t = ts[i];
var after = i < ts.length-1 ? ts[i+1] : null;
s += t;
if (after != null && !t.match(noSpaceAfter)
&& !after.match(noSpaceBefore)) {
s += " ";
}
}
return s;
};
/* Utilities */
/* from Remedial JavaScript by Douglas Crockford, http://javascript.crockford.com/remedial.html */
function isString(a) { return typeof a == 'string'; }
function isArray(a) { return a && typeof a == 'object' && a.constructor == Array; }
function isUndefined(a) { return typeof a == 'undefined'; }
function isBoolean(a) { return typeof a == 'boolean'; }
function isNumber(a) { return typeof a == 'number' && isFinite(a); }
function isFunction(a) { return typeof a == 'function'; }
function dumpObject (obj) {
if (isUndefined(obj)) {
return "undefined";
} else if (isString(obj)) {
return '"' + obj.toString() + '"'; // FIXME: escape
} else if (isBoolean(obj) || isNumber(obj)) {
return obj.toString();
} else if (isArray(obj)) {
var x = "[";
for (var i in obj) {
x += dumpObject(obj[i]);
if (i < obj.length-1) {
x += ",";
}
}
return x + "]";
} else {
var x = "{";
for (var y in obj) {
x += y + "=" + dumpObject(obj[y]) + ";" ;
}
return x + "}";
}
}
function copy_arguments(args, start) {
var arr = new Array();
for (var i = 0; i < args.length - start; i++) {
arr[i] = args[i + start];
}
return arr;
}

79
devel/phrases/index.html
View File

@@ -1,79 +0,0 @@
<!DOCTYPE html
PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head>
<title>English-Thai Phrase Translator</title>
<link href="style.css" rel="stylesheet" type="text/css"></link>
<script type="text/javascript" src="flash-controls.js"></script>
</head>
<body>
<h1>English-Thai Phrase Translator</h1>
<p>This document describes the
<a href="pizza.xml">GF XHTML+Voice English-Thai Phrase Translator</a>,
a demonstration of
<a href="http://www.voicexml.org/specs/multimodal/x+v/12/">XHTML+Voice</a>
dialog system generated from a
<a href="http://www.cs.chalmers.se/~aarne/GF/">Grammatical Framework</a> grammar.
For a more detailed explanation of how this generation is done,
see the article <a href="http://www.cs.chalmers.se/~bringert/publ/gf-voicexml/gf-voicexml.pdf">Generating Dialog Systems from Grammars</a>.
This demo was built by reusing code and ideas from Björn Bringert's
<a href="http://www.cs.chalmers.se/~bringert/xv/pizza/">Pizza Demo</a>.
</p>
<h2>Try the demo</h2>
<p>You can <a href="pizza.xml">try the demo</a> if you
have a web browser which can handle
<a href="http://www.voicexml.org/specs/multimodal/x+v/12/">XHTML+Voice</a>
and
<a href="http://www.w3.org/Graphics/SVG/">SVG</a>.
Currently this only includes
<a href="http://www.opera.com/download/">Opera</a> for Windows (when voice controlled
browsing is enabled). See
<a href="http://www.opera.com/support/tutorials/voice/using/">Using Opera with Voice</a>
for more information.</p>
<p>There is a slightly simpler version of the demo which also works
on the Opera multimodal browser for the Sharp Zaurus. It will be added here shortly.</p>
<h2>Functionality</h2>
<h2>References</h2>
<ul>
<li><a href="http://www.cs.chalmers.se/~aarne/GF/">Grammatical Framework</a>.</li>
<li><a href="http://www.cs.chalmers.se/~bringert/publ/gf-voicexml/gf-voicexml.pdf">Generating Dialog Systems from Grammars</a>, Bj&ouml;rn Bringert, 2007. Submitted to <a href="http://ufal.mff.cuni.cz/acl2007/">ACL 2007</a>.</li>
<li><a href="http://www.voicexml.org/specs/multimodal/x+v/12/">XHTML+Voice Profile 1.2</a>, VoiceXML Forum.</li>
<li><a href="http://dev.opera.com/articles/voice/">Voice - Opera Developer Community</a>, Opera Software ASA.</li>
<li><a href="http://www.w3.org/TR/voicexml20/">Voice Extensible Markup Language (VoiceXML) Version 2.0</a>.</li>
<li><a href="http://www.w3.org/TR/speech-grammar/">Speech Recognition Grammar Specification (SRGS)</a>, W3C Recommendation.
GF can generate SRGS grammars in both the XML and ABNF forms, and Opera
supports both formats.</li>
<li><a href="http://www.w3.org/TR/jsgf/">JSpeech Grammar Format (JSGF)</a>, W3C Note.
GF can also generate JSGF grammars, and Opera supports them.</li>
<li><a href="http://www.w3.org/TR/semantic-interpretation/">Semantic Interpretation for Speech Recognition (SISR) Version 1.0</a>,
W3C Proposed Recommendation.
The version supported by Opera appears to be
<a href="http://www.w3.org/TR/2003/WD-semantic-interpretation-20030401/">SISR - W3C Working Draft 1 April 2003</a>.</li>
</ul>
<address><a href="http://www.cs.chalmers.se/~aarne/">Aarne Ranta</a>,
<a href="mailto:bringert@cs.chalmers.se">aarne@cs.chalmers.se</a>.</address>
</body>
</html>

49
devel/phrases/order-simple.js
View File

@@ -1,49 +0,0 @@
var currentOrder = new Fun("?");
var talkText;
function say(text) {
talkText = text;
activateForm("talker");
}
function newOrder() {
currentOrder = new Fun("?");
document.getElementById("top_abs").value = "";
document.getElementById("top_img").value = "";
document.getElementById("ordertext").value = "";
return getOrder();
}
function getOrder() {
activateForm("getorder");
return true;
}
function done(input) {
currentOrder = Pizza.copyTree(input, "Order");
document.getElementById("top_abs").value = currentOrder.print();
sayOrder();
}
function sayOrder() {
var eng = PizzaEng.linearize(currentOrder);
document.getElementById("ordertext").value = eng;
say("You have ordered " + eng);
}
/* XHTML+Voice Utilities */
function activateForm(formid) {
var form = document.getElementById(formid);
var e = document.createEvent("UIEvents");
e.initEvent("DOMActivate","true","true");
form.dispatchEvent(e);
}

70
devel/phrases/order.js
View File

@@ -1,70 +0,0 @@
var svgNS = "http://www.w3.org/2000/svg";
var currentOrder = new Fun("?");
var talkText;
function say(text) {
talkText = text;
activateForm("talker");
}
function newOrder() {
currentOrder = new Fun("?");
document.getElementById("in_abs").value = "";
setText(document.getElementById("ordertext"), "");
setText(document.getElementById("ordertextf"), "");
setText(document.getElementById("ordertextt"), "");
return getOrder();
}
function getOrder() {
activateForm("getorder");
return true;
}
function done(input) {
currentOrder = Travel.copyTree(input);
document.getElementById("in_abs").value = currentOrder.print();
sayOrder();
}
function sayOrder() {
var output = currentOrder;
var eng = TravelEng.linearize(output);
setText(document.getElementById("ordertext"), eng);
var fin = TravelTha.linearize(output).replace(/ /g,"");
setText(document.getElementById("ordertextf"), fin);
var tha = TravelThaiP.linearize(output);
setText(document.getElementById("ordertextt"), tha);
say(tha);
}
/* XHTML+Voice Utilities */
function activateForm(formid) {
var form = document.getElementById(formid);
var e = document.createEvent("UIEvents");
e.initEvent("DOMActivate","true","true");
form.dispatchEvent(e);
}
/* DOM utilities */
function removeChildren(node) {
while (node.hasChildNodes()) {
node.removeChild(node.firstChild);
}
}
function setText(node, text) {
removeChildren(node);
node.appendChild(document.createTextNode(text));
}

39
devel/phrases/pizza-movie-large.html
View File

@@ -1,39 +0,0 @@
<!DOCTYPE html
PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head>
<title>Pizza Demo - GF XHTML+Voice</title>
<link href="style.css" rel="stylesheet" type="text/css"></link>
<script type="text/javascript" src="flash-controls.js"></script>
</head>
<body>
<h1>Pizza Demo - GF XHTML+Voice</h1>
<p>This is a demo of a dialog system built with GF and XHTML+Voice.
There is <a href="index.html">more information about this demo here</a>.</p>
<form class="flashControls">
<p>
<input type="button" onclick="flashPlay('pizzaSmall')" value="Play"/>
<input type="button" onclick="flashPause('pizzaSmall')" value="Pause"/>
</p>
</form>
<p>
<object id="pizzaLarge" classid="clsid:D27CDB6E-AE6D-11cf-96B8-444553540000" width="762" height="578"
codebase="http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0">
<param name="movie" value="pizza-movie-large.swf" />
<param name="play" value="false" />
<param name="loop" value="false" />
<param name="quality" value="autohigh" />
<embed id="pizzaLarge" name="pizzaLarge" src="pizza-movie-large.swf" width="762" height="578" play="false"
loop="false" quality="autohigh" type="application/x-shockwave-flash"
pluginspage="http://www.macromedia.com/go/getflashplayer">
</embed></object>
</p>
</body>
</html>

62
devel/phrases/pizza-simple.html
View File

@@ -1,62 +0,0 @@
<?xml version="1.0"?>
<!DOCTYPE html PUBLIC "-//VoiceXML Forum//DTD XHTML+Voice 1.2//EN" "http://www.voicexml.org/specs/multimodal/x+v/12/dtd/xhtml+voice12.dtd">
<html xmlns="http://www.w3.org/1999/xhtml"
xmlns:vxml="http://www.w3.org/2001/vxml"
xmlns:ev="http://www.w3.org/2001/xml-events"
xmlns:xv="http://www.voicexml.org/2002/xhtml+voice"
xml:lang="en-US">
<head>
<title>Order a Pizza</title>
<script type="text/javascript" src="gflib.js"></script>
<script type="text/javascript" src="pizza-simple.js"></script>
<script type="text/javascript" src="order-simple.js"></script>
<vxml:form id="talker">
<vxml:block>
<vxml:value expr="talkText"/>
</vxml:block>
</vxml:form>
<vxml:form id="getorder">
<vxml:var name="dummy" />
<vxml:subdialog name="sub" src="Pizza.vxml#Order_cat">
<vxml:param name="old" expr="currentOrder" />
<vxml:filled>
<vxml:assign name="dummy" expr="done(sub.term)"/>
</vxml:filled>
</vxml:subdialog>
</vxml:form>
</head>
<body>
<p><button onclick="newOrder()">I want to say a phrase</button></p>
<div class="box">
<form>
<input type="text" id="ordertext" size="100" style="width:100%" />
</form>
</div>
<div class="box">
<form>
<input type="text" id="ordertextf" size="100" style="width:100%" />
</form>
<form>
<input type="text" id="ordertextt" size="100" style="width:100%" />
</form>
</div>
<div class="box">
<form>
<p>
Current order state<br />
<input type="text" id="top_img" size="70" /><br />
<textarea id="top_abs" rows="4" cols="52"></textarea>
</p>
</form>
</div>
</body>
</html>

73
devel/phrases/pizza.xml
View File

@@ -1,73 +0,0 @@
<!DOCTYPE html PUBLIC "-//VoiceXML Forum//DTD XHTML+Voice 1.2//EN" "http://www.voicexml.org/specs/multimodal/x+v/12/dtd/xhtml+voice12.dtd">
<html xmlns="http://www.w3.org/1999/xhtml"
xmlns:ev="http://www.w3.org/2001/xml-events"
xmlns:xv="http://www.voicexml.org/2002/xhtml+voice"
xmlns:vxml="http://www.w3.org/2001/vxml">
<head>
<title>Say Phrases in Thai</title>
<meta http-equiv="content-type" content="text/xml; charset=utf-8" />
<link href="style.css" rel="stylesheet" type="text/css"></link>
<script type="text/javascript" src="gflib.js"></script>
<script type="text/javascript" src="Travel.js"></script>
<script type="text/javascript" src="order.js"></script>
<vxml:form id="talker">
<vxml:block>
<vxml:value expr="talkText"/>
</vxml:block>
</vxml:form>
<vxml:form id="getorder">
<vxml:var name="dummy" />
<vxml:subdialog name="sub" src="TravelEng.vxml#Order_cat">
<vxml:param name="old" expr="currentOrder" />
<vxml:filled>
<vxml:assign name="dummy" expr="done(sub.term)"/>
</vxml:filled>
</vxml:subdialog>
</vxml:form>
</head>
<body>
<div><img src="images/logo.png" width="246" height="92" /></div>
<div><p>This demo requires an XHTML+Voice browser.
<a href="index.html">More information about this demo</a>.</p></div>
<p><button onclick="newOrder()">I want to say my order</button></p>
<div class="box">
<p id="ordertext"></p>
<p id="ordertextf"></p>
<p id="ordertextt"></p>
<p><object id="order" data="images/order.svg" width="700" height="200"></object></p>
</div>
<div class="box">
<form>
<textarea id="in_abs" rows="4" cols="52"></textarea>
<textarea id="out_abs" rows="4" cols="52"></textarea>
</form>
</div>
<!-- SVG "sprites" -->
<object id="pizza" data="images/pizza.svg" width="0" height="0"></object>
<object id="ham" data="images/ham.svg" width="0" height="0"></object>
<object id="cheese" data="images/cheese.svg" width="0" height="0"></object>
<object id="pepperoni" data="images/pepperoni.svg" width="0" height="0"></object>
<object id="anchovies" data="images/anchovies.svg" width="0" height="0"></object>
<object id="beer" data="images/beer.svg" width="0" height="0"></object>
<object id="coke" data="images/coke.svg" width="0" height="0"></object>
</body>
</html>

73
devel/phrases/travel.xml
View File

@@ -1,73 +0,0 @@
<!DOCTYPE html PUBLIC "-//VoiceXML Forum//DTD XHTML+Voice 1.2//EN" "http://www.voicexml.org/specs/multimodal/x+v/12/dtd/xhtml+voice12.dtd">
<html xmlns="http://www.w3.org/1999/xhtml"
xmlns:ev="http://www.w3.org/2001/xml-events"
xmlns:xv="http://www.voicexml.org/2002/xhtml+voice"
xmlns:vxml="http://www.w3.org/2001/vxml">
<head>
<title>Say Phrases in Thai</title>
<meta http-equiv="content-type" content="text/xml; charset=utf-8" />
<link href="style.css" rel="stylesheet" type="text/css"></link>
<script type="text/javascript" src="gflib.js"></script>
<script type="text/javascript" src="Travel.js"></script>
<script type="text/javascript" src="order.js"></script>
<vxml:form id="talker">
<vxml:block>
<vxml:value expr="talkText"/>
</vxml:block>
</vxml:form>
<vxml:form id="getorder">
<vxml:var name="dummy" />
<vxml:subdialog name="sub" src="TravelEng.vxml#Order_cat">
<vxml:param name="old" expr="currentOrder" />
<vxml:filled>
<vxml:assign name="dummy" expr="done(sub.term)"/>
</vxml:filled>
</vxml:subdialog>
</vxml:form>
</head>
<body>
<div><font size="+5">ภาษาไทยแปลว่าอะไร</font></div>
<div><p>This demo requires an XHTML+Voice browser.
<a href="index.html">More information about this demo</a>.</p></div>
<p><button onclick="newOrder()">Push here to say a phrase</button></p>
<div class="box">
<p id="ordertext"></p>
<font size="+3">
<p id="ordertextf"></p>
<p id="ordertextt"></p>
</font>
<p><object id="order" data="images/order.svg" width="700" height="200"></object></p>
</div>
<div class="box">
<form>
<textarea id="in_abs" rows="4" cols="52"></textarea>
</form>
</div>
<!-- SVG "sprites" -->
<object id="pizza" data="images/pizza.svg" width="0" height="0"></object>
<object id="ham" data="images/ham.svg" width="0" height="0"></object>
<object id="cheese" data="images/cheese.svg" width="0" height="0"></object>
<object id="pepperoni" data="images/pepperoni.svg" width="0" height="0"></object>
<object id="anchovies" data="images/anchovies.svg" width="0" height="0"></object>
<object id="beer" data="images/beer.svg" width="0" height="0"></object>
<object id="coke" data="images/coke.svg" width="0" height="0"></object>
</body>
</html>

35
index-3.html → index.html
View File

@@ -20,26 +20,23 @@ Version 3.0
June 2008
</P>
<P>
</center>
</P>
<P>
<font size=+2>
</P>
<P>
<CODE>|</CODE> <A HREF="demos/">Demos</A>
<CODE>[</CODE> <A HREF="demos/">Demos</A>
<CODE>|</CODE> <A HREF="download">Download</A>
<CODE>|</CODE> <A HREF="lib/">Libraries</A>
<CODE>|</CODE> <A HREF="lib/resource/doc/synopsis.html">Libraries</A>
<CODE>|</CODE> <A HREF="doc/gf-refman.html">Reference</A>
<CODE>|</CODE> <A HREF="doc/gf-tutorial.html">Tutorial</A>
<CODE>|</CODE>
<CODE>]</CODE>
</P>
<P>
</font>
</P>
<P>
<CODE>|</CODE> <A HREF="demos/">Demos</A>
<CODE>[</CODE> <A HREF="demos/">Demos</A>
<CODE>|</CODE> <A HREF="download">Download</A>
<CODE>|</CODE> <A HREF="download">Development</A>
<CODE>|</CODE> <A HREF="doc/darcs.html">Developers</A>
<CODE>|</CODE> <A HREF="doc/events.html">Events</A>
<CODE>|</CODE> <A HREF="lib/">Libraries</A>
<CODE>|</CODE> <A HREF="doc/gf-people.html">People</A>
@@ -47,7 +44,10 @@ June 2008
<CODE>|</CODE> <A HREF="doc/gf-tutorial.html">Publications</A>
<CODE>|</CODE> <A HREF="doc/gf-refman.html">Reference</A>
<CODE>|</CODE> <A HREF="doc/gf-tutorial.html">Tutorial</A>
<CODE>|</CODE>
<CODE>]</CODE>
</P>
<P>
</center>
</P>
<P>
<font size=-1>
@@ -66,11 +66,16 @@ GF, Grammatical Framework, is a programming language for
<B>multilingual grammar applications</B>. It is
</P>
<UL>
<LI>a <B>special-purpose language for grammars</B>, like YACC, Bison, Happy, BNFC
<LI>a <B>functional language</B>, like Haskell, Lisp, OCaml, Scheme, SML
<LI>a <B>natural language processing framework</B>, like LKB, XLE, Regulus
<LI>a <B>categorial grammar formalism</B>, like ACG, CCG
<LI>a <B>logical framework</B>, like Agda, Coq, Isabelle
<LI>a <B>special-purpose language for grammars</B>, like YACC, Bison, Happy, BNFC,
but not restricted to programming languages
<LI>a <B>functional language</B>, like Haskell, Lisp, OCaml, Scheme, SML,
but specialized to grammar writing
<LI>a <B>natural language processing framework</B>, like LKB, XLE, Regulus,
but based on functional programming and type theory
<LI>a <B>categorial grammar formalism</B>, like ACG, CCG,
but different and equipped with different tools
<LI>a <B>logical framework</B>, like Agda, Coq, Isabelle,
but equipped with concrete syntax in addition to logic
</UL>
<P>
@@ -192,5 +197,5 @@ are welcome!
</P>
<!-- html code generated by txt2tags 2.4 (http://txt2tags.sf.net) -->
<!-- cmdline: txt2tags -thtml index-3.txt -->
<!-- cmdline: txt2tags -thtml index.txt -->
</BODY></HTML>

16
index-3.txt → index.txt
View File

@@ -18,22 +18,21 @@ Version 3.0
June 2008
#ENCE
#BELARGE
``|`` [Demos demos/]
``[`` [Demos demos/]
``|`` [Download download]
``|`` [Libraries lib/]
``|`` [Libraries lib/resource/doc/synopsis.html]
``|`` [Reference doc/gf-refman.html]
``|`` [Tutorial doc/gf-tutorial.html]
``|``
``]``
#ENLARGE
``|`` [Demos demos/]
``[`` [Demos demos/]
``|`` [Download download]
``|`` [Development download]
``|`` [Developers doc/darcs.html]
``|`` [Events doc/events.html]
``|`` [Libraries lib/]
``|`` [People doc/gf-people.html]
@@ -41,7 +40,10 @@ June 2008
``|`` [Publications doc/gf-tutorial.html]
``|`` [Reference doc/gf-refman.html]
``|`` [Tutorial doc/gf-tutorial.html]
``|``
``]``
#ENCE
#BESMALL