From a5300ad062b82154f3f9533e143ea35515e6c39e Mon Sep 17 00:00:00 2001 From: aarne Date: Tue, 11 Nov 2008 10:28:32 +0000 Subject: tutorial complete with server and js --- doc/food-js.png | Bin 0 -> 19002 bytes doc/food-magnet.png | Bin 0 -> 98845 bytes doc/gf-tutorial.html | 206 +++++++++++----------- doc/gf-tutorial.txt | 60 ++++++- doc/iphone.jpg | Bin 0 -> 17150 bytes examples/tutorial/old/semantics/Answer.hs | 21 +++ examples/tutorial/old/semantics/AnswerBase.hs | 90 ++++++++++ examples/tutorial/old/semantics/Base.gf | 60 +++++++ examples/tutorial/old/semantics/BaseEng.gf | 56 ++++++ examples/tutorial/old/semantics/BaseI.gf | 70 ++++++++ examples/tutorial/old/semantics/BaseIEng.gf | 8 + examples/tutorial/old/semantics/BaseSwe.gf | 8 + examples/tutorial/old/semantics/GSyntax.hs | 242 ++++++++++++++++++++++++++ examples/tutorial/old/semantics/LexBase.gf | 19 ++ examples/tutorial/old/semantics/LexBaseEng.gf | 20 +++ examples/tutorial/old/semantics/LexBaseSwe.gf | 22 +++ examples/tutorial/old/semantics/Logic.hs | 101 +++++++++++ examples/tutorial/old/semantics/SemBase.hs | 42 +++++ examples/tutorial/old/semantics/Top.hs | 23 +++ examples/tutorial/semantics/Answer.hs | 21 --- examples/tutorial/semantics/AnswerBase.hs | 90 ---------- examples/tutorial/semantics/Base.gf | 60 ------- examples/tutorial/semantics/BaseEng.gf | 56 ------ examples/tutorial/semantics/BaseI.gf | 70 -------- examples/tutorial/semantics/BaseIEng.gf | 8 - examples/tutorial/semantics/BaseSwe.gf | 8 - examples/tutorial/semantics/GSyntax.hs | 242 -------------------------- examples/tutorial/semantics/LexBase.gf | 19 -- examples/tutorial/semantics/LexBaseEng.gf | 20 --- examples/tutorial/semantics/LexBaseSwe.gf | 22 --- examples/tutorial/semantics/Logic.hs | 101 ----------- examples/tutorial/semantics/SemBase.hs | 42 ----- examples/tutorial/semantics/Top.hs | 23 --- 33 files changed, 941 insertions(+), 889 deletions(-) create mode 100644 doc/food-js.png create mode 100644 doc/food-magnet.png create mode 100644 doc/iphone.jpg create mode 100644 examples/tutorial/old/semantics/Answer.hs create mode 100644 examples/tutorial/old/semantics/AnswerBase.hs create mode 100644 examples/tutorial/old/semantics/Base.gf create mode 100644 examples/tutorial/old/semantics/BaseEng.gf create mode 100644 examples/tutorial/old/semantics/BaseI.gf create mode 100644 examples/tutorial/old/semantics/BaseIEng.gf create mode 100644 examples/tutorial/old/semantics/BaseSwe.gf create mode 100644 examples/tutorial/old/semantics/GSyntax.hs create mode 100644 examples/tutorial/old/semantics/LexBase.gf create mode 100644 examples/tutorial/old/semantics/LexBaseEng.gf create mode 100644 examples/tutorial/old/semantics/LexBaseSwe.gf create mode 100644 examples/tutorial/old/semantics/Logic.hs create mode 100644 examples/tutorial/old/semantics/SemBase.hs create mode 100644 examples/tutorial/old/semantics/Top.hs delete mode 100644 examples/tutorial/semantics/Answer.hs delete mode 100644 examples/tutorial/semantics/AnswerBase.hs delete mode 100644 examples/tutorial/semantics/Base.gf delete mode 100644 examples/tutorial/semantics/BaseEng.gf delete mode 100644 examples/tutorial/semantics/BaseI.gf delete mode 100644 examples/tutorial/semantics/BaseIEng.gf delete mode 100644 examples/tutorial/semantics/BaseSwe.gf delete mode 100644 examples/tutorial/semantics/GSyntax.hs delete mode 100644 examples/tutorial/semantics/LexBase.gf delete mode 100644 examples/tutorial/semantics/LexBaseEng.gf delete mode 100644 examples/tutorial/semantics/LexBaseSwe.gf delete mode 100644 examples/tutorial/semantics/Logic.hs delete mode 100644 examples/tutorial/semantics/SemBase.hs delete mode 100644 examples/tutorial/semantics/Top.hs diff --git a/doc/food-js.png b/doc/food-js.png new file mode 100644 index 000000000..fe579b1a9 Binary files /dev/null and b/doc/food-js.png differ diff --git a/doc/food-magnet.png b/doc/food-magnet.png new file mode 100644 index 000000000..8b137875d Binary files /dev/null and b/doc/food-magnet.png differ diff --git a/doc/gf-tutorial.html b/doc/gf-tutorial.html index fcf5683d4..18e353a23 100644 --- a/doc/gf-tutorial.html +++ b/doc/gf-tutorial.html @@ -238,19 +238,23 @@ Version 3.1.2, November 2008
  • Producing GFCC for the translator
  • A translator loop
  • A question-answer system -
  • Exporting GF datatypes to Haskell -
  • Example of exporting GF datatypes +
  • Abstract syntax of the query system +
  • Exporting GF datatypes to Haskell
  • The question-answer function
  • Converting between Haskell and GF trees
  • Putting it all together: the transfer definition
  • Putting it all together: the Main module
  • Putting it all together: the Makefile -
  • Translets: embedded translators in Java -
  • Dialogue systems in Java -
  • Language models for speech recognition +
  • Web server applications +
  • JavaScript applications +
  • Language models for speech recognition + @@ -5232,10 +5236,10 @@ point literals as arguments. Goals:

    @@ -5245,13 +5249,13 @@ Goals:

    Functionalities of an embedded grammar format

    GF grammars can be used as parts of programs written in other programming -languages. Haskell and Java. +languages, to be called host languages. This facility is based on several components:

    @@ -5264,23 +5268,13 @@ This facility is based on several components: The portable format is called PGF, "Portable Grammar Format".

    -A file can be produced in GF by the command -

    -
    -    > print_grammar | write_file FILE.pgf
-
    -

    -There is also a batch compiler, executable from the operative system shell: +This format is produced by the GF batch compiler gfc, +executable from the operative system shell: 

         % gfc --make SOURCE.gf

    -This applies to GF version 3 and upwards. Older GF used a format suffixed -.gfcm. -At the moment of writing, also the Java interpreter still uses the GFCM format. -

    -

    PGF is the recommended format in which final grammar products are distributed, because they are stripped from superfluous information and can be started and applied @@ -5456,50 +5450,60 @@ To reply in the same language as the question:

    +

    Abstract syntax of the query system

    +

    +Input: abstract syntax judgements +

    +
    +  abstract Query = {
+  
+    flags startcat=Question ;
+  
+    cat 
+      Answer ; Question ; Object ;
+  
+    fun 
+      Even   : Object -> Question ;
+      Odd    : Object -> Question ;
+      Prime  : Object -> Question ;
+      Number : Int -> Object ;
+  
+      Yes : Answer ;
+      No  : Answer ;
+  }
+
    +

    +

    + +

    +

    Exporting GF datatypes to Haskell

    To make it easy to define a transfer function, we export the abstract syntax to a system of Haskell datatypes: 

    -    % gfc --output-format=haskell Food.gfcc
+    % gfc --output-format=haskell Query.pgf

    It is also possible to produce the Haskell file together with GFCC, by 

    -    % gfc --make --output-format=haskell FoodEng.gf FoodIta.gf
+    % gfc --make --output-format=haskell QueryEng.gf

    -The result is a file named Food.hs, containing a -module named Food. +The result is a file named Query.hs, containing a +module named Query.

    - -

    Example of exporting GF datatypes

    -

    -Input: abstract syntax judgements -

    -
    -    cat 
-      Answer ; Question ; Object ;
-  
-    fun 
-      Even   : Object -> Question ;
-      Odd    : Object -> Question ;
-      Prime  : Object -> Question ;
-      Number : Int -> Object ;
-  
-      Yes : Answer ;
-      No  : Answer ;
-

    Output: Haskell definitions 

    -  newtype GInt = GInt Integer
+  module Query where
+  import PGF
   
   data GAnswer =
      GYes 
@@ -5511,6 +5515,8 @@ Output: Haskell definitions
      GPrime GObject 
    | GOdd GObject 
    | GEven GObject 
+  
+  newtype GInt = GInt Integer

    All type and constructor names are prefixed with a G to prevent clashes. @@ -5571,8 +5577,8 @@ For the programmer, it is enougo to know:

    @@ -5584,7 +5590,7 @@ For the programmer, it is enougo to know: module TransferDef where import PGF (Tree) - import Math -- generated from GF + import Query -- generated from GF transfer :: Tree -> Tree transfer = gf . answer . fg @@ -5625,7 +5631,7 @@ Here is the complete code in the Haskell file TransferLoop.hs. main :: IO () main = do - gr <- file2grammar "Math.pgf" + gr <- readPGF "Query.pgf" loop (translate transfer gr) loop :: (String -> String) -> IO () @@ -5636,7 +5642,7 @@ Here is the complete code in the Haskell file TransferLoop.hs. loop trans translate :: (Tree -> Tree) -> PGF -> String -> String - translate tr gr = case parseAllLang gr (startCat gr) s of + translate tr gr s = case parseAllLang gr (startCat gr) s of (lg,t:_):_ -> linearize gr lg (tr t) _ -> "NO PARSE" @@ -5651,7 +5657,7 @@ To automate the production of the system, we write a Makefile as fo 

       all:
-          gfc --make -haskell MathEng.gf MathFre.gf
+          gfc --make --output-format=haskell QueryEng
           ghc --make -o ./math TransferLoop.hs
           strip math
    @@ -5683,91 +5689,81 @@ Just to summarize, the source of the application consists of the following files

    -

    Translets: embedded translators in Java

    +

    Web server applications

    -NOTICE. Only for GF 2.9 and older at the moment. +PGF files can be used in web servers, for which there is a Haskell library included +in src/server/. How to build a server for tasks like translators is explained +in the README file in that directory.

    -A Java system needs many more files than a Haskell system. -To get started, fetch the package gfc2java from +One of the servers that can be readily built with the library (without any +programming required) is fridge poetry magnets. It is an application that +uses an incremental parser to suggest grammatically correct next words. Here +is an example of its application to the Foods grammars.

    -www.cs.chalmers.se/~bringert/darcs/gfc2java/ +

    -by using the Darcs version control system as described in this page. +

    + +

    JavaScript applications

    -The gfc2java package contains a script build-translet, which -can be applied -to any .gfcm file to create a translet, a small translation GUI. +JavaScript is a programming language that has interpreters built in in most +web browsers. It is therefore usable for client side web programs, which can even +be run without access to the internet. The following figure shows a JavaScript +program compiled from GF grammars as run on an iPhone.

    -For the Food -grammars of Lesson 2, we first create a file food.gfcm by +

    -
    -    % echo "pm | wf food.gfcm" | gf FoodEng.gf FoodIta.gf
-

    -and then run +

    -
    -    % build_translet food.gfcm
-
    + +

    Compiling to JavaScript

    -The resulting file translate-food.jar can be run with +JavaScript is one of the output formats of the GF batch compiler. Thus the following +command generates a JavaScript file from two Food grammars. 

    -    % java -jar translate-food.jar
+    % gfc --make --output-format=js FoodEng.gf FoodIta.gf

    -The translet looks like this: -

    -

    - +The name of the generated file is Food.js, derived from the top-most abstract +syntax name. This file contains the multilingual grammar as a JavaScript object.

    - -

    Dialogue systems in Java

    -

    -NOTICE. Only for GF 2.9 and older at the moment. -

    -

    -A question-answer system is a special case of a dialogue system, -where the user and -the computer communicate by writing or, even more properly, by speech. -The gf-java -homepage provides an example of a most simple dialogue system imaginable, -where two -the conversation has just two rules: -

    - - + +

    Using the JavaScript grammar

    -The conversation can be made in both English and Swedish; the user's initiative -decides which language the system replies in. Thus the structure is very similar -to the math program here. +To perform parsing and linearization, the run-time library +gflib.js is used. It is included in GF/lib/javascript/, together with +some other JavaScript and HTML files; these files can be used +as templates for building applications.

    -The GF and Java sources of the program can be -found in +An example of usage is +translator.html, +which is in fact initialized with +a pointer to the Food grammar, so that it provides translation between the English +and Italian grammars:

    -[www.cs.chalmers.se/~bringert/darcs/simpledemo http://www.cs.chalmers.se/~bringert/darcs/simpledemo] +

    -again accessible with the Darcs version control system. +The grammar must have the name grammar.js. The abstract syntax and start +category names in translator.html must match the ones in the grammar. +With these changes, the translator works for any multilingual GF grammar.

    - +

    Language models for speech recognition

    The standard way of using GF in speech recognition is by building @@ -5814,7 +5810,7 @@ Example: GSL generated from FoodsEng.gf.

    - +

    More speech recognition grammar formats

    Other formats available via the --output-format flag include: diff --git a/doc/gf-tutorial.txt b/doc/gf-tutorial.txt index c556cbe64..3cb22a3d4 100644 --- a/doc/gf-tutorial.txt +++ b/doc/gf-tutorial.txt @@ -4899,12 +4899,68 @@ Just to summarize, the source of the application consists of the following files #NEW -TODO: web server applications +==Web server applications== + +PGF files can be used in web servers, for which there is a Haskell library included +in ``src/server/``. How to build a server for tasks like translators is explained +in the [``README`` ../src/server/README] file in that directory. + +One of the servers that can be readily built with the library (without any +programming required) is **fridge poetry magnets**. It is an application that +uses an incremental parser to suggest grammatically correct next words. Here +is an example of its application to the ``Foods`` grammars. + +[food-magnet.png] + + +#NEW + +==JavaScript applications== + +JavaScript is a programming language that has interpreters built in in most +web browsers. It is therefore usable for client side web programs, which can even +be run without access to the internet. The following figure shows a JavaScript +program compiled from GF grammars as run on an iPhone. + +[iphone.jpg] #NEW -TODO: JavaScript applications +===Compiling to JavaScript=== + +JavaScript is one of the output formats of the GF batch compiler. Thus the following +command generates a JavaScript file from two ``Food`` grammars. +``` + % gfc --make --output-format=js FoodEng.gf FoodIta.gf +``` +The name of the generated file is ``Food.js``, derived from the top-most abstract +syntax name. This file contains the multilingual grammar as a JavaScript object. + + +#NEW + +===Using the JavaScript grammar=== + +To perform parsing and linearization, the run-time library +``gflib.js`` is used. It is included in ``GF/lib/javascript/``, together with +some other JavaScript and HTML files; these files can be used +as templates for building applications. + +An example of usage is +[``translator.html`` ../lib/javascript/translator.html], +which is in fact initialized with +a pointer to the Food grammar, so that it provides translation between the English +and Italian grammars: + +[food-js.png] + +The grammar must have the name ``grammar.js``. The abstract syntax and start +category names in ``translator.html`` must match the ones in the grammar. +With these changes, the translator works for any multilingual GF grammar. + + + #NEW diff --git a/doc/iphone.jpg b/doc/iphone.jpg new file mode 100644 index 000000000..d9e138b88 Binary files /dev/null and b/doc/iphone.jpg differ diff --git a/examples/tutorial/old/semantics/Answer.hs b/examples/tutorial/old/semantics/Answer.hs new file mode 100644 index 000000000..08a76c5f1 --- /dev/null +++ b/examples/tutorial/old/semantics/Answer.hs @@ -0,0 +1,21 @@ +module Main where + +import GSyntax +import AnswerBase +import GF.GFCC.API + +main :: IO () +main = do + gr <- file2grammar "base.gfcc" + loop gr + +loop :: MultiGrammar -> IO () +loop gr = do + s <- getLine + case parse gr "BaseEng" "Question" s of + [] -> putStrLn "no parse" + ts -> mapM_ answer ts + loop gr + where + answer t = putStrLn $ linearize gr "BaseEng" $ gf $ question2answer $ fg t + diff --git a/examples/tutorial/old/semantics/AnswerBase.hs b/examples/tutorial/old/semantics/AnswerBase.hs new file mode 100644 index 000000000..56e2b5451 --- /dev/null +++ b/examples/tutorial/old/semantics/AnswerBase.hs @@ -0,0 +1,90 @@ +module AnswerBase where + +import GSyntax + +-- interpretation of Base + +type Prop = Bool +type Ent = Int +domain = [0 .. 100] + +iS :: GS -> Prop +iS s = case s of + GPredAP np ap -> iNP np (iAP ap) + +iNP :: GNP -> (Ent -> Prop) -> Prop +iNP np p = case np of + GEvery cn -> all (\x -> not (iCN cn x) || p x) domain + GSome cn -> any (\x -> iCN cn x && p x) domain + GNone -> not (any (\x -> p x) domain) + GMany pns -> and (map p (iListPN pns)) + GConjNP c np1 np2 -> iConj c (iNP np1 p) (iNP np2 p) + GUsePN a -> p (iPN a) + +iPN :: GPN -> Ent +iPN pn = case pn of + GUseInt i -> iInt i + GSum pns -> sum (iListPN pns) + GProduct pns -> product (iListPN pns) + GGCD pns -> foldl1 gcd (iListPN pns) + +iAP :: GAP -> Ent -> Prop +iAP ap e = case ap of + GComplA2 a2 np -> iNP np (iA2 a2 e) + GConjAP c ap1 ap2 -> iConj c (iAP ap1 e) (iAP ap2 e) + GEven -> even e + GOdd -> odd e + GPrime -> prime e + +iCN :: GCN -> Ent -> Prop +iCN cn e = case cn of + GModCN ap cn0 -> (iCN cn0 e) && (iAP ap e) + GNumber -> True + +iConj :: GConj -> Prop -> Prop -> Prop +iConj c = case c of + GAnd -> (&&) + GOr -> (||) + +iA2 :: GA2 -> Ent -> Ent -> Prop +iA2 a2 e1 e2 = case a2 of + GGreater -> e1 > e2 + GSmaller -> e1 < e2 + GEqual -> e1 == e2 + GDivisible -> e2 /= 0 && mod e1 e2 == 0 + +iListPN :: GListPN -> [Ent] +iListPN gls = case gls of + GListPN pns -> map iPN pns + +iInt :: GInt -> Ent +iInt gi = case gi of + GInt i -> fromInteger i + +-- questions and answers + +iQuestion :: GQuestion -> Either Bool [Ent] +iQuestion q = case q of + GWhatIs pn -> Right [iPN pn] -- computes the value + GWhichAre cn ap -> Right [e | e <- domain, iCN cn e, iAP ap e] + GQuestS s -> Left (iS s) + +question2answer :: GQuestion -> GAnswer +question2answer q = case iQuestion q of + Left True -> GYes + Left False -> GNo + Right [] -> GValue GNone + Right [v] -> GValue (GUsePN (ent2pn v)) + Right vs -> GValue (GMany (GListPN (map ent2pn vs))) + +ent2pn :: Ent -> GPN +ent2pn e = GUseInt (GInt (toInteger e)) + + +-- auxiliary + +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/old/semantics/Base.gf b/examples/tutorial/old/semantics/Base.gf new file mode 100644 index 000000000..85868d7ac --- /dev/null +++ b/examples/tutorial/old/semantics/Base.gf @@ -0,0 +1,60 @@ +-- abstract syntax of a query language + +abstract Base = { + +cat + S ; + NP ; + PN ; + CN ; + AP ; + A2 ; + Conj ; +fun + +-- sentence syntax + PredAP : NP -> AP -> S ; + + ComplA2 : A2 -> NP -> AP ; + + ModCN : AP -> CN -> CN ; + + ConjAP : Conj -> AP -> AP -> AP ; + ConjNP : Conj -> NP -> NP -> NP ; + + UsePN : PN -> NP ; + Every : CN -> NP ; + Some : CN -> NP ; + + And, Or : Conj ; + +-- lexicon + + UseInt : Int -> PN ; + + Number : CN ; + Even, Odd, Prime : AP ; + Equal, Greater, Smaller, Divisible : A2 ; + + Sum, Product, GCD : ListPN -> PN ; + +-- adding questions + +cat + Question ; + Answer ; + ListPN ; +fun + WhatIs : PN -> Question ; + WhichAre : CN -> AP -> Question ; + QuestS : S -> Question ; + + Yes : Answer ; + No : Answer ; + Value : NP -> Answer ; + + None : NP ; + Many : ListPN -> NP ; + BasePN : PN -> PN -> ListPN ; + ConsPN : PN -> ListPN -> ListPN ; +} diff --git a/examples/tutorial/old/semantics/BaseEng.gf b/examples/tutorial/old/semantics/BaseEng.gf new file mode 100644 index 000000000..bd79bc98c --- /dev/null +++ b/examples/tutorial/old/semantics/BaseEng.gf @@ -0,0 +1,56 @@ +--# -path=.:prelude + +concrete BaseEng of Base = open Prelude in { + +flags lexer=literals ; unlexer=text ; + +-- English concrete syntax; greatly simplified - just for demo purposes + +lin + PredAP = infixSS "is" ; + + ComplA2 = cc2 ; + + ModCN = cc2 ; + + ConjAP c = infixSS c.s ; + ConjNP c = infixSS c.s ; + + UsePN a = a ; + Every = prefixSS "every" ; + Some = prefixSS "some" ; + + And = ss "and" ; + Or = ss "or" ; + + UseInt n = n ; + + Number = ss "number" ; + + Even = ss "even" ; + Odd = ss "odd" ; + Prime = ss "prime" ; + Equal = ss ("equal" ++ "to") ; + Greater = ss ("greater" ++ "than") ; + Smaller = ss ("smaller" ++ "than") ; + Divisible = ss ("divisible" ++ "by") ; + + Sum = prefixSS ["the sum of"] ; + Product = prefixSS ["the product of"] ; + GCD = prefixSS ["the greatest common divisor of"] ; + + WhatIs = prefixSS ["what is"] ; + WhichAre cn ap = ss ("which" ++ cn.s ++ "is" ++ ap.s) ; ---- are + QuestS s = s ; ---- inversion + + Yes = ss "yes" ; + No = ss "no" ; + + Value np = np ; + None = ss "none" ; + Many list = list ; + + BasePN = infixSS "and" ; + ConsPN = infixSS "," ; + +} diff --git a/examples/tutorial/old/semantics/BaseI.gf b/examples/tutorial/old/semantics/BaseI.gf new file mode 100644 index 000000000..b7ed86666 --- /dev/null +++ b/examples/tutorial/old/semantics/BaseI.gf @@ -0,0 +1,70 @@ +incomplete concrete BaseI of Base = + open Syntax, (G = Grammar), Symbolic, LexBase in { + +flags lexer=literals ; unlexer=text ; + +lincat + Question = G.Phr ; + Answer = G.Phr ; + S = G.Cl ; + NP = G.NP ; + PN = G.NP ; + CN = G.CN ; + AP = G.AP ; + A2 = G.A2 ; + Conj = G.Conj ; + ListPN = G.ListNP ; + +lin + PredAP = mkCl ; + + ComplA2 = mkAP ; + + ModCN = mkCN ; + + ConjAP = mkAP ; + ConjNP = mkNP ; + + UsePN p = p ; + Every = mkNP every_Det ; + Some = mkNP someSg_Det ; + + And = and_Conj ; + Or = or_Conj ; + + UseInt i = symb (i ** {lock_Int = <>}) ; ---- terrible to need this + + Number = mkCN number_N ; + + Even = mkAP even_A ; + Odd = mkAP odd_A ; + Prime = mkAP prime_A ; + Equal = equal_A2 ; + Greater = greater_A2 ; + Smaller = smaller_A2 ; + Divisible = divisible_A2 ; + + Sum = prefix sum_N2 ; + Product = prefix product_N2 ; + GCD nps = mkNP (mkDet DefArt (mkOrd great_A)) + (mkCN common_A (mkCN divisor_N2 (mkNP and_Conj nps))) ; + + WhatIs np = mkPhr (mkQS (mkQCl whatSg_IP (mkVP np))) ; + WhichAre cn ap = mkPhr (mkQS (mkQCl (mkIP which_IQuant cn) (mkVP ap))) ; + QuestS s = mkPhr (mkQS (mkQCl s)) ; + + Yes = mkPhr yes_Utt ; + No = mkPhr no_Utt ; + + Value np = mkPhr (mkUtt np) ; + Many list = mkNP and_Conj list ; + None = none_NP ; + + BasePN = G.BaseNP ; + ConsPN = G.ConsNP ; + +oper + prefix : G.N2 -> G.ListNP -> G.NP = \n2,nps -> + mkNP DefArt (mkCN n2 (mkNP and_Conj nps)) ; + +} diff --git a/examples/tutorial/old/semantics/BaseIEng.gf b/examples/tutorial/old/semantics/BaseIEng.gf new file mode 100644 index 000000000..a73bd44c6 --- /dev/null +++ b/examples/tutorial/old/semantics/BaseIEng.gf @@ -0,0 +1,8 @@ +--# -path=.:prelude:present:api:mathematical + +concrete BaseIEng of Base = BaseI with + (Syntax = SyntaxEng), + (Grammar = GrammarEng), + (G = GrammarEng), + (Symbolic = SymbolicEng), + (LexBase = LexBaseEng) ; diff --git a/examples/tutorial/old/semantics/BaseSwe.gf b/examples/tutorial/old/semantics/BaseSwe.gf new file mode 100644 index 000000000..6329c1c9c --- /dev/null +++ b/examples/tutorial/old/semantics/BaseSwe.gf @@ -0,0 +1,8 @@ +--# -path=.:prelude:present:api:mathematical + +concrete BaseSwe of Base = BaseI with + (Syntax = SyntaxSwe), + (Grammar = GrammarSwe), + (G = GrammarSwe), + (Symbolic = SymbolicSwe), + (LexBase = LexBaseSwe) ; diff --git a/examples/tutorial/old/semantics/GSyntax.hs b/examples/tutorial/old/semantics/GSyntax.hs new file mode 100644 index 000000000..6c67e40aa --- /dev/null +++ b/examples/tutorial/old/semantics/GSyntax.hs @@ -0,0 +1,242 @@ +module GSyntax where + +import GF.GFCC.DataGFCC +import GF.GFCC.AbsGFCC +---------------------------------------------------- +-- automatic translation from GF to Haskell +---------------------------------------------------- + +class Gf a where gf :: a -> Exp +class Fg a where fg :: Exp -> a + +newtype GString = GString String deriving Show + +instance Gf GString where + gf (GString s) = DTr [] (AS s) [] + +instance Fg GString where + fg t = + case t of + DTr [] (AS s) [] -> GString s + _ -> error ("no GString " ++ show t) + +newtype GInt = GInt Integer deriving Show + +instance Gf GInt where + gf (GInt s) = DTr [] (AI s) [] + +instance Fg GInt where + fg t = + case t of + DTr [] (AI s) [] -> GInt s + _ -> error ("no GInt " ++ show t) + +newtype GFloat = GFloat Double deriving Show + +instance Gf GFloat where + gf (GFloat s) = DTr [] (AF s) [] + +instance Fg GFloat where + fg t = + case t of + DTr [] (AF s) [] -> GFloat s + _ -> error ("no GFloat " ++ show t) + +---------------------------------------------------- +-- below this line machine-generated +---------------------------------------------------- + +data GA2 = + GDivisible + | GEqual + | GGreater + | GSmaller + deriving Show + +data GAP = + GComplA2 GA2 GNP + | GConjAP GConj GAP GAP + | GEven + | GOdd + | GPrime + deriving Show + +data GAnswer = + GNo + | GValue GNP + | GYes + deriving Show + +data GCN = + GModCN GAP GCN + | GNumber + deriving Show + +data GConj = + GAnd + | GOr + deriving Show + +newtype GListPN = GListPN [GPN] deriving Show + +data GNP = + GConjNP GConj GNP GNP + | GEvery GCN + | GMany GListPN + | GNone + | GSome GCN + | GUsePN GPN + deriving Show + +data GPN = + GGCD GListPN + | GProduct GListPN + | GSum GListPN + | GUseInt GInt + deriving Show + +data GQuestion = + GQuestS GS + | GWhatIs GPN + | GWhichAre GCN GAP + deriving Show + +data GS = GPredAP GNP GAP + deriving Show + + +instance Gf GA2 where + gf GDivisible = DTr [] (AC (CId "Divisible")) [] + gf GEqual = DTr [] (AC (CId "Equal")) [] + gf GGreater = DTr [] (AC (CId "Greater")) [] + gf GSmaller = DTr [] (AC (CId "Smaller")) [] + +instance Gf GAP where + gf (GComplA2 x1 x2) = DTr [] (AC (CId "ComplA2")) [gf x1, gf x2] + gf (GConjAP x1 x2 x3) = DTr [] (AC (CId "ConjAP")) [gf x1, gf x2, gf x3] + gf GEven = DTr [] (AC (CId "Even")) [] + gf GOdd = DTr [] (AC (CId "Odd")) [] + gf GPrime = DTr [] (AC (CId "Prime")) [] + +instance Gf GAnswer where + gf GNo = DTr [] (AC (CId "No")) [] + gf (GValue x1) = DTr [] (AC (CId "Value")) [gf x1] + gf GYes = DTr [] (AC (CId "Yes")) [] + +instance Gf GCN where + gf (GModCN x1 x2) = DTr [] (AC (CId "ModCN")) [gf x1, gf x2] + gf GNumber = DTr [] (AC (CId "Number")) [] + +instance Gf GConj where + gf GAnd = DTr [] (AC (CId "And")) [] + gf GOr = DTr [] (AC (CId "Or")) [] + +instance Gf GListPN where + gf (GListPN [x1,x2]) = DTr [] (AC (CId "BasePN")) [gf x1, gf x2] + gf (GListPN (x:xs)) = DTr [] (AC (CId "ConsPN")) [gf x, gf (GListPN xs)] + +instance Gf GNP where + gf (GConjNP x1 x2 x3) = DTr [] (AC (CId "ConjNP")) [gf x1, gf x2, gf x3] + gf (GEvery x1) = DTr [] (AC (CId "Every")) [gf x1] + gf (GMany x1) = DTr [] (AC (CId "Many")) [gf x1] + gf GNone = DTr [] (AC (CId "None")) [] + gf (GSome x1) = DTr [] (AC (CId "Some")) [gf x1] + gf (GUsePN x1) = DTr [] (AC (CId "UsePN")) [gf x1] + +instance Gf GPN where + gf (GGCD x1) = DTr [] (AC (CId "GCD")) [gf x1] + gf (GProduct x1) = DTr [] (AC (CId "Product")) [gf x1] + gf (GSum x1) = DTr [] (AC (CId "Sum")) [gf x1] + gf (GUseInt x1) = DTr [] (AC (CId "UseInt")) [gf x1] + +instance Gf GQuestion where + gf (GQuestS x1) = DTr [] (AC (CId "QuestS")) [gf x1] + gf (GWhatIs x1) = DTr [] (AC (CId "WhatIs")) [gf x1] + gf (GWhichAre x1 x2) = DTr [] (AC (CId "WhichAre")) [gf x1, gf x2] + +instance Gf GS where gf (GPredAP x1 x2) = DTr [] (AC (CId "PredAP")) [gf x1, gf x2] + + +instance Fg GA2 where + fg t = + case t of + DTr [] (AC (CId "Divisible")) [] -> GDivisible + DTr [] (AC (CId "Equal")) [] -> GEqual + DTr [] (AC (CId "Greater")) [] -> GGreater + DTr [] (AC (CId "Smaller")) [] -> GSmaller + _ -> error ("no A2 " ++ show t) + +instance Fg GAP where + fg t = + case t of + DTr [] (AC (CId "ComplA2")) [x1,x2] -> GComplA2 (fg x1) (fg x2) + DTr [] (AC (CId "ConjAP")) [x1,x2,x3] -> GConjAP (fg x1) (fg x2) (fg x3) + DTr [] (AC (CId "Even")) [] -> GEven + DTr [] (AC (CId "Odd")) [] -> GOdd + DTr [] (AC (CId "Prime")) [] -> GPrime + _ -> error ("no AP " ++ show t) + +instance Fg GAnswer where + fg t = + case t of + DTr [] (AC (CId "No")) [] -> GNo + DTr [] (AC (CId "Value")) [x1] -> GValue (fg x1) + DTr [] (AC (CId "Yes")) [] -> GYes + _ -> error ("no Answer " ++ show t) + +instance Fg GCN where + fg t = + case t of + DTr [] (AC (CId "ModCN")) [x1,x2] -> GModCN (fg x1) (fg x2) + DTr [] (AC (CId "Number")) [] -> GNumber + _ -> error ("no CN " ++ show t) + +instance Fg GConj where + fg t = + case t of + DTr [] (AC (CId "And")) [] -> GAnd + DTr [] (AC (CId "Or")) [] -> GOr + _ -> error ("no Conj " ++ show t) + +instance Fg GListPN where + fg t = + case t of + DTr [] (AC (CId "BasePN")) [x1,x2] -> GListPN [fg x1, fg x2] + DTr [] (AC (CId "ConsPN")) [x1,x2] -> let GListPN xs = fg x2 in GListPN (fg x1:xs) + _ -> error ("no ListPN " ++ show t) + +instance Fg GNP where + fg t = + case t of + DTr [] (AC (CId "ConjNP")) [x1,x2,x3] -> GConjNP (fg x1) (fg x2) (fg x3) + DTr [] (AC (CId "Every")) [x1] -> GEvery (fg x1) + DTr [] (AC (CId "Many")) [x1] -> GMany (fg x1) + DTr [] (AC (CId "None")) [] -> GNone + DTr [] (AC (CId "Some")) [x1] -> GSome (fg x1) + DTr [] (AC (CId "UsePN")) [x1] -> GUsePN (fg x1) + _ -> error ("no NP " ++ show t) + +instance Fg GPN where + fg t = + case t of + DTr [] (AC (CId "GCD")) [x1] -> GGCD (fg x1) + DTr [] (AC (CId "Product")) [x1] -> GProduct (fg x1) + DTr [] (AC (CId "Sum")) [x1] -> GSum (fg x1) + DTr [] (AC (CId "UseInt")) [x1] -> GUseInt (fg x1) + _ -> error ("no PN " ++ show t) + +instance Fg GQuestion where + fg t = + case t of + DTr [] (AC (CId "QuestS")) [x1] -> GQuestS (fg x1) + DTr [] (AC (CId "WhatIs")) [x1] -> GWhatIs (fg x1) + DTr [] (AC (CId "WhichAre")) [x1,x2] -> GWhichAre (fg x1) (fg x2) + _ -> error ("no Question " ++ show t) + +instance Fg GS where + fg t = + case t of + DTr [] (AC (CId "PredAP")) [x1,x2] -> GPredAP (fg x1) (fg x2) + _ -> error ("no S " ++ show t) + + diff --git a/examples/tutorial/old/semantics/LexBase.gf b/examples/tutorial/old/semantics/LexBase.gf new file mode 100644 index 000000000..83713a35f --- /dev/null +++ b/examples/tutorial/old/semantics/LexBase.gf @@ -0,0 +1,19 @@ +interface LexBase = open Syntax in { + +oper + even_A : A ; + odd_A : A ; + prime_A : A ; + common_A : A ; + great_A : A ; + equal_A2 : A2 ; + greater_A2 : A2 ; + smaller_A2 : A2 ; + divisible_A2 : A2 ; + number_N : N ; + sum_N2 : N2 ; + product_N2 : N2 ; + divisor_N2 : N2 ; + + none_NP : NP ; --- +} diff --git a/examples/tutorial/old/semantics/LexBaseEng.gf b/examples/tutorial/old/semantics/LexBaseEng.gf new file mode 100644 index 000000000..aea3a838b --- /dev/null +++ b/examples/tutorial/old/semantics/LexBaseEng.gf @@ -0,0 +1,20 @@ +instance LexBaseEng of LexBase = open SyntaxEng, ParadigmsEng in { + +oper + even_A = mkA "even" ; + odd_A = mkA "odd" ; + prime_A = mkA "prime" ; + great_A = mkA "great" ; + common_A = mkA "common" ; + equal_A2 = mkA2 (mkA "equal") (mkPrep "to") ; + greater_A2 = mkA2 (mkA "greater") (mkPrep "than") ; --- + smaller_A2 = mkA2 (mkA "smaller") (mkPrep "than") ; --- + divisible_A2 = mkA2 (mkA "divisible") (mkPrep "by") ; + number_N = mkN "number" ; + sum_N2 = mkN2 (mkN "sum") (mkPrep "of") ; + product_N2 = mkN2 (mkN "product") (mkPrep "of") ; + divisor_N2 = mkN2 (mkN "divisor") (mkPrep "of") ; + + none_NP = mkNP (mkPN "none") ; --- + +} diff --git a/examples/tutorial/old/semantics/LexBaseSwe.gf b/examples/tutorial/old/semantics/LexBaseSwe.gf new file mode 100644 index 000000000..6ac1904aa --- /dev/null +++ b/examples/tutorial/old/semantics/LexBaseSwe.gf @@ -0,0 +1,22 @@ +instance LexBaseSwe of LexBase = open SyntaxSwe, ParadigmsSwe in { + +oper + even_A = mkA "jämn" ; + odd_A = invarA "udda" ; + prime_A = mkA "prim" ; + great_A = mkA "stor" "större" "störst" ; + common_A = mkA "gemensam" ; + equal_A2 = mkA2 (invarA "lika") (mkPrep "med") ; + greater_A2 = mkA2 (invarA "större") (mkPrep "än") ; --- + smaller_A2 = mkA2 (invarA "mindre") (mkPrep "än") ; --- + divisible_A2 = mkA2 (mkA "delbar") (mkPrep "med") ; + number_N = mkN "tal" "tal" ; + sum_N2 = mkN2 (mkN "summa") (mkPrep "av") ; + product_N2 = mkN2 (mkN "produkt") (mkPrep "av") ; + divisor_N2 = mkN2 (mkN "delare") (mkPrep "av") ; + + none_NP = mkNP (mkPN "inget" neutrum) ; --- + + invarA : Str -> A = \x -> mkA x x x x x ; --- + +} diff --git a/examples/tutorial/old/semantics/Logic.hs b/examples/tutorial/old/semantics/Logic.hs new file mode 100644 index 000000000..b5c615da5 --- /dev/null +++ b/examples/tutorial/old/semantics/Logic.hs @@ -0,0 +1,101 @@ +module Logic where + +data Prop = + Pred Ident [Exp] + | And Prop Prop + | Or Prop Prop + | If Prop Prop + | Not Prop + | All Prop + | Exist Prop + deriving Show + +data Exp = + App Ident [Exp] + | Var Int -- de Bruijn index + deriving Show + +type Ident = String + +data Model a = Model { + app :: Ident -> [a] -> a, + prd :: Ident -> [a] -> Bool, + dom :: [a] + } + +type Assignment a = [a] + +update :: a -> Assignment a -> Assignment a +update x assign = x : assign + +look :: Int -> Assignment a -> a +look i assign = assign !! i + +valExp :: Model a -> Assignment a -> Exp -> a +valExp model assign exp = case exp of + App f xs -> app model f (map (valExp model assign) xs) + Var i -> look i assign + +valProp :: Model a -> Assignment a -> Prop -> Bool +valProp model assign prop = case prop of + Pred f xs -> prd model f (map (valExp model assign) xs) + And a b -> v a && v b + Or a b -> v a || v b + If a b -> if v a then v b else True + Not a -> not (v a) + All p -> all (\x -> valProp model (update x assign) p) (dom model) + Exist p -> any (\x -> valProp model (update x assign) p) (dom model) + where + v = valProp model assign + +liftProp :: Int -> Prop -> Prop +liftProp i p = case p of + Pred f xs -> Pred f (map liftExp xs) + And a b -> And (lift a) (lift b) + Or a b -> Or (lift a) (lift b) + If a b -> If (lift a) (lift b) + Not a -> Not (lift a) + All p -> All (liftProp (i+1) p) + Exist p -> Exist (liftProp (i+1) p) + where + lift = liftProp i + liftExp e = case e of + App f xs -> App f (map liftExp xs) + Var j -> Var (j + i) + _ -> e + + +-- example: initial segments of integers + +intModel :: Int -> Model Int +intModel mx = Model { + app = \f xs -> case (f,xs) of + ("+",_) -> sum xs + (_,[]) -> read f, + prd = \f xs -> case (f,xs) of + ("E",[x]) -> even x + ("<",[x,y]) -> x < y + ("=",[x,y]) -> x == y + _ -> error "undefined val", + dom = [0 .. mx] + } + +exModel = intModel 100 + +ev x = Pred "E" [x] +lt x y = Pred "<" [x,y] +eq x y = Pred "=" [x,y] +int i = App (show i) [] + +ex1 :: Prop +ex1 = Exist (ev (Var 0)) + +ex2 :: Prop +ex2 = All (Exist (lt (Var 1) (Var 0))) + +ex3 :: Prop +ex3 = All (If (lt (Var 0) (int 100)) (Exist (lt (Var 1) (Var 0)))) + +ex4 :: Prop +ex4 = All (All (If (lt (Var 1) (Var 0)) (Not (lt (Var 0) (Var 1))))) + diff --git a/examples/tutorial/old/semantics/SemBase.hs b/examples/tutorial/old/semantics/SemBase.hs new file mode 100644 index 000000000..b682010e1 --- /dev/null +++ b/examples/tutorial/old/semantics/SemBase.hs @@ -0,0 +1,42 @@ +module SemBase where + +import Base +import Logic + +-- translation of Base syntax to Logic + +iS :: GS -> Prop +iS s = case s of + GPredAP np ap -> iNP np (iAP ap) + +iNP :: GNP -> (Exp -> Prop) -> Prop +iNP np p = case np of + GEvery cn -> All (If (iCN cn var) (liftProp 0 (p var))) ---- + GSome cn -> Exist (And (iCN cn var) (p var)) ---- + GConjNP c np1 np2 -> iConj c (iNP np1 p) (iNP np2 p) + GUseInt (GInt i) -> p (int i) + +iAP :: GAP -> Exp -> Prop +iAP ap e = case ap of + GComplA2 a2 np -> iNP np (iA2 a2 e) + GConjAP c ap1 ap2 -> iConj c (iAP ap1 e) (iAP ap2 e) + GEven -> ev e + GOdd -> Not (ev e) + +iCN :: GCN -> Exp -> Prop +iCN cn e = case cn of + GModCN ap cn0 -> And (iCN cn0 e) (iAP ap e) + GNumber -> eq e e + +iConj :: GConj -> Prop -> Prop -> Prop +iConj c = case c of + GAnd -> And + GOr -> Or + +iA2 :: GA2 -> Exp -> Exp -> Prop +iA2 a2 e1 e2 = case a2 of + GGreater -> lt e2 e1 + GSmaller -> lt e1 e2 + GEqual -> eq e1 e2 + +var = Var 0 diff --git a/examples/tutorial/old/semantics/Top.hs b/examples/tutorial/old/semantics/Top.hs new file mode 100644 index 000000000..51d5fbb99 --- /dev/null +++ b/examples/tutorial/old/semantics/Top.hs @@ -0,0 +1,23 @@ +module Main where + +import Base +import SemBase +import Logic +import PGF + +main :: IO () +main = do + gr <- file2grammar "Base.pgf" + loop gr + +loop :: PGF -> IO () +loop gr = do + s <- getLine + let t:_ = parse gr "BaseEng" "S" s + putStrLn $ showTree t + let p = iS $ fg t + putStrLn $ show p + let v = valProp exModel [] p + putStrLn $ show v + loop gr + diff --git a/examples/tutorial/semantics/Answer.hs b/examples/tutorial/semantics/Answer.hs deleted file mode 100644 index 08a76c5f1..000000000 --- a/examples/tutorial/semantics/Answer.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Main where - -import GSyntax -import AnswerBase -import GF.GFCC.API - -main :: IO () -main = do - gr <- file2grammar "base.gfcc" - loop gr - -loop :: MultiGrammar -> IO () -loop gr = do - s <- getLine - case parse gr "BaseEng" "Question" s of - [] -> putStrLn "no parse" - ts -> mapM_ answer ts - loop gr - where - answer t = putStrLn $ linearize gr "BaseEng" $ gf $ question2answer $ fg t - diff --git a/examples/tutorial/semantics/AnswerBase.hs b/examples/tutorial/semantics/AnswerBase.hs deleted file mode 100644 index 56e2b5451..000000000 --- a/examples/tutorial/semantics/AnswerBase.hs +++ /dev/null @@ -1,90 +0,0 @@ -module AnswerBase where - -import GSyntax - --- interpretation of Base - -type Prop = Bool -type Ent = Int -domain = [0 .. 100] - -iS :: GS -> Prop -iS s = case s of - GPredAP np ap -> iNP np (iAP ap) - -iNP :: GNP -> (Ent -> Prop) -> Prop -iNP np p = case np of - GEvery cn -> all (\x -> not (iCN cn x) || p x) domain - GSome cn -> any (\x -> iCN cn x && p x) domain - GNone -> not (any (\x -> p x) domain) - GMany pns -> and (map p (iListPN pns)) - GConjNP c np1 np2 -> iConj c (iNP np1 p) (iNP np2 p) - GUsePN a -> p (iPN a) - -iPN :: GPN -> Ent -iPN pn = case pn of - GUseInt i -> iInt i - GSum pns -> sum (iListPN pns) - GProduct pns -> product (iListPN pns) - GGCD pns -> foldl1 gcd (iListPN pns) - -iAP :: GAP -> Ent -> Prop -iAP ap e = case ap of - GComplA2 a2 np -> iNP np (iA2 a2 e) - GConjAP c ap1 ap2 -> iConj c (iAP ap1 e) (iAP ap2 e) - GEven -> even e - GOdd -> odd e - GPrime -> prime e - -iCN :: GCN -> Ent -> Prop -iCN cn e = case cn of - GModCN ap cn0 -> (iCN cn0 e) && (iAP ap e) - GNumber -> True - -iConj :: GConj -> Prop -> Prop -> Prop -iConj c = case c of - GAnd -> (&&) - GOr -> (||) - -iA2 :: GA2 -> Ent -> Ent -> Prop -iA2 a2 e1 e2 = case a2 of - GGreater -> e1 > e2 - GSmaller -> e1 < e2 - GEqual -> e1 == e2 - GDivisible -> e2 /= 0 && mod e1 e2 == 0 - -iListPN :: GListPN -> [Ent] -iListPN gls = case gls of - GListPN pns -> map iPN pns - -iInt :: GInt -> Ent -iInt gi = case gi of - GInt i -> fromInteger i - --- questions and answers - -iQuestion :: GQuestion -> Either Bool [Ent] -iQuestion q = case q of - GWhatIs pn -> Right [iPN pn] -- computes the value - GWhichAre cn ap -> Right [e | e <- domain, iCN cn e, iAP ap e] - GQuestS s -> Left (iS s) - -question2answer :: GQuestion -> GAnswer -question2answer q = case iQuestion q of - Left True -> GYes - Left False -> GNo - Right [] -> GValue GNone - Right [v] -> GValue (GUsePN (ent2pn v)) - Right vs -> GValue (GMany (GListPN (map ent2pn vs))) - -ent2pn :: Ent -> GPN -ent2pn e = GUseInt (GInt (toInteger e)) - - --- auxiliary - -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/semantics/Base.gf b/examples/tutorial/semantics/Base.gf deleted file mode 100644 index 85868d7ac..000000000 --- a/examples/tutorial/semantics/Base.gf +++ /dev/null @@ -1,60 +0,0 @@ --- abstract syntax of a query language - -abstract Base = { - -cat - S ; - NP ; - PN ; - CN ; - AP ; - A2 ; - Conj ; -fun - --- sentence syntax - PredAP : NP -> AP -> S ; - - ComplA2 : A2 -> NP -> AP ; - - ModCN : AP -> CN -> CN ; - - ConjAP : Conj -> AP -> AP -> AP ; - ConjNP : Conj -> NP -> NP -> NP ; - - UsePN : PN -> NP ; - Every : CN -> NP ; - Some : CN -> NP ; - - And, Or : Conj ; - --- lexicon - - UseInt : Int -> PN ; - - Number : CN ; - Even, Odd, Prime : AP ; - Equal, Greater, Smaller, Divisible : A2 ; - - Sum, Product, GCD : ListPN -> PN ; - --- adding questions - -cat - Question ; - Answer ; - ListPN ; -fun - WhatIs : PN -> Question ; - WhichAre : CN -> AP -> Question ; - QuestS : S -> Question ; - - Yes : Answer ; - No : Answer ; - Value : NP -> Answer ; - - None : NP ; - Many : ListPN -> NP ; - BasePN : PN -> PN -> ListPN ; - ConsPN : PN -> ListPN -> ListPN ; -} diff --git a/examples/tutorial/semantics/BaseEng.gf b/examples/tutorial/semantics/BaseEng.gf deleted file mode 100644 index bd79bc98c..000000000 --- a/examples/tutorial/semantics/BaseEng.gf +++ /dev/null @@ -1,56 +0,0 @@ ---# -path=.:prelude - -concrete BaseEng of Base = open Prelude in { - -flags lexer=literals ; unlexer=text ; - --- English concrete syntax; greatly simplified - just for demo purposes - -lin - PredAP = infixSS "is" ; - - ComplA2 = cc2 ; - - ModCN = cc2 ; - - ConjAP c = infixSS c.s ; - ConjNP c = infixSS c.s ; - - UsePN a = a ; - Every = prefixSS "every" ; - Some = prefixSS "some" ; - - And = ss "and" ; - Or = ss "or" ; - - UseInt n = n ; - - Number = ss "number" ; - - Even = ss "even" ; - Odd = ss "odd" ; - Prime = ss "prime" ; - Equal = ss ("equal" ++ "to") ; - Greater = ss ("greater" ++ "than") ; - Smaller = ss ("smaller" ++ "than") ; - Divisible = ss ("divisible" ++ "by") ; - - Sum = prefixSS ["the sum of"] ; - Product = prefixSS ["the product of"] ; - GCD = prefixSS ["the greatest common divisor of"] ; - - WhatIs = prefixSS ["what is"] ; - WhichAre cn ap = ss ("which" ++ cn.s ++ "is" ++ ap.s) ; ---- are - QuestS s = s ; ---- inversion - - Yes = ss "yes" ; - No = ss "no" ; - - Value np = np ; - None = ss "none" ; - Many list = list ; - - BasePN = infixSS "and" ; - ConsPN = infixSS "," ; - -} diff --git a/examples/tutorial/semantics/BaseI.gf b/examples/tutorial/semantics/BaseI.gf deleted file mode 100644 index b7ed86666..000000000 --- a/examples/tutorial/semantics/BaseI.gf +++ /dev/null @@ -1,70 +0,0 @@ -incomplete concrete BaseI of Base = - open Syntax, (G = Grammar), Symbolic, LexBase in { - -flags lexer=literals ; unlexer=text ; - -lincat - Question = G.Phr ; - Answer = G.Phr ; - S = G.Cl ; - NP = G.NP ; - PN = G.NP ; - CN = G.CN ; - AP = G.AP ; - A2 = G.A2 ; - Conj = G.Conj ; - ListPN = G.ListNP ; - -lin - PredAP = mkCl ; - - ComplA2 = mkAP ; - - ModCN = mkCN ; - - ConjAP = mkAP ; - ConjNP = mkNP ; - - UsePN p = p ; - Every = mkNP every_Det ; - Some = mkNP someSg_Det ; - - And = and_Conj ; - Or = or_Conj ; - - UseInt i = symb (i ** {lock_Int = <>}) ; ---- terrible to need this - - Number = mkCN number_N ; - - Even = mkAP even_A ; - Odd = mkAP odd_A ; - Prime = mkAP prime_A ; - Equal = equal_A2 ; - Greater = greater_A2 ; - Smaller = smaller_A2 ; - Divisible = divisible_A2 ; - - Sum = prefix sum_N2 ; - Product = prefix product_N2 ; - GCD nps = mkNP (mkDet DefArt (mkOrd great_A)) - (mkCN common_A (mkCN divisor_N2 (mkNP and_Conj nps))) ; - - WhatIs np = mkPhr (mkQS (mkQCl whatSg_IP (mkVP np))) ; - WhichAre cn ap = mkPhr (mkQS (mkQCl (mkIP which_IQuant cn) (mkVP ap))) ; - QuestS s = mkPhr (mkQS (mkQCl s)) ; - - Yes = mkPhr yes_Utt ; - No = mkPhr no_Utt ; - - Value np = mkPhr (mkUtt np) ; - Many list = mkNP and_Conj list ; - None = none_NP ; - - BasePN = G.BaseNP ; - ConsPN = G.ConsNP ; - -oper - prefix : G.N2 -> G.ListNP -> G.NP = \n2,nps -> - mkNP DefArt (mkCN n2 (mkNP and_Conj nps)) ; - -} diff --git a/examples/tutorial/semantics/BaseIEng.gf b/examples/tutorial/semantics/BaseIEng.gf deleted file mode 100644 index a73bd44c6..000000000 --- a/examples/tutorial/semantics/BaseIEng.gf +++ /dev/null @@ -1,8 +0,0 @@ ---# -path=.:prelude:present:api:mathematical - -concrete BaseIEng of Base = BaseI with - (Syntax = SyntaxEng), - (Grammar = GrammarEng), - (G = GrammarEng), - (Symbolic = SymbolicEng), - (LexBase = LexBaseEng) ; diff --git a/examples/tutorial/semantics/BaseSwe.gf b/examples/tutorial/semantics/BaseSwe.gf deleted file mode 100644 index 6329c1c9c..000000000 --- a/examples/tutorial/semantics/BaseSwe.gf +++ /dev/null @@ -1,8 +0,0 @@ ---# -path=.:prelude:present:api:mathematical - -concrete BaseSwe of Base = BaseI with - (Syntax = SyntaxSwe), - (Grammar = GrammarSwe), - (G = GrammarSwe), - (Symbolic = SymbolicSwe), - (LexBase = LexBaseSwe) ; diff --git a/examples/tutorial/semantics/GSyntax.hs b/examples/tutorial/semantics/GSyntax.hs deleted file mode 100644 index 6c67e40aa..000000000 --- a/examples/tutorial/semantics/GSyntax.hs +++ /dev/null @@ -1,242 +0,0 @@ -module GSyntax where - -import GF.GFCC.DataGFCC -import GF.GFCC.AbsGFCC ----------------------------------------------------- --- automatic translation from GF to Haskell ----------------------------------------------------- - -class Gf a where gf :: a -> Exp -class Fg a where fg :: Exp -> a - -newtype GString = GString String deriving Show - -instance Gf GString where - gf (GString s) = DTr [] (AS s) [] - -instance Fg GString where - fg t = - case t of - DTr [] (AS s) [] -> GString s - _ -> error ("no GString " ++ show t) - -newtype GInt = GInt Integer deriving Show - -instance Gf GInt where - gf (GInt s) = DTr [] (AI s) [] - -instance Fg GInt where - fg t = - case t of - DTr [] (AI s) [] -> GInt s - _ -> error ("no GInt " ++ show t) - -newtype GFloat = GFloat Double deriving Show - -instance Gf GFloat where - gf (GFloat s) = DTr [] (AF s) [] - -instance Fg GFloat where - fg t = - case t of - DTr [] (AF s) [] -> GFloat s - _ -> error ("no GFloat " ++ show t) - ----------------------------------------------------- --- below this line machine-generated ----------------------------------------------------- - -data GA2 = - GDivisible - | GEqual - | GGreater - | GSmaller - deriving Show - -data GAP = - GComplA2 GA2 GNP - | GConjAP GConj GAP GAP - | GEven - | GOdd - | GPrime - deriving Show - -data GAnswer = - GNo - | GValue GNP - | GYes - deriving Show - -data GCN = - GModCN GAP GCN - | GNumber - deriving Show - -data GConj = - GAnd - | GOr - deriving Show - -newtype GListPN = GListPN [GPN] deriving Show - -data GNP = - GConjNP GConj GNP GNP - | GEvery GCN - | GMany GListPN - | GNone - | GSome GCN - | GUsePN GPN - deriving Show - -data GPN = - GGCD GListPN - | GProduct GListPN - | GSum GListPN - | GUseInt GInt - deriving Show - -data GQuestion = - GQuestS GS - | GWhatIs GPN - | GWhichAre GCN GAP - deriving Show - -data GS = GPredAP GNP GAP - deriving Show - - -instance Gf GA2 where - gf GDivisible = DTr [] (AC (CId "Divisible")) [] - gf GEqual = DTr [] (AC (CId "Equal")) [] - gf GGreater = DTr [] (AC (CId "Greater")) [] - gf GSmaller = DTr [] (AC (CId "Smaller")) [] - -instance Gf GAP where - gf (GComplA2 x1 x2) = DTr [] (AC (CId "ComplA2")) [gf x1, gf x2] - gf (GConjAP x1 x2 x3) = DTr [] (AC (CId "ConjAP")) [gf x1, gf x2, gf x3] - gf GEven = DTr [] (AC (CId "Even")) [] - gf GOdd = DTr [] (AC (CId "Odd")) [] - gf GPrime = DTr [] (AC (CId "Prime")) [] - -instance Gf GAnswer where - gf GNo = DTr [] (AC (CId "No")) [] - gf (GValue x1) = DTr [] (AC (CId "Value")) [gf x1] - gf GYes = DTr [] (AC (CId "Yes")) [] - -instance Gf GCN where - gf (GModCN x1 x2) = DTr [] (AC (CId "ModCN")) [gf x1, gf x2] - gf GNumber = DTr [] (AC (CId "Number")) [] - -instance Gf GConj where - gf GAnd = DTr [] (AC (CId "And")) [] - gf GOr = DTr [] (AC (CId "Or")) [] - -instance Gf GListPN where - gf (GListPN [x1,x2]) = DTr [] (AC (CId "BasePN")) [gf x1, gf x2] - gf (GListPN (x:xs)) = DTr [] (AC (CId "ConsPN")) [gf x, gf (GListPN xs)] - -instance Gf GNP where - gf (GConjNP x1 x2 x3) = DTr [] (AC (CId "ConjNP")) [gf x1, gf x2, gf x3] - gf (GEvery x1) = DTr [] (AC (CId "Every")) [gf x1] - gf (GMany x1) = DTr [] (AC (CId "Many")) [gf x1] - gf GNone = DTr [] (AC (CId "None")) [] - gf (GSome x1) = DTr [] (AC (CId "Some")) [gf x1] - gf (GUsePN x1) = DTr [] (AC (CId "UsePN")) [gf x1] - -instance Gf GPN where - gf (GGCD x1) = DTr [] (AC (CId "GCD")) [gf x1] - gf (GProduct x1) = DTr [] (AC (CId "Product")) [gf x1] - gf (GSum x1) = DTr [] (AC (CId "Sum")) [gf x1] - gf (GUseInt x1) = DTr [] (AC (CId "UseInt")) [gf x1] - -instance Gf GQuestion where - gf (GQuestS x1) = DTr [] (AC (CId "QuestS")) [gf x1] - gf (GWhatIs x1) = DTr [] (AC (CId "WhatIs")) [gf x1] - gf (GWhichAre x1 x2) = DTr [] (AC (CId "WhichAre")) [gf x1, gf x2] - -instance Gf GS where gf (GPredAP x1 x2) = DTr [] (AC (CId "PredAP")) [gf x1, gf x2] - - -instance Fg GA2 where - fg t = - case t of - DTr [] (AC (CId "Divisible")) [] -> GDivisible - DTr [] (AC (CId "Equal")) [] -> GEqual - DTr [] (AC (CId "Greater")) [] -> GGreater - DTr [] (AC (CId "Smaller")) [] -> GSmaller - _ -> error ("no A2 " ++ show t) - -instance Fg GAP where - fg t = - case t of - DTr [] (AC (CId "ComplA2")) [x1,x2] -> GComplA2 (fg x1) (fg x2) - DTr [] (AC (CId "ConjAP")) [x1,x2,x3] -> GConjAP (fg x1) (fg x2) (fg x3) - DTr [] (AC (CId "Even")) [] -> GEven - DTr [] (AC (CId "Odd")) [] -> GOdd - DTr [] (AC (CId "Prime")) [] -> GPrime - _ -> error ("no AP " ++ show t) - -instance Fg GAnswer where - fg t = - case t of - DTr [] (AC (CId "No")) [] -> GNo - DTr [] (AC (CId "Value")) [x1] -> GValue (fg x1) - DTr [] (AC (CId "Yes")) [] -> GYes - _ -> error ("no Answer " ++ show t) - -instance Fg GCN where - fg t = - case t of - DTr [] (AC (CId "ModCN")) [x1,x2] -> GModCN (fg x1) (fg x2) - DTr [] (AC (CId "Number")) [] -> GNumber - _ -> error ("no CN " ++ show t) - -instance Fg GConj where - fg t = - case t of - DTr [] (AC (CId "And")) [] -> GAnd - DTr [] (AC (CId "Or")) [] -> GOr - _ -> error ("no Conj " ++ show t) - -instance Fg GListPN where - fg t = - case t of - DTr [] (AC (CId "BasePN")) [x1,x2] -> GListPN [fg x1, fg x2] - DTr [] (AC (CId "ConsPN")) [x1,x2] -> let GListPN xs = fg x2 in GListPN (fg x1:xs) - _ -> error ("no ListPN " ++ show t) - -instance Fg GNP where - fg t = - case t of - DTr [] (AC (CId "ConjNP")) [x1,x2,x3] -> GConjNP (fg x1) (fg x2) (fg x3) - DTr [] (AC (CId "Every")) [x1] -> GEvery (fg x1) - DTr [] (AC (CId "Many")) [x1] -> GMany (fg x1) - DTr [] (AC (CId "None")) [] -> GNone - DTr [] (AC (CId "Some")) [x1] -> GSome (fg x1) - DTr [] (AC (CId "UsePN")) [x1] -> GUsePN (fg x1) - _ -> error ("no NP " ++ show t) - -instance Fg GPN where - fg t = - case t of - DTr [] (AC (CId "GCD")) [x1] -> GGCD (fg x1) - DTr [] (AC (CId "Product")) [x1] -> GProduct (fg x1) - DTr [] (AC (CId "Sum")) [x1] -> GSum (fg x1) - DTr [] (AC (CId "UseInt")) [x1] -> GUseInt (fg x1) - _ -> error ("no PN " ++ show t) - -instance Fg GQuestion where - fg t = - case t of - DTr [] (AC (CId "QuestS")) [x1] -> GQuestS (fg x1) - DTr [] (AC (CId "WhatIs")) [x1] -> GWhatIs (fg x1) - DTr [] (AC (CId "WhichAre")) [x1,x2] -> GWhichAre (fg x1) (fg x2) - _ -> error ("no Question " ++ show t) - -instance Fg GS where - fg t = - case t of - DTr [] (AC (CId "PredAP")) [x1,x2] -> GPredAP (fg x1) (fg x2) - _ -> error ("no S " ++ show t) - - diff --git a/examples/tutorial/semantics/LexBase.gf b/examples/tutorial/semantics/LexBase.gf deleted file mode 100644 index 83713a35f..000000000 --- a/examples/tutorial/semantics/LexBase.gf +++ /dev/null @@ -1,19 +0,0 @@ -interface LexBase = open Syntax in { - -oper - even_A : A ; - odd_A : A ; - prime_A : A ; - common_A : A ; - great_A : A ; - equal_A2 : A2 ; - greater_A2 : A2 ; - smaller_A2 : A2 ; - divisible_A2 : A2 ; - number_N : N ; - sum_N2 : N2 ; - product_N2 : N2 ; - divisor_N2 : N2 ; - - none_NP : NP ; --- -} diff --git a/examples/tutorial/semantics/LexBaseEng.gf b/examples/tutorial/semantics/LexBaseEng.gf deleted file mode 100644 index aea3a838b..000000000 --- a/examples/tutorial/semantics/LexBaseEng.gf +++ /dev/null @@ -1,20 +0,0 @@ -instance LexBaseEng of LexBase = open SyntaxEng, ParadigmsEng in { - -oper - even_A = mkA "even" ; - odd_A = mkA "odd" ; - prime_A = mkA "prime" ; - great_A = mkA "great" ; - common_A = mkA "common" ; - equal_A2 = mkA2 (mkA "equal") (mkPrep "to") ; - greater_A2 = mkA2 (mkA "greater") (mkPrep "than") ; --- - smaller_A2 = mkA2 (mkA "smaller") (mkPrep "than") ; --- - divisible_A2 = mkA2 (mkA "divisible") (mkPrep "by") ; - number_N = mkN "number" ; - sum_N2 = mkN2 (mkN "sum") (mkPrep "of") ; - product_N2 = mkN2 (mkN "product") (mkPrep "of") ; - divisor_N2 = mkN2 (mkN "divisor") (mkPrep "of") ; - - none_NP = mkNP (mkPN "none") ; --- - -} diff --git a/examples/tutorial/semantics/LexBaseSwe.gf b/examples/tutorial/semantics/LexBaseSwe.gf deleted file mode 100644 index 6ac1904aa..000000000 --- a/examples/tutorial/semantics/LexBaseSwe.gf +++ /dev/null @@ -1,22 +0,0 @@ -instance LexBaseSwe of LexBase = open SyntaxSwe, ParadigmsSwe in { - -oper - even_A = mkA "jämn" ; - odd_A = invarA "udda" ; - prime_A = mkA "prim" ; - great_A = mkA "stor" "större" "störst" ; - common_A = mkA "gemensam" ; - equal_A2 = mkA2 (invarA "lika") (mkPrep "med") ; - greater_A2 = mkA2 (invarA "större") (mkPrep "än") ; --- - smaller_A2 = mkA2 (invarA "mindre") (mkPrep "än") ; --- - divisible_A2 = mkA2 (mkA "delbar") (mkPrep "med") ; - number_N = mkN "tal" "tal" ; - sum_N2 = mkN2 (mkN "summa") (mkPrep "av") ; - product_N2 = mkN2 (mkN "produkt") (mkPrep "av") ; - divisor_N2 = mkN2 (mkN "delare") (mkPrep "av") ; - - none_NP = mkNP (mkPN "inget" neutrum) ; --- - - invarA : Str -> A = \x -> mkA x x x x x ; --- - -} diff --git a/examples/tutorial/semantics/Logic.hs b/examples/tutorial/semantics/Logic.hs deleted file mode 100644 index b5c615da5..000000000 --- a/examples/tutorial/semantics/Logic.hs +++ /dev/null @@ -1,101 +0,0 @@ -module Logic where - -data Prop = - Pred Ident [Exp] - | And Prop Prop - | Or Prop Prop - | If Prop Prop - | Not Prop - | All Prop - | Exist Prop - deriving Show - -data Exp = - App Ident [Exp] - | Var Int -- de Bruijn index - deriving Show - -type Ident = String - -data Model a = Model { - app :: Ident -> [a] -> a, - prd :: Ident -> [a] -> Bool, - dom :: [a] - } - -type Assignment a = [a] - -update :: a -> Assignment a -> Assignment a -update x assign = x : assign - -look :: Int -> Assignment a -> a -look i assign = assign !! i - -valExp :: Model a -> Assignment a -> Exp -> a -valExp model assign exp = case exp of - App f xs -> app model f (map (valExp model assign) xs) - Var i -> look i assign - -valProp :: Model a -> Assignment a -> Prop -> Bool -valProp model assign prop = case prop of - Pred f xs -> prd model f (map (valExp model assign) xs) - And a b -> v a && v b - Or a b -> v a || v b - If a b -> if v a then v b else True - Not a -> not (v a) - All p -> all (\x -> valProp model (update x assign) p) (dom model) - Exist p -> any (\x -> valProp model (update x assign) p) (dom model) - where - v = valProp model assign - -liftProp :: Int -> Prop -> Prop -liftProp i p = case p of - Pred f xs -> Pred f (map liftExp xs) - And a b -> And (lift a) (lift b) - Or a b -> Or (lift a) (lift b) - If a b -> If (lift a) (lift b) - Not a -> Not (lift a) - All p -> All (liftProp (i+1) p) - Exist p -> Exist (liftProp (i+1) p) - where - lift = liftProp i - liftExp e = case e of - App f xs -> App f (map liftExp xs) - Var j -> Var (j + i) - _ -> e - - --- example: initial segments of integers - -intModel :: Int -> Model Int -intModel mx = Model { - app = \f xs -> case (f,xs) of - ("+",_) -> sum xs - (_,[]) -> read f, - prd = \f xs -> case (f,xs) of - ("E",[x]) -> even x - ("<",[x,y]) -> x < y - ("=",[x,y]) -> x == y - _ -> error "undefined val", - dom = [0 .. mx] - } - -exModel = intModel 100 - -ev x = Pred "E" [x] -lt x y = Pred "<" [x,y] -eq x y = Pred "=" [x,y] -int i = App (show i) [] - -ex1 :: Prop -ex1 = Exist (ev (Var 0)) - -ex2 :: Prop -ex2 = All (Exist (lt (Var 1) (Var 0))) - -ex3 :: Prop -ex3 = All (If (lt (Var 0) (int 100)) (Exist (lt (Var 1) (Var 0)))) - -ex4 :: Prop -ex4 = All (All (If (lt (Var 1) (Var 0)) (Not (lt (Var 0) (Var 1))))) - diff --git a/examples/tutorial/semantics/SemBase.hs b/examples/tutorial/semantics/SemBase.hs deleted file mode 100644 index b682010e1..000000000 --- a/examples/tutorial/semantics/SemBase.hs +++ /dev/null @@ -1,42 +0,0 @@ -module SemBase where - -import Base -import Logic - --- translation of Base syntax to Logic - -iS :: GS -> Prop -iS s = case s of - GPredAP np ap -> iNP np (iAP ap) - -iNP :: GNP -> (Exp -> Prop) -> Prop -iNP np p = case np of - GEvery cn -> All (If (iCN cn var) (liftProp 0 (p var))) ---- - GSome cn -> Exist (And (iCN cn var) (p var)) ---- - GConjNP c np1 np2 -> iConj c (iNP np1 p) (iNP np2 p) - GUseInt (GInt i) -> p (int i) - -iAP :: GAP -> Exp -> Prop -iAP ap e = case ap of - GComplA2 a2 np -> iNP np (iA2 a2 e) - GConjAP c ap1 ap2 -> iConj c (iAP ap1 e) (iAP ap2 e) - GEven -> ev e - GOdd -> Not (ev e) - -iCN :: GCN -> Exp -> Prop -iCN cn e = case cn of - GModCN ap cn0 -> And (iCN cn0 e) (iAP ap e) - GNumber -> eq e e - -iConj :: GConj -> Prop -> Prop -> Prop -iConj c = case c of - GAnd -> And - GOr -> Or - -iA2 :: GA2 -> Exp -> Exp -> Prop -iA2 a2 e1 e2 = case a2 of - GGreater -> lt e2 e1 - GSmaller -> lt e1 e2 - GEqual -> eq e1 e2 - -var = Var 0 diff --git a/examples/tutorial/semantics/Top.hs b/examples/tutorial/semantics/Top.hs deleted file mode 100644 index 51d5fbb99..000000000 --- a/examples/tutorial/semantics/Top.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Main where - -import Base -import SemBase -import Logic -import PGF - -main :: IO () -main = do - gr <- file2grammar "Base.pgf" - loop gr - -loop :: PGF -> IO () -loop gr = do - s <- getLine - let t:_ = parse gr "BaseEng" "S" s - putStrLn $ showTree t - let p = iS $ fg t - putStrLn $ show p - let v = valProp exModel [] p - putStrLn $ show v - loop gr - -- cgit v1.2.3